open-insight/LSL2/STPROC/RDS_SUPPLEMENT_MAINT.txt

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