COMPILE FUNCTION obj_PM_Spec(Method,Parms) /* Methods for PM_SPEC table 8/29/2016 JCH - Initial Coding Properties: Methods: AllPMKeys ;* Returns all PM keys in descending date order SendReminders ;* Send Notes reminding of calibrations coming due */ DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Dialog_Box, Popup, NextKey, Database_Services, Datetime, SRP_Datetime DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, RList, obj_Notes, ErrMsg, Btree.Extract, Database_Services $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT PM_SPEC_EQUATES $INSERT PM_EQUATES $INSERT RLIST_EQUATES $INSERT NOTIFICATION_EQU $INSERT CALIB_LIST_EQUATES $INSERT TOOL_EQUATES EQU PDISPLAY$ TO 8 ;* From Popup_Equates EQU CRLF$ TO \0D0A\ ErrCode = '' ErrorMsg = '' ErrTitle = 'Error in Stored Procedure "obj_PM_Spec"' 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 = 'SchedStart' ; GOSUB SchedStart CASE Method = 'EarlyStart' ; GOSUB EarlyStart CASE Method = 'LateStart' ; GOSUB LateStart CASE Method = 'SchedNewPM' ; GOSUB SchedNewPM CASE Method = 'SendReminders' ; GOSUB SendReminders CASE Method = 'GetHistory' ; GOSUB GetHistory CASE Method = 'LastPMCompDTM' ; GOSUB LastPMCompDTM CASE 1 END CASE IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) RETURN '' END RETURN Result * * * * * * * SchedStart: * * * * * * * PMSpecKey = Parms[1,@RM] PMSpecRec = Parms[COL2()+1,@RM] IF PMSpecKey = '' THEN RETURN IF PMSpecRec = '' THEN PMSpecRec = XLATE('PM_SPEC',PMSpecKey,'','X') IF PMSpecRec = '' THEN RETURN END END SchedUnits = PMSpecRec PMKeys = PMSpecRec pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '') FOR I = 1 TO pmCnt PMKey = PMKeys<1,I> PMRec = XLATE('PM',PMKey,'','X') SchedStart = '' IF SchedUnits = 'D' OR SchedUnits = 'M' THEN SchedStart = OCONV(PMRec,'D') END IF SchedUnits = 'T' THEN ThisSchedTime = OCONV(PMRec,'MT') if ThisSchedTime = '' then ThisSchedTime = '00:00' SchedStart = OCONV(PMRec,'D4'):' ':ThisSchedTime END IF SchedUnits = 'Q' THEN SchedStart = PMRec END Result<1,I> = SchedStart NEXT I RETURN * * * * * * * EarlyStart: * * * * * * * PMSpecKey = Parms[1,@RM] PMSpecRec = Parms[COL2()+1,@RM] IF PMSpecKey = '' THEN RETURN IF PMSpecRec = '' THEN PMSpecRec = XLATE('PM_SPEC',PMSpecKey,'','X') IF PMSpecRec = '' THEN RETURN END END SchedUnits = PMSpecRec PMKeys = PMSpecRec pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '') Delta = PMSpecRec ;* FOR I = 1 TO pmCnt PMKey = PMKeys<1,I> PMRec = XLATE('PM',PMKey,'','X') EarlyStart = '' IF SchedUnits = 'D' THEN EarlyStart = OCONV(PMRec - Delta ,'D') END If SchedUnits = 'M' then EarlyStart = OConv(SRP_Datetime('AddMonths', PMRec, (-Delta)), 'D') end IF SchedUnits = 'T' THEN Delta = ( Delta/24 ) ;* Convert hours to decimal part of day SchedTM = ( PMRec / 86400 ) ;* Sec (since midnight ) * Sec/Day => decimal part of day EarlyStart = OCONV( PMRec + ( SchedTm - Delta ) , 'DT' ) END IF SchedUnits = 'Q' THEN EarlyStart = PMRec - Delta END Result<1,I> = EarlyStart NEXT I RETURN * * * * * * * LateStart: * * * * * * * PMSpecKey = Parms[1,@RM] PMSpecRec = Parms[COL2()+1,@RM] IF PMSpecKey = '' THEN RETURN IF PMSpecRec = '' THEN PMSpecRec = XLATE('PM_SPEC',PMSpecKey,'','X') IF PMSpecRec = '' THEN RETURN END END SchedUnits = PMSpecRec PMKeys = PMSpecRec pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '') Delta = PMSpecRec ;* FOR I = 1 TO pmCnt PMKey = PMKeys<1,I> PMRec = XLATE('PM',PMKey,'','X') Start = '' IF SchedUnits = 'D' THEN Start = OCONV(PMRec + Delta ,'D') END If SchedUnits = 'M' then Start = OConv(SRP_Datetime('AddMonths', PMRec, (Delta)), 'D') end IF SchedUnits = 'T' THEN Delta = ( Delta/24 ) ;* Convert hours to decimal part of day SchedTM = ( PMRec / 86400 ) ;* Sec (since midnight ) * Sec/Day => decimal part of day Start = OCONV( PMRec + ( SchedTm + Delta ) , 'DT' ) END IF SchedUnits = 'Q' THEN Start = PMRec + Delta END Result<1,I> = Start NEXT I RETURN * * * * * * * SchedNewPM: * * * * * * * PMSID = Parms[1,@RM] StartDt = Parms[COL2()+1,@RM] ;* Comp Date StartTm = Parms[COL2()+1,@RM] ;* Comp Time StartQty = Parms[COL2()+1,@RM] ;* Tool Cycle Count @ Completion of PM PMNo = Parms[COL2()+1,@RM] ;* Last PM complete Swap ',' with '' in PMSID Swap ',' with '' in PMNo PMSpecRec = Database_Services('ReadDataRow', 'PM_SPEC', PMSID) ToolID = Xlate('PM_SPEC', PMSID, 'TOOL_ID', 'X') ToolMode = Xlate('TOOL', ToolID, 'CURR_MODE', 'X') If ToolMode NE 'OUT' then IF PMSID = '' THEN ErrorMsg = 'Null Parameter "PMSID" passed to routine. (':Method:')' IF StartDt = '' THEN ErrorMsg = 'Null Parameter "StartDt" passed to routine. (':Method:')' IF ErrorMsg NE '' THEN RETURN thisStartDt = ICONV(StartDt,'D') IF thisStartDt = '' THEN ErrorMsg = 'Invalid parameter StartDt ':QUOTE(StartDt):' passed to routine. (':Method:')' RETURN END thisStartQty = ICONV(StartQty,'MD0') IF thisStartQty = '' THEN ErrorMsg = 'Invalid parameter StartQty ':QUOTE(StartQty):' passed to routine. (':Method:')' RETURN END Units = PMSpecRec IF Units = 'T' THEN IF StartTm = '' THEN ErrorMsg = 'Null Parameter "StartDt" passed to routine. (':Method:')' RETURN END thisStartTm = ICONV(StartTm,'MT') IF thisStartTm = '' THEN ErrorMsg = 'Invalid parameter StartTm ':QUOTE(StartTm):' passed to routine. (':Method:')' RETURN END END SchedDt = '' SchedTm = '' SchedQty = '' Interval = PMSpecRec BEGIN CASE CASE Units = 'D' SchedDt = thisStartDt + PMSpecRec ;* Interval is in days Case Units = 'M' SchedDt = SRP_Datetime('AddMonths', thisStartDt, PMSpecRec) CASE Units = 'T' Interval = PMSpecRec ;* Interval is in hours Interval = ( Interval/24 ) ;* Convert hours to decimal part of day EarlyStartDelta = (PMSpecRec / 24) ;* Convert hours to decimal part of day PrevSchedDt = Xlate('PM', PMNo, 'SCHED_DT', 'X') PrevSchedTm = Xlate('PM', PMNo, 'SCHED_TM', 'X') PrevSchedTm = ( PrevSchedTM / 86400 ) ;* Sec (since midnight ) * Sec/Day => decimal part of day PrevSchedDTM = PrevSchedDt + PrevSchedTm IF PrevSchedTm EQ 0 then //Condition for midnight SchedDTM = (thisStartDt + 1) + ( PrevSchedTm + Interval ) end else SchedDTM = thisStartDt + ( PrevSchedTm + Interval ) end SchedDiff = SchedDTM - EarlyStartDelta - Datetime() If SchedDiff GT Interval then // This is too far out SchedDTM = thisStartDt + PrevSchedTm end If SchedDTM LT PrevSchedDTM then SchedDTM = PrevSchedDTM CurrDtm = Datetime() If SchedDTM LE CurrDtm then Loop Until SchedDTM GE CurrDtm SchedDtm += Interval Repeat end SchedDTM = OCONV(SchedDTM, 'DT/^S') SchedDt = SchedDTM[1,' '] SchedTm = SchedDTM[COL2()+1,' '] SchedDt = ICONV(SchedDt,'D') SchedTm = ICONV(SchedTm,'MT') CASE Units = 'Q' // Run-based PM SchedQty = Interval + thisStartQty CASE 1 * Missing Units RETURN END CASE CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTH') CurrDTM = ICONV(CurrDTM,'DT') If ( (PMSId EQ 653) or (PMSId EQ 654) ) then PMResult = Xlate('PM', PMNo, 'PASS_FAIL', 'X') If PMResult EQ 'Pass' then // Schedule time-based PM four days from now. PMSId = 654 ;* Key to time-based PM_SPEC template PMNo = NextKey('PM') ;* Next PMKey PMRec = '' PMRec = PMSId ;* New PMRec PMrec = 'AUTO' ;* Automated process user PMRec = CurrDTM PMRec = Date() + 4 PMRec = Time() PMRec = '' end else // Reset cycle counter and schedule another PM with the same interval. ToolRec = Database_Services('ReadDataRow', 'TOOL', ToolID) ToolRec = 0 Database_Services('WriteDataRow', 'TOOL', ToolID, ToolRec, True$, False$, True$) PMSId = 653 ;* Key to run-based PM_SPEC template PMSInterval = Xlate('PM_SPEC', PMSId, 'INTERVAL', 'X') PMNo = NextKey('PM') ;* Next PMKey PMRec = '' PMRec = PMSId ;* New PMRec PMrec = 'AUTO' ;* Automated process user PMRec = CurrDTM PMRec = PMSInterval PMRec = PMSInterval PMRec = PMSInterval end end else PMNo = NextKey('PM') ;* Next PMKey PMRec = '' PMRec = PMSId ;* New PMRec PMrec = 'AUTO' ;* Automated process user PMRec = CurrDTM PMRec = SchedDt PMRec = SchedTm PMRec = OCONV(SchedQty,'MD0') end otParms = 'PM':@RM:PMNo:@RM:@RM:PMRec obj_Tables('WriteRec',otParms) ;* Write new PM record IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END end RETURN * * * * * * * GetHistory: * * * * * * * PMSId = Parms[1,@RM] IF PMSId = '' THEN RETURN OPEN 'DICT.PM' TO DictVar ELSE ErrorMsg = 'Unable to open DICT.PM for index lookup' RETURN END Search = '' IF PMSID NE '' THEN Search := 'PMS_ID':@VM:PMSId:@FM Option = '' Flag = '' PMKeys = '' Btree.Extract(Search, 'PM', DictVar, PMKeys, Option, Flag) ;* Get unsorted keys based on Search parameters * Put sort data in first column (Install DTM) WorkList = '' pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '') FOR I = 1 TO pmCnt PMKey = PMKeys<1,I> WorkList = XLATE('PM',PMKey,PM_COMP_DTM$,'X'):@VM:pmKey NEXT I WorkList := @RM CONVERT @FM:@VM TO @RM:@FM IN WorkList ;* push delimiters higher for V119 CALL V119('S','','D','R',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 pmCnt Result<1,I> = WorkList ;* Strip Sort column(s) NEXT I RETURN * * * * * * * LastPMCompDTM: * * * * * * * GOSUB GetHistory HistKeys = FIELD(Result,@VM,1,20) Result = '' LOOP PMNo = HistKeys[1,@VM] HistKeys[1,COL2()] = '' CompDTM = XLATE('PM',PMNo,PM_COMP_DTM$,'X') UNTIL CompDTM NE '' OR HistKeys = '' REPEAT Result = CompDTM RETURN * * * * * * * SendReminders: * * * * * * * RETURN ;* Update for PM_SPEC table JCH OPEN 'PM_SPEC' TO FileIn ELSE ErrorMsg = 'Unable to open "PM_SPEC" table. (':Method:')' RETURN END CheckDt = OCONV(Date()+15,'D4/') SelectSent = 'SELECT CALIB_LIST WITH NEXT_CAL_DT < ':QUOTE(CheckDt):' BY NEXT_CAL_DT' RList(SelectSent,TARGET_ACTIVELIST$,'','','') NoteText = '' Depts = '' Done = 0 LOOP READNEXT CLNo ELSE Done = 1 UNTIL Done READ CLRec FROM FileIn,CLNo THEN NextCalDt = OCONV(XLATE('CALIB_LIST',CLNo,'NEXT_CAL_DT','X'),'D4/') IF NextCalDt NE '' THEN CLType = CLRec Dept = CLRec IF Dept = '' THEN Dept = 'MET' IF CLType = 'E' THEN Desc = CLRec SN = CLRec Loc = CLRec SN = CLRec Loc = CLRec NewLine = 'The NIST Standard ':Desc:' (S/N: ':SN:') located in the ':Loc:' is due for calibration on ':NextCalDt:CRLF$ END LOCATE Dept IN Depts USING @FM SETTING Pos ELSE Depts = INSERT(Depts,Pos,0,0,Dept) END NoteText = NoteText:NewLine END ;* End of check for NextCalDt END ;* End of CLRec read REPEAT DeptUsers = '' DeptDescs ='' PopupLiteral = XLATE('SYSREPOSPOPUPS',@APPID<1>:'**DEPT',PDISPLAY$,'X') CONVERT @VM:@SVM TO @FM:@VM IN PopupLiteral LiteralCnt = COUNT(PopupLiteral,@FM) + (PopupLiteral NE '') FOR I = 1 TO LiteralCnt Dept = PopupLiteral DeptDesc = PopupLiteral UserNames = PopupLiteral LOCATE Dept IN Depts USING @FM SETTING Pos THEN CONVERT ' ' TO '' IN UserNames CONVERT ',' TO @VM IN UserNames DeptUsers = UserNames DeptDescs = DeptDesc END NEXT I NoteSubject = "Equipment Calibration Reminder" DeptCnt = COUNT(Depts,@FM) + (Depts NE '') FOR I = 1 TO DeptCnt IF NoteText NE '' THEN Recipients = DeptUsers LOCATE @USER4 IN Recipients SETTING Dummy THEN Recipient = @USER4 SentFrom = 'System' Subject = DeptDescs:" Department - Equipment Calibration Reminder" Message = NoteText AttachWindow = 'MASTER_CALIB_LIST' AttachKeys = '' SendToGroup = '' Obj_Notes('Create',Recipient:@RM:'System':@RM:NoteSubject:@RM:NoteText:@RM:'MASTER_CALIB_LIST') END END NEXT I RETURN