COMPILE FUNCTION obj_Sched(Method,Parms) /* Methods for SCHED table 07/1/2014 JCH - Initial Coding Properties: Methods: */ DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, Send_Dyn, RList, ErrMsg, Btree.Extract $INSERT MSG_EQUATES $INSERT SCHED_EQUATES $INSERT SCHED_DET_EQUATES $INSERT WO_MASTER_SCHED_EQU $INSERT RLIST_EQUATES EQU WFS$ TO \7C5E\ ErrTitle = 'Error in Stored Procedure "obj_Sched"' ErrorMsg = '' errCode = '' 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 = 'PushConfig' ; GOSUB PushConfig CASE Method = 'GetReactNos' ; GOSUB GetReactNos CASE Method = 'AddWO' ; GOSUB AddWO CASE Method = 'RemWO' ; GOSUB RemWO CASE Method = 'UnschedWOSteps' ; GOSUB UnschedWOSteps CASE 1 ErrorMsg = 'Unknown Method ':QUOTE(Method):' passed to routine.' END CASE IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) RETURN '' END RETURN Result * * * * * * * PushConfig: * * * * * * * MastSched = XLATE('CONFIG','WO_MAST_SCHED','','X') Dates = MastSched Month = MastSched MaxReact = MastSched SchedDts = '' FOR SchedDay = 1 TO 31 SchedDt = ICONV(FIELD(Dates<1,SchedDay>,' ',2,6),'D') SchedDts<1,SchedDay> = SchedDt AllReactsDay = MastSched FOR ReactNo = 20 TO MaxReact SchedData = MastSched CONVERT ';' TO @FM IN SchedData SWAP 'Open' WITH '' IN SchedData SWAP WFS$ WITH @VM IN SchedData scCnt = COUNT(SchedData,@FM) + (SchedData NE '') SchedSeq = 0 FOR N = 1 TO scCnt WONo = '' Comment = '' WODat = SchedData Trailer = SchedData WONo = WODat[1,' '] IF LEN(WONo) > 6 THEN WONo = WONo[1,6] WOStep = WONo[8,1] END ELSE WOStep = '' END IF WONo NE '' OR Trailer NE '' THEN SchedSeq += 1 SchedDetKey = ReactNo:'*':SchedDt:'*':SchedSeq SchedDetRec ='' SchedDetRec = WONo SchedDetRec = Trailer SchedDetRec = WOStep otParms = 'SCHED_DET':@RM:SchedDetKey:@RM:@RM:SchedDetRec obj_Tables('WriteRec',otParms) IF Get_Status(errCode) THEN DEBUG END NEXT N NEXT ReactNo NEXT SchedDay RETURN * * * * * * * GetReactNos: * * * * * * * WONo = Parms[1,@RM] IF WONo = '' THEN RETURN OPEN 'DICT.SCHED_DET' TO SchedDictVar ELSE ErrMsg('Unable to open DICT.SCHED_DET for index lookup') RETURN END SearchString = 'WO_NO':@VM:WONo:@FM Btree.Extract(SearchString,'SCHED_DET',SchedDictVar,SchedDetKeys,'','') IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END keyCnt = COUNT(SchedDetKeys,@VM) + (SchedDetKeys NE '') ReactNos = '' FOR I = 1 TO keyCnt SchedDetKey = SchedDetKeys<1,I> ReactNo = SchedDetKey[1,'*'] SchedDt = OCONV(SchedDetKey[COL2()+1,'*'],'D4/') SeqNo = SchedDetKey[COL2()+1,'*'] LOCATE ReactNo IN ReactNos BY 'AR' USING @VM SETTING Pos ELSE ReactNos = INSERT(ReactNos,1,Pos,0,ReactNo) END NEXT I Result = ReactNos RETURN * * * * * * * AddWO: * * * * * * * * Add Work Order to Schedule records RETURN * * * * * * * RemWO: * * * * * * * * Remove Work Order from all Schedule records RETURN * * * * * * * UnschedWOSteps: * * * * * * * DEBUG MsgUp = Msg(@window, Def) SelectSent = 'SELECT WO_STEP WITH SCHEDULED NE "Yes" ' RList(SelectSent,TARGET_ACTIVELIST$,'','','') WOStepKeys = '' Done = 0 LOOP READNEXT WOStepKey ELSE Done = 1 UNTIL Done WOStepKeys<-1> = WOStepKey REPEAT CONVERT @VM TO @FM IN WOStepKeys IF WOStepKeys = '' THEN Msg(@window, MsgUp) ErrMsg('No Work Orders remain unscheduled.') RETURN END *Make.List('',WOStepKeys,WOStepTable,DictWOStep) RETURN