489 lines
15 KiB
Plaintext
489 lines
15 KiB
Plaintext
COMPILE FUNCTION Master_PM_List(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5)
|
|
#pragma precomp SRP_PreCompiler
|
|
|
|
/*
|
|
Commuter module for MASTER_PM_LIST (PM List) dialog window
|
|
|
|
08/29/2016 - John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, RList
|
|
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, Yield
|
|
DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note
|
|
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup, Collect.Ixvals, Admin_User, Printer_Select
|
|
DECLARE FUNCTION Send_Message, Msg, Security_Check, obj_React_Run_CI, MemberOf, Get_Printer, obj_Install,Set_Printer
|
|
DECLARE FUNCTION obj_PM_Spec, NextKey, Popup, GaN_Services, Set_Property
|
|
|
|
$INSERT MSG_EQUATES
|
|
$INSERT APPCOLORS
|
|
$INSERT LSL_USERS_EQU
|
|
$INSERT SECURITY_RIGHTS_EQU
|
|
$INSERT PM_SPEC_EQUATES
|
|
$INSERT POPUP_EQUATES
|
|
$INSERT TOOL_EQUATES
|
|
$INSERT RTI_STYLE_EQUATES
|
|
$INSERT RLIST_EQUATES
|
|
$INSERT OIPRINT_EQUATES
|
|
|
|
|
|
EQU COL$PMS_ID TO 1
|
|
EQU COL$DESC TO 2
|
|
EQU COL$TOOL_ID TO 3
|
|
EQU COL$TOOL_DESC TO 4
|
|
EQU COL$TOOL_STATUS TO 5
|
|
EQU COL$TOOL_CYCLE_CNT TO 6
|
|
EQU COL$LAST_PM TO 7
|
|
EQU COL$EARLY_START TO 8
|
|
EQU COL$SCHED_START TO 9
|
|
EQU COL$LATE_START TO 10
|
|
EQU COL$PM_STATUS TO 11
|
|
|
|
// Update the arguments so that the OpenInsight OLE event will treate the ActiveX event as a native event handler.
|
|
If Event EQ 'OLE' then
|
|
Transfer Event to OIEvent
|
|
Transfer Parm1 to Event
|
|
Transfer Parm2 to Parm1
|
|
Transfer Parm3 to Parm2
|
|
Transfer Parm4 to Parm3
|
|
Transfer Parm5 to Parm4
|
|
* Transfer Param6 to Param5
|
|
* Transfer Param7 to Param6
|
|
* Transfer Param8 to Param7
|
|
end
|
|
|
|
ErrTitle = 'Error in Master_PM_List routine'
|
|
ErrorMsg = ''
|
|
|
|
Result = ''
|
|
|
|
|
|
BEGIN CASE
|
|
|
|
CASE EntID = @WINDOW AND Event = 'CREATE' ; GOSUB Create
|
|
CASE EntID = @WINDOW AND Event = 'CLOSE' ; GOSUB Close
|
|
CASE EntID = @WINDOW AND Event = 'GOTFOCUS' ; GOSUB Refresh
|
|
CASE EntID = @WINDOW:'.SCHED' AND Event = 'DBLCLK' ; GOSUB SchedDC
|
|
CASE EntID = @WINDOW:'.SCHED' AND Event = 'OPTIONS' ; GOSUB SchedOptions
|
|
CASE EntID = @WINDOW:'.REFRESH' AND Event = 'CLICK' ; GOSUB Refresh
|
|
CASE EntID = @WINDOW:'.PRINT_PM_LIST' AND Event = 'CLICK' ; GOSUB PrintPMList
|
|
CASE EntID = @WINDOW:'.NEW_PM' AND Event = 'CLICK' ; GOSUB NewPM
|
|
CASE EntID = @WINDOW:'.COMBO_FILTER' AND Event = 'CHANGED' ; GOSUB Refresh
|
|
CASE EntID = @WINDOW:'.OLE_BTN_CLEAR_FILTER' AND Event = 'OnClick' ; GOSUB ClearFilter
|
|
|
|
CASE 1
|
|
ErrorMsg = 'Unknown Parameters ':EntID:' - ':Event:' passed to commuter'
|
|
ErrMsg(ErrorMsg)
|
|
|
|
END CASE
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
ErrMsg(ErrTitle:@SVM:ErrorMsg)
|
|
END
|
|
|
|
RETURN Result
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
obj_Appwindow('Create',@WINDOW)
|
|
|
|
IF MemberOf (@USER4, 'PM_SCHED') ELSE
|
|
Message = 'You do not have the proper security to enter the Master PM Schedule List...'
|
|
Message<MICON$> = 'H'
|
|
Void = Msg( '', Message )
|
|
GOTO Close
|
|
END
|
|
|
|
PMStyles = Send_Message(@WINDOW:'.SCHED','COLSTYLE',0,'')
|
|
PMStyles<COL$PMS_ID> = BitOr(PMStyles<COL$PMS_ID>,DTCS_OPTIONSBUTTON$)
|
|
|
|
void = Send_Message(@WINDOW:'.SCHED','COLSTYLE',0,PMStyles)
|
|
|
|
GaNToolList = GaN_Services('GetToolList')
|
|
Set_Property(@WINDOW :'.COMBO_FILTER', 'LIST', GaNToolList)
|
|
Set_Property(@WINDOW, 'GANTOOLLIST@', GaNToolList)
|
|
Send_Message(@WINDOW:'.OLE_BTN_CLEAR_FILTER', 'QUALIFY_EVENT', 'OLE.OnClick', 1)
|
|
|
|
GOSUB Refresh
|
|
PrevCursor = Set_Property("SYSTEM", "CURSOR", "A")
|
|
Yield()
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Close:
|
|
* * * * * * *
|
|
|
|
End_Dialog(@WINDOW,'')
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
Refresh:
|
|
* * * * * * *
|
|
|
|
PrevCursor = Set_Property("SYSTEM", "CURSOR", "H")
|
|
Yield()
|
|
GaNToolList = Get_Property(@WINDOW, 'GANTOOLLIST@')
|
|
ToolFilter = Get_Property(@WINDOW :'.COMBO_FILTER', 'TEXT')
|
|
|
|
OPEN 'PM_SPEC' TO TableIn ELSE
|
|
ErrorMsg = 'Unable to open "PM_SPEC" table.'
|
|
PrevCursor = Set_Property("SYSTEM", "CURSOR", "A")
|
|
Yield()
|
|
RETURN
|
|
END
|
|
|
|
SELECT TableIn
|
|
|
|
SchedList = ''
|
|
SchedColors = ''
|
|
|
|
EQ_LOC = ''
|
|
Done = 0
|
|
Today = Date()
|
|
|
|
SortedStarts = ''
|
|
|
|
LOOP
|
|
|
|
READNEXT PMSId ELSE Done = 1
|
|
|
|
|
|
UNTIL Done
|
|
READ PMSpecRec FROM TableIn,PMSId THEN
|
|
|
|
ActPMKeys = PMSpecRec<PM_SPEC_PM_KEYS$>
|
|
Units = PMSpecRec<PM_SPEC_UNITS$>
|
|
ToolID = PMSpecRec<PM_SPEC_TOOL_ID$>
|
|
ToolStatus = XLATE('TOOL',ToolID,'CURR_MODE_DESC','X')
|
|
If ( ( (ToolID _EQC ToolFilter) or (ToolFilter EQ '') ) and (ToolStatus NE 'Out of Service') ) then
|
|
|
|
Conv = ''
|
|
IF Units = 'D' THEN Conv = 'D'
|
|
IF Units = 'T' THEN Conv = 'DT'
|
|
IF Units = 'Q' THEN Conv = 'MD0'
|
|
|
|
Today = Date()
|
|
CurrDtm = ICONV(OCONV(Date(),'D'):' ':OCONV(Time(),'MT'), 'DT' )
|
|
CurrCnt = XLATE('TOOL',ToolID,TOOL_CYCLE_CNT$,'X') ;* Curr Cycle Count on Tool
|
|
Now = ''
|
|
IF Units = 'D' THEN Now = Today
|
|
IF Units = 'T' THEN Now = CurrDtm
|
|
IF Units = 'Q' THEN Now = CurrCnt
|
|
|
|
pmCnt = COUNT(ActPMKeys,@VM) + (ActPMKeys NE '')
|
|
|
|
IF pmCnt = 0 THEN pmCnt = 1
|
|
|
|
SchedStarts = obj_PM_Spec('SchedStart',PMSId:@RM:PMSpecRec)
|
|
EarlyStarts = obj_PM_Spec('EarlyStart',PMSId:@RM:PMSpecRec)
|
|
LateStarts = obj_PM_Spec('LateStart',PMSId:@RM:PMSpecRec)
|
|
|
|
FOR I = 1 TO pmCnt
|
|
SchedStart = SchedStarts<1,I>
|
|
EarlyStart = EarlyStarts<1,I>
|
|
LateStart = LateStarts<1,I>
|
|
|
|
IF Conv NE '' THEN
|
|
SchedStartIn = ICONV(SchedStart,Conv)
|
|
EarlyStartIn = ICONV(EarlyStart,Conv)
|
|
LateStartIn = ICONV(LateStart,Conv)
|
|
END ELSE
|
|
SchedStartIn = SchedStart
|
|
EarlyStartIn = EarlyStart
|
|
LateStartIn = LateStart
|
|
END
|
|
|
|
BEGIN CASE
|
|
|
|
CASE SchedStartIn = '' ; LineColor = WHITE$
|
|
CASE EarlyStartIn = '' AND Now LE SchedStartIn ; LineColor = GREEN$
|
|
CASE Now < EarlyStartIn ; LineColor = GREEN$
|
|
CASE Now < SchedStartIn ; LineColor = YELLOW$
|
|
CASE LateStartIn = '' AND Now = SchedStartIn ; LineColor = ORANGE$
|
|
CASE LateStartIn = '' AND Now > SchedStartIn ; LineColor = RED$
|
|
CASE Now > LateStartIn ; LineColor = RED$
|
|
CASE Now GE SchedStartIn ; LineColor = ORANGE$ ;
|
|
|
|
END CASE
|
|
|
|
LastPM = OCONV(obj_PM_Spec('LastPMCompDTM',PMSId),'DT4/^H')
|
|
|
|
PMDesc = PMSpecRec<PM_SPEC_DESC$>
|
|
ToolID = PMSpecRec<PM_SPEC_TOOL_ID$>
|
|
ToolDesc = XLATE('TOOL',ToolID,TOOL_TOOL_DESC$,'X')
|
|
ToolLocation = XLATE('TOOL',ToolID,'LOCATION','X')
|
|
|
|
LastPM = LastPM
|
|
|
|
IF SchedStartIn = '' THEN
|
|
Pos = -1
|
|
END ELSE
|
|
|
|
LOCATE SchedStartIn IN SortedStarts BY 'AR' USING @FM SETTING Pos THEN
|
|
NULL
|
|
END ELSE
|
|
NULL
|
|
END
|
|
SortedStarts = INSERT(SortedStarts,Pos,0,0,SchedStartIn)
|
|
END
|
|
|
|
SchedLine = PMSId
|
|
SchedLine<1,COL$DESC> = PMDesc
|
|
SchedLine<1,COL$TOOL_ID> = ToolID
|
|
SchedLine<1,COL$TOOL_DESC> = ToolDesc
|
|
SchedLine<1,COL$TOOL_STATUS> = ToolStatus
|
|
SchedLine<1,COL$TOOL_CYCLE_CNT> = CurrCnt
|
|
SchedLine<1,COL$LAST_PM> = LastPM
|
|
SchedLine<1,COL$EARLY_START> = EarlyStart
|
|
SchedLine<1,COL$SCHED_START> = SchedStart
|
|
SchedLine<1,COL$LATE_START> = LateStart
|
|
SchedLine<1,COL$PM_STATUS> = XLATE('PM',ActPMKeys<1,I>,'STATUS','X') ;*PMStatus
|
|
SchedList = INSERT(SchedList,Pos,0,0,SchedLine)
|
|
SchedColors = INSERT(SchedColors,Pos,0,0,LineColor)
|
|
|
|
NEXT I
|
|
end
|
|
|
|
END ;* End of PM Rec read
|
|
REPEAT
|
|
|
|
SchedList<-1> = STR(@VM,10)
|
|
Set_Property(@WINDOW:'.Sched','LIST',SchedList)
|
|
SchedCnt = COUNT(SchedList,@FM) + (SchedList NE '')
|
|
FOR I = 1 TO SchedCnt
|
|
stat = Send_Message(@WINDOW:'.SCHED','COLOR_BY_POS',0,I,SchedColors<I>)
|
|
NEXT I
|
|
|
|
PrevCursor = Set_Property("SYSTEM", "CURSOR", "A")
|
|
Yield()
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
SchedDC:
|
|
* * * * * * *
|
|
|
|
CtrlEntId = @WINDOW:'.SCHED'
|
|
|
|
RowData = Get_Property(CtrlEntId,'ROWDATA')
|
|
|
|
PMSId = RowData<COL$PMS_ID>
|
|
|
|
obj_AppWindow('ViewRelated','PM_SPEC':@RM:PMSId)
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
SchedOptions:
|
|
* * * * * * *
|
|
|
|
CtrlEntId = @WINDOW:'.SCHED'
|
|
|
|
RowData = Get_Property(CtrlEntId,'ROWDATA')
|
|
|
|
PMSId = RowData<COL$PMS_ID>
|
|
|
|
TypeOver = ''
|
|
|
|
TypeOver<PDISPLAY$> = 'WITH PMS_ID = ':QUOTE(PMSId):' BY-DSND ENTER_DTM'
|
|
TypeOver<PSELECT$> = '2'
|
|
|
|
PMKeys = Popup(@WINDOW,TypeOver,'PM_HISTORY')
|
|
|
|
IF PMKeys = '' OR PMKeys = CHAR(27) THEN RETURN
|
|
|
|
obj_Appwindow('ViewRelated','PM':@RM:PMKeys:@RM:@RM)
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
NewPM:
|
|
* * * * * * *
|
|
|
|
PMSId = NextKey('PM_SCHED')
|
|
|
|
obj_AppWindow('ViewRelated','PM_SCHED':@RM:PMSId)
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
PrintPMList:
|
|
* * * * * * *
|
|
|
|
RETURN
|
|
|
|
|
|
Title = '':@VM:''
|
|
PageInfo = .25:@FM:1.5:@FM:.25:@FM:0.6
|
|
PageSetup = 1 ;* Landscape
|
|
|
|
PrintSetup = ''
|
|
PrintSetup<1,1> = '2' ;* Preview Normal
|
|
PrintSetup<1,2> = '5' ;* Show Print and PDF, hide Print Setup
|
|
PrintSetup<1,3> = '0' ;* Show the printing window
|
|
PDFParms = 'Printing PDF Document':@FM: '' :@FM:'':@FM: ''
|
|
|
|
|
|
PrintPath = Printer_Select('') ;* Select printer without changing default printer
|
|
|
|
stat = Set_Printer("INIT",PDFParms,Title,PageInfo,PageSetup,PrintSetup,PrintPath)
|
|
|
|
|
|
font = 'Arial'
|
|
font<2> = '12'
|
|
font<3> = 'L'
|
|
font<4> = '1' ;* Bold
|
|
|
|
stat = Set_Printer( 'FONT', font ); *send the Font to the printer
|
|
|
|
stat = set_Printer('FONTHEADFOOT',font)
|
|
|
|
|
|
Header = @VM:'MASTER CALIBRATION LIST'
|
|
Header<2> = @VM:"for Equipment as of 'D'"
|
|
Header<3> = ''
|
|
Header<4> = @VM:'All items must be calibrated by approved calibration suppliers.'
|
|
Header<5> = ' '
|
|
Header<6> = ' '
|
|
|
|
stat = Set_Printer( 'HEADER', header )
|
|
|
|
Location = -0.15:@FM:-1.150:@FM:1.57:@FM:1
|
|
stat = Set_Printer('BMP',obj_Install('Get_Prop','ColorBMP'),Location, 0,1)
|
|
|
|
|
|
colData = Get_Property(@WINDOW:'.EQUIPMENT','LIST')
|
|
colHead = Get_Property(@WINDOW:'.EQUIPMENT','LABEL')
|
|
|
|
CONVERT @FM TO @VM IN colHead
|
|
|
|
colFmt = '^+720'
|
|
colFmt<1,2> = '+720'
|
|
colFmt<1,3> = '^+1800'
|
|
colFmt<1,4> = '^+2160'
|
|
colFmt<1,5> = '^+1440'
|
|
colFmt<1,6> = '^+1440'
|
|
colFmt<1,7> = '^+1080'
|
|
colFmt<1,8> = '^+1440'
|
|
colFmt<1,9> = '^+1440'
|
|
colFmt<1,10> = '^+1440'
|
|
colFmt<1,11> = '^+1440'
|
|
|
|
|
|
font<2> = 10
|
|
font<4> = 1 ;* Bold
|
|
stat = Set_Printer('FONT',font,'100')
|
|
|
|
stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL)
|
|
|
|
font<4> = 0
|
|
fontSpacing = ''
|
|
stat = Set_Printer('FONT',font,fontSpacing)
|
|
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7)
|
|
|
|
stat = Set_Printer('TERM',1 )
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
PrintNIST:
|
|
* * * * * * *
|
|
|
|
FileName = ''
|
|
Title = '':@VM:''
|
|
PageInfo = .25:@FM:1.5:@FM:.25:@FM:0.6
|
|
PageSetup = 1 ;* Landscape
|
|
|
|
PrintSetup = ''
|
|
PrintSetup<1,1> = '2' ;* Preview Normal
|
|
PrintSetup<1,2> = '5' ;* Show Print and PDF, hide Print Setup
|
|
PrintSetup<1,3> = '0' ;* Show the printing window
|
|
PDFParms = 'Printing PDF Document':@FM: '' :@FM: 6 :@FM: ''
|
|
|
|
|
|
PrintPath = Printer_Select('') ;* Select printer without changing default printer
|
|
|
|
stat = Set_Printer("INIT",PDFParms,Title,PageInfo,PageSetup,PrintSetup,PrintPath)
|
|
|
|
|
|
font = 'Arial'
|
|
font<2> = '12'
|
|
font<3> = 'L'
|
|
font<4> = '1' ;* Bold
|
|
|
|
stat = Set_Printer( 'FONT', font ); *send the Font to the printer
|
|
|
|
stat = set_Printer('FONTHEADFOOT',font)
|
|
|
|
|
|
Header = @VM:'MASTER CALIBRATION LIST'
|
|
Header<2> = @VM:"for NIST / Primary Standards as of 'D'"
|
|
Header<3> = ''
|
|
Header<4> = @VM:'All items must be calibrated by approved'
|
|
Header<5> = @VM:'calibration suppliers as outlined in the Critical Materials List'
|
|
Header<6> = ' '
|
|
|
|
stat = Set_Printer( 'HEADER', header )
|
|
|
|
Location = -0.15:@FM:-1.150:@FM:1.57:@FM:1
|
|
stat = Set_Printer('BMP',obj_Install('Get_Prop','ColorBMP'),Location, 0,1)
|
|
|
|
|
|
colData = Get_Property(@WINDOW:'.NIST','LIST')
|
|
colHead = Get_Property(@WINDOW:'.NIST','LABEL')
|
|
|
|
CONVERT @FM TO @VM IN colHead
|
|
|
|
colFmt = '^+720'
|
|
colFmt<1,2> = '+1440'
|
|
colFmt<1,3> = '^+1800'
|
|
colFmt<1,4> = '^+2160'
|
|
colFmt<1,5> = '^+2160'
|
|
colFmt<1,6> = '^+1440'
|
|
colFmt<1,7> = '^+1440'
|
|
colFmt<1,8> = '^+1440'
|
|
colFmt<1,9> = '^+1440'
|
|
|
|
font<2> = 10
|
|
font<4> = 1 ;* Bold
|
|
stat = Set_Printer('FONT',font,'100')
|
|
stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL)
|
|
|
|
font<4> = 0
|
|
stat = Set_Printer('FONT',font,fontSpacing)
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7)
|
|
stat = Set_Printer('TERM',1 )
|
|
|
|
RETURN
|
|
|
|
|
|
ClearFilter:
|
|
|
|
Set_Property(@WINDOW:'.COMBO_FILTER', 'TEXT', '')
|
|
GoSub Refresh
|
|
|
|
return
|
|
|
|
|