COMPILE FUNCTION obj_Reactor_Log(Method,Parms) #pragma precomp SRP_PreCompiler /* Methods for REACTOR_LOG table 01/24/2014 JCH - Initial Coding Properties: Methods: InstHistKeys(@ID,@RECORD) TubeChange(Reactor,Date,ReactLogID) ;* Creates new Line item for Tube Change CloseOpenModes(Reactor) ;* Closes extraneous open REACT_MODE records */ DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, Send_Dyn, ErrMsg, Btree.Extract, obj_React_Item_Hist, Update_Index, obj_Post_Log Declare subroutine Error_Services, Database_Services DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, obj_React_Item, obj_Calendar, Database_Services $INSERT REACTOR_LOG_EQUATES $INSERT REACT_ITEM_EQUATES $INSERT REACT_ITEM_HIST_EQUATES $INSERT MSG_EQUATES ErrTitle = 'Error in Stored Procedure "obj_Reactor_Log"' ErrorMsg = '' IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine' IF NOT(ASSIGNED(Parms)) THEN Parms = '' IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) RETURN '' END Result = '' BEGIN CASE CASE Method = 'ElapsedHrs' ; GOSUB ElapsedHrs CASE Method = 'PostReactItems' ; GOSUB PostReactItems CASE Method = 'UnpostReactItems' ; GOSUB UnpostReactItems CASE Method = 'InstHistKeys' ; GOSUB InstHistKeys CASE Method = 'RemHistKeys' ; GOSUB RemHistKeys CASE 1 ErrorMsg = 'Unknown Method ':Method:' passed to object routine.' END CASE IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * ElapsedHrs: * * * * * * * RLNo = Parms[1,@RM] ReactLogRec = Parms[COL2()+1,@RM] IF RLNo = '' THEN RETURN ;* This is used in the dictionary -> don't throw an error for a null parmeter IF ReactLogRec = '' THEN ReactLogRec = XLATE('REACTOR_LOG',RLNo,'','X') StartDt = OCONV(ReactLogRec,'D4/') StartTm = OCONV(ReactLogRec,'MTH') EndDt = OCONV(ReactLogRec,'D4/') EndTm = OCONV(ReactLogRec,'MTH') StartDTM = ICONV(StartDt:' ':StartTm,'DT') EndDTM = ICONV(EndDt:' ':EndTm,'DT') IF StartDTM NE '' AND EndDTM NE '' AND EndDTM > StartDTM THEN Result = ICONV((EndDTM - StartDTM) * 24,'MD2') END RETURN * * * * * * * PostReactItems: * * * * * * * RLNo = Parms[1,@RM] PostSig = Parms[Col2()+1,@RM] IF RLNo = '' THEN RETURN otParms = 'REACTOR_LOG':@RM:RLNo //ReactorLogRec = obj_Tables('ReadRec',otParms) ReactorLogRec = Database_Services('ReadDataRow', 'REACTOR_LOG', RLNo) ReactNo = ReactorLogRec PostBy = ReactorLogRec PostDTM = ReactorLogRec If PostSig EQ '' then PostSig = @User4 * PostSig = @USER4 * Check for existing PostDTM (unposted case) IF PostDTM = '' THEN PostDTM = obj_Calendar('CurrDTM') PostDTM = ICONV(PostDTM,'DT') END InstRINos = ReactorLogRec CurrRINos = XLATE('REACTOR_LOG', RLNo, 'CURR_RI_NO', 'X') //Check to make sure that everything is valid before adding or removing anything ValidationFailureReason = '' for each InstRINo in InstRINos using @VM InstRIRec = Database_Services('ReadDataRow', 'REACT_ITEM', InstRINo) If InstRIRec NE '' then ValidationFailureReason = 'Unable to install Reactor Item No. ' : InstRINo : ' because its status is retired!' end Until ValidationFailureReason NE '' Next InstRINo if ValidationFailureReason EQ '' then irCnt = COUNT(InstRINos,@VM) + (InstRINos NE '') * * * * * 6/17/2014 JCH Changed this logic to not reinstall a Reactor Item that is already in the reactor * * * * * * * FOR I = 1 TO irCnt InstRINo = InstRINos<1,I> LOCATE InstRINo IN CurrRINos USING @VM SETTING Dummy ELSE InstRIHKey = ReactNo:'*':InstRINos<1,I>:'*':PostDTM oriParms = InstRIHKey:@RM oriParms := RLNo:@RM oriParms := ReactorLogRec ;*ReactorLogRec:@RM oriParms := ReactorLogRec obj_React_Item_Hist('Install',oriParms) IF Get_Status(errCode) THEN END END ;* End of LOCATE check for Install RI number already in the reactor NEXT I RemRIHKeys = ReactorLogRec rrCnt = COUNT(RemRIHKeys,@VM) + (RemRIHKeys NE '') FOR I = 1 TO rrCnt RemRIHKey = RemRIHKeys<1,I> DispCd = ReactorLogRec ;* Disposition Code IF DispCd = 'RET' THEN RemRINo = FIELD(RemRIHKey,'*',2) rlParms = 'REACT_ITEM':@RM rlParms := RemRINo:@RM rlParms := REACT_ITEM_RETIRE_BY$:@VM:REACT_ITEM_RETIRE_DT$:@RM rlParms := PostSig:@VM:PostDTM[1,'.']:@RM obj_Post_Log('Create',rlParms) END ELSE *obj_React_Item('PrintLabel', END ;* End of check for RET - Retire Item oriParms = RemRIHKey:@RM oriParms := PostDTM:@RM oriParms := RLNo:@RM oriParms := ReactorLogRec oriParms := ReactorLogRec obj_React_Item_Hist('Remove',oriParms) NEXT I ReactorLogRec = PostSig ReactorLogRec = PostDTM otParms = FIELDSTORE(otParms,@RM,4,0,ReactorLogRec) //obj_Tables('WriteRec',otParms) Database_Services('WriteDataRow', 'REACTOR_LOG', RLNo, ReactorLogRec, 1, 0, 1) Update_Index('REACT_ITEM_HIST', 'INST_RL_ID', False$, True$) ;* Don't wait for indexer - flush pending indexes now Update_Index('REACT_ITEM_HIST', 'REM_RL_ID', False$, True$) end else Error_Services('Add', ValidationFailureReason) end RETURN * * * * * * * UnpostReactItems: * * * * * * * RLNo = Parms[1,@RM] IF RLNo = '' THEN RETURN otParms = 'REACTOR_LOG':@RM:RLNo //ReactorLogRec = obj_Tables('ReadRec',otParms) ReactorLogRec = Database_Services('ReadDataRow', 'REACTOR_LOG', RLNo) ReactNo = ReactorLogRec PostBy = ReactorLogRec PostDTM = ReactorLogRec PostSig = @USER4 * Check for existing PostDTM (unposted case) IF PostDTM = '' THEN PostDTM = obj_Calendar('CurrDTM') PostDTM = ICONV(PostDTM,'DT') END * InstRINos = ReactorLogRec irCnt = COUNT(InstRINos,@VM) + (InstRINos NE '') CloseDTM = '' CloseRLId = '' CloseReactWfrs = '' CloseReactHrs = '' FOR I = 1 TO irCnt InstRIHKey = ReactNo:'*':InstRINos<1,I>:'*':PostDTM IF CloseDtm = '' THEN CloseRec = XLATE('REACT_ITEM_HIST',InstRIHkey,'','X') CloseDTM = CloseRec CloseRLId = CloseRec CloseReactWfrs = CloseRec CloseReactHrs = CloseRec END oRihParms = 'REACT_ITEM_HIST':@RM:InstRIHkey obj_Tables('DeleteRec',oRihParms) IF Get_Status(errCode) THEN DEBUG END NEXT I * Close - Update Close Records closed by ReactorLog Post RemRIHKeys = ReactorLogRec rrCnt = COUNT(RemRIHKeys,@VM) + (RemRIHKeys NE '') FOR I = 1 TO rrCnt IF CloseDTM = '' THEN oriParms = RemRIHKeys<1,I> obj_React_Item_Hist('ClearRemove',oriParms) END ELSE oriParms = RemRIHKeys<1,I>:@RM oriParms := CloseDTM:@RM oriParms := CloseRLId:@RM oriParms := CloseReactWfrs:@RM oriParms := CloseReactHrs obj_React_Item_Hist('Remove',oriParms) IF Get_Status(errCode) THEN DEBUG END END NEXT I ReactorLogRec = '' ReactorLogRec = PostDTM //otParms = FIELDSTORE(otParms,@RM,4,0,ReactorLogRec) //obj_Tables('WriteRec',otParms) Database_Services('WriteDataRow', 'REACTOR_LOG', RLNo, ReactorLogRec, 1,0,1) Update_Index('REACT_ITEM_HIST', 'REM_RL_ID', False$, True$) ;* Don't wait for indexer - flush pending indexes now Update_Index('REACT_ITEM_HIST', 'INST_RL_ID', False$, True$) RETURN * * * * * * * InstHistKeys: * * * * * * * IF NOT(ASSIGNED(RLId)) THEN RLId = Parms[1,@RM] IF NOT(ASSIGNED(ReactLogRec)) THEN ReactLogRec = Parms[COL2()+1,@RM] IF RLId = '' THEN RETURN ;* This is used in the dictionary -> don't throw an error for a null parmeter IF ReactLogRec = '' THEN ReactLogRec = XLATE('REACTOR_LOG',RLId,'','X') ReactNo = ReactLogRec EndDt = OCONV(ReactLogRec,'D4/') EndTm = OCONV(ReactLogRec,'MTS') InstDTM = ICONV(EndDt:' ':EndTm,'DT') ReactItemList = ReactLogRec riCnt = COUNT(ReactItemList,@VM) + (ReactItemList NE '') RHKeys = '' FOR I = 1 TO riCnt ReactItem = ReactItemList<1,I> IF ReactItem NE '' THEN RINo = obj_React_Item('Serial_RINo',ReactItem) IF RINo NE '' THEN RHKeys<1,-1> = ReactNo:'*':RINo:'*':InstDTM END END NEXT I /* OPEN 'DICT.REACT_ITEM_HIST' TO DictVar ELSE RETURN Search = 'INST_RL_ID':@VM:RLId:@FM Btree.Extract(Search,'REACT_ITEM_HIST',DictVar,RHKeys,'','') IF Get_Status(errCode) THEN DEBUG */ Result = RHKeys RETURN * * * * * * * RemHistKeys: * * * * * * * IF NOT(ASSIGNED(RLId)) THEN RLId = Parms[1,@RM] IF NOT(ASSIGNED(ReactLogRec)) THEN ReactLogRec = Parms[COL2()+1,@RM] IF RLId = '' THEN RETURN ;* This is used in the dictionary -> don't throw an error for a null parmeter IF ReactLogRec = '' THEN ReactLogRec = XLATE('REACTOR_LOG',RLId,'','X') OPEN 'DICT.REACT_ITEM_HIST' TO DictVar ELSE RETURN Search = 'REM_RL_ID':@VM:RLId:@FM Btree.Extract(Search,'REACT_ITEM_HIST',DictVar,RHKeys,'','') IF Get_Status(errCode) THEN DEBUG Result = RHKeys RETURN