COMPILE FUNCTION obj_React_Item_Hist(Method,Parms) /* Methods for React_Item_Hist table 01/18/2014 JCH - Initial Coding Properties: Methods: Install(ReactNo, RINo, InstDTM, RL_Id, ReactWfrs, ReactHrs) ;* Adds Reactor Installation line item to record Remove(ReactNo, RINo, InstDTM, RemDTM, RL_Id, ReactWfrs, ReactHrs) ;* Adds Removal information to Reactor Installation line item ClearRemove((ReactNo, RINo, InstDTM) ;* Clears Removal information in Reactor Installation line item GetHistory(ReactNo,RINo,RIType) ;* Returns sorted ReactItemHist keys for Reactor only, ReactItem Only, ReactType Only Reactor + RItem or Reactor + RIType */ DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Send_Dyn, obj_Popup DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, Send_Dyn DECLARE SUBROUTINE ErrMsg, Btree.Extract $INSERT REACT_ITEM_HIST_EQUATES EQU CRLF$ TO \0D0A\ EQU TAB$ TO CHAR(9) ErrTitle = 'Error in Stored Procedure "obj_ReactItem_Hist"' 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 = 'Install' ; GOSUB Install CASE Method = 'Remove' ; GOSUB Remove CASE Method = 'ClearRemove' ; GOSUB ClearRemove CASE Method = 'GetHistory' ; GOSUB GetHistory CASE 1 ErrorMsg = 'Unknown Method ':QUOTE(Method):' passed to routine.' END CASE IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) END RETURN Result * * * * * * * Install: * * * * * * * RIHKey = Parms[1,@RM] RL_Id = Parms[COL2()+1,@RM] ReactWfrCnt = Parms[COL2()+1,@RM] ReactHrs = Parms[COL2()+1,@RM] IF RIHKey = '' THEN ErrorMsg = 'Null Parameter "RIHKey" passed to routine. (':Method:')' IF RL_Id = '' THEN ErrorMsg = 'Null Parameter "RL_Id" passed to routine. (':Method:')' *IF ReactWfrCnt = '' THEN ErrorMsg = 'Null Parameter "ReactWfrCnt" passed to routine. (':Method:')' ;* Optional *IF ReactHrs = '' THEN ErrorMsg = 'Null Parameter "ReactHrs" passed to routine. (':Method:')' ;* Optional IF ErrorMsg NE '' THEN RETURN RIHRec = '' RIHRec = RL_ID RIHRec = ReactWfrCnt RIHRec = ReactHrs otParms = 'REACT_ITEM_HIST':@RM:RIHKey:@RM:@RM:RIHRec obj_Tables('WriteRec',otParms) RETURN * * * * * * * Remove: * * * * * * * RIHKey = Parms[1,@RM] RemoveDTM = Parms[COL2()+1,@RM] ;* Internal format * RL_Id = Parms[COL2()+1,@RM] ReactWfrCnt = Parms[COL2()+1,@RM] ReactHrs = Parms[COL2()+1,@RM] IF RIHKey = '' THEN ErrorMsg = 'Null Parameter "RIHKey" passed to routine. (':Method:')' IF RemoveDTM = '' THEN ErrorMsg = 'Null Parameter "RemoveDTM" passed to routine. (':Method:')' IF RL_Id = '' THEN ErrorMsg = 'Null Parameter "RL_Id" passed to routine. (':Method:')' *IF ReactWfrCnt = '' THEN ErrorMsg = 'Null Parameter "ReactWfrCnt" passed to routine. (':Method:')' ;* Optional *IF ReactHrs = '' THEN ErrorMsg = 'Null Parameter "ReactHrs" passed to routine. (':Method:')' ;* Optional IF ErrorMsg NE '' THEN RETURN * Read and update record * otParms = 'REACT_ITEM_HIST':@RM:RIHKey RIHRec = obj_Tables('ReadRec',otParms) IF Get_Status(errCode) THEN Set_Status(0) RIHRec = '' END RIHRec = RemoveDTM RIHRec = RL_Id RIHRec = ReactWfrCnt RIHRec = ReactHrs otParms = FIELDSTORE(otParms,@RM,4,0,RIHRec) obj_Tables('WriteRec',otParms) RETURN * * * * * * * ClearRemove: * * * * * * * RIHKey = Parms[1,@RM] IF RIHKey = '' THEN RETURN * Read and update record * otParms = 'REACT_ITEM_HIST':@RM:RIHKey RIHRec = obj_Tables('ReadRec',otParms) RIHRec = '' RIHRec = '' RIHRec = '' RIHRec = '' otParms = FIELDSTORE(otParms,@RM,4,0,RIHRec) obj_Tables('WriteRec',otParms) RETURN * * * * * * * GetHistory: * * * * * * * ReactNo = Parms[1,@RM] RINo = Parms[COL2()+1,@RM] RIType = Parms[COL2()+1,@RM] IF ReactNo = '' AND RINo = '' AND RIType = '' THEN RETURN OPEN 'DICT.REACT_ITEM_HIST' TO DictVar ELSE ErrorMsg = 'Unable to open DICT.REACT_ITEM_HIST for index lookup' RETURN END Search = '' IF ReactNo NE '' THEN Search := 'REACT_NO':@VM:ReactNo:@FM IF RINo NE '' THEN Search := 'RI_NO':@VM:RINo:@FM IF RIType NE '' THEN Search := 'RI_TYPE':@VM:RIType:@FM Option = '' Flag = '' Btree.Extract(Search, 'REACT_ITEM_HIST', DictVar, RIKeys, Option, Flag) ;* Get unsorted keys based on Search parameters * Put sort data in first column (Install DTM) WorkList = '' riCnt = COUNT(RIKeys,@VM) + (RIKeys NE '') FOR I = 1 TO riCnt RIKey = RIKeys<1,I> WorkList = FIELD(RIKey,'*',3):@VM:RIKey NEXT I WorkList := @RM CONVERT @FM:@VM TO @RM:@FM IN WorkList ;* push delimiters higher for V119 CALL V119('S','','D','L',WorkList,'') ;* Descending Left justified sort CONVERT @FM:@RM TO @VM:@FM IN WorkList ;* pull delimiters lower WorkList[-1,1] = '' ;* Trim trailing delimiter FOR I = 1 TO riCnt Result<1,I> = WorkList ;* Strip Sort column(s) NEXT I RETURN