added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
157
LSL2/STPROC/RDS_SUPPLEMENT_MAINT.txt
Normal file
157
LSL2/STPROC/RDS_SUPPLEMENT_MAINT.txt
Normal file
@ -0,0 +1,157 @@
|
||||
function rds_supplement_maint( WO )
|
||||
|
||||
declare function msg, fieldcount, popup, next_key, dialog_box
|
||||
declare subroutine extract_si_keys, make.list
|
||||
|
||||
$insert msg_equates
|
||||
$insert rds_equ
|
||||
$insert popup_equates
|
||||
|
||||
equ CrLf$ to char(13):char(10)
|
||||
|
||||
open 'RDS' to RdsTable else
|
||||
Void = msg( '', 'Unable to open RDS...' )
|
||||
return 0
|
||||
end
|
||||
extract_si_keys( 'RDS', 'WO', WO, RdsIds )
|
||||
if RdsIds then
|
||||
Rcnt = fieldcount( RdsIds, @vm )
|
||||
SuppIds = xlate( 'RDS', RdsIds, rds_supplement$, 'X' )
|
||||
PreSelect = ''
|
||||
PreSelectRDS = ''
|
||||
for i = 1 to Rcnt
|
||||
if SuppIds<1,i> = 1 then
|
||||
PreSelect<1,-1> = i
|
||||
PreSelectRDS<1,-1> = RdsIds<1,i>
|
||||
end
|
||||
next i
|
||||
PopRec = xlate( 'SYSREPOSPOPUPS', @appid<1>:'**':'RDS_QUERY', '', 'X' )
|
||||
PopRec<ptitle$> = 'Choose the RDSs that you wish to have RDS Supplement Instructions'
|
||||
if PreSelect <> '' then ; // <> -> NE
|
||||
PopRec<pinitselect$> = PreSelect
|
||||
end
|
||||
convert @vm to @fm in RdsIds
|
||||
HoldRDSIds = RdsIds
|
||||
make.list( 0, RdsIds, '', '' )
|
||||
ChoosenKeys = popup( @window, PopRec )
|
||||
FirstRDS = xlate( 'RDS', ChoosenKeys<1,1>, '', 'X' )
|
||||
Instructions = FirstRDS<rds_suppl_inst$>
|
||||
if ChoosenKeys then
|
||||
* CALL A QUICK DIALOG BOX ALLOWING THEM TO SET THE SUPPLEMENT INSTRUCTIONS
|
||||
Instructions = dialog_box( 'RDS_SUPPL_INST', @window, Instructions:char(245):'*CENTER' )
|
||||
if Instructions = 'CANCEL' then
|
||||
return 0
|
||||
end
|
||||
*
|
||||
Ccnt = fieldcount( ChoosenKeys, @vm )
|
||||
* FIRST ADD THE NEW ONES
|
||||
if Instructions <> '' else
|
||||
return 0
|
||||
end
|
||||
RDSUpdateMsg = ''
|
||||
for i = 1 to Ccnt
|
||||
ThisCRDS = ChoosenKeys<1,i>
|
||||
ThisRDSRec = xlate( 'RDS', ThisCRDS, '', 'X' )
|
||||
locate ThisCRDS in HoldRDSIds using @fm setting Rpos then
|
||||
locate Rpos in PreSelect using @vm setting Ppos then
|
||||
* WAS ALREADY SELECTED AND THE RDS WILL BE STAMPED WITH A VERIFICATION
|
||||
* SO ONLY STAMP THE SUPPLEMENT NOTES
|
||||
ThisRDSRec<rds_suppl_inst$> = Instructions
|
||||
end else
|
||||
ThisRDSRec<rds_supplement$> = 1
|
||||
ThisRDSRec<rds_suppl_inst$> = Instructions
|
||||
ThisRDSRec<rds_suppl_entry_id$> = @user4
|
||||
ThisRDSRec<rds_suppl_entry_date$> = date()
|
||||
ThisRDSRec<rds_suppl_entry_time$> = time()
|
||||
end
|
||||
* LOCK RDS OTHERWISE DO NOT CREATE VERIFICATION
|
||||
lock RDSTable, ThisCRDS then
|
||||
* CREATE THE SUPPLEMENT INFORMATION IN THE RDS
|
||||
write ThisRDSRec on RDSTable, ThisCRDS else
|
||||
Void = msg( '', 'Unable to write to RDS ':ThisCRDS )
|
||||
return 0
|
||||
end
|
||||
unlock RDSTable, ThisCRDS else
|
||||
Void = msg( '', 'Unable to unlock RDS ':ThisCRDS )
|
||||
return 0
|
||||
end
|
||||
RDSUpdateMsg := 'RDS# ':ThisCRDS:' Run Order# ':xlate( 'RDS', ThisCRDS, 'RUN_ORDER_NUM', 'X' ):CrLf$
|
||||
end else
|
||||
MsgInfo = ''
|
||||
MsgInfo<micon$> = '!'
|
||||
MsgInfo<mtext$> = 'RDS ':ThisCRDS:' is in use and no supplement can be created...Try at a later point.'
|
||||
Void = msg( '', MsgInfo )
|
||||
end
|
||||
end
|
||||
next i
|
||||
if RDSUpdateMsg <> '' then
|
||||
RDSUpdateMsg[-2,2] = ''
|
||||
* RDSUpdateMsg = 'The Following RDSs were stamped with Supplements':CrLf$:RDSUpdateMsg
|
||||
* MsgInfo = ''
|
||||
* MsgInfo<micon$> = '!'
|
||||
* MsgInfo<mtext$> = RDSUpdateMsg
|
||||
* Void = msg( '', MsgInfo )
|
||||
Void = Dialog_Box('RDS_SUPPLEMENT_MAINTENANCE', @Window, RDSUpdateMsg)
|
||||
end
|
||||
* NOW DID THEY REMOVE A SUPPLEMENTS THAT WERE PREVIOUSLY SELECTED IF SO THEN
|
||||
* PROMPT THE USER TO MAKE SURE
|
||||
RDSUpdateMsg = ''
|
||||
Pcnt = fieldcount( PreSelectRds, @vm )
|
||||
for i = 1 to Pcnt
|
||||
TPRds = PreSelectRds<1,i>
|
||||
locate TPRds in ChoosenKeys using @vm setting OKPos else
|
||||
lock RDSTable, TPRds then
|
||||
ThisRdsRec = xlate( 'RDS', TPRds, '', 'X' )
|
||||
if ( ThisRDSREc<rds_suppl_sig$> <> '' ) then
|
||||
MsgInfo = ''
|
||||
MsgInfo<micon$> = '!'
|
||||
MsgInfo<mtext$> = 'RDS ':TPRds:' Supplement form has already been signed by a technician.'
|
||||
Void = msg( '', MsgInfo )
|
||||
unlock RDSTable, TPRds else
|
||||
Void = msg( '', 'Unable to unlock RDS ':TPRds )
|
||||
return 0
|
||||
end
|
||||
end else
|
||||
ThisRDSRec<rds_supplement$> = 0
|
||||
ThisRDSRec<rds_suppl_inst$> = ''
|
||||
ThisRDSRec<rds_suppl_entry_id$> = ''
|
||||
ThisRDSRec<rds_suppl_entry_date$> = ''
|
||||
ThisRDSRec<rds_suppl_entry_time$> = ''
|
||||
ThisRDSRec<rds_suppl_sig$> = ''
|
||||
ThisRDSRec<rds_suppl_sig_date$> = ''
|
||||
ThisRDSRec<rds_suppl_sig_time$> = ''
|
||||
write ThisRDSRec on RDSTable, TPRds else
|
||||
Void = msg( '', 'Unable to write to RDS ':TPRds )
|
||||
return 0
|
||||
end
|
||||
unlock RDSTable, TPRds else
|
||||
Void = msg( '', 'Unable to unlock RDS ':TPRds )
|
||||
return 0
|
||||
end
|
||||
RDSUpdateMsg := 'RDS# ':TPRds:' Run Order# ':xlate( 'RDS', TPRds, 'RUN_ORDER_NUM', 'X' ):CrLf$
|
||||
end
|
||||
end else
|
||||
MsgInfo = ''
|
||||
MsgInfo<micon$> = '!'
|
||||
MsgInfo<mtext$> = 'RDS ':TPRds:' is in use and the verification can not be removed...Try at a later point.'
|
||||
Void = msg( '', MsgInfo )
|
||||
end
|
||||
end
|
||||
next i
|
||||
if RDSUpdateMsg <> '' then
|
||||
RDSUpdateMsg[-2,2] = ''
|
||||
RDSUpdateMsg = 'The Following RDSs had Supplements removed:':CrLf$:RDSUpdateMsg
|
||||
MsgInfo = ''
|
||||
MsgInfo<micon$> = '!'
|
||||
MsgInfo<mtext$> = RDSUpdateMsg
|
||||
Void = msg( '', MsgInfo )
|
||||
end
|
||||
end; * NO CHOOSEN KEYS
|
||||
end else
|
||||
MsgInfo = ''
|
||||
MsgInfo<mtext$> = 'Error extracting keys...'
|
||||
MsgInfo<micon$> = 'H'
|
||||
Void = msg( '', MsgInfo )
|
||||
return 0
|
||||
end
|
||||
return 0
|
||||
Reference in New Issue
Block a user