open-insight/LSL2/STPROC/NDW_MASTER_CALIB_LIST_EVENTS.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

1079 lines
43 KiB
Plaintext

COMPILE FUNCTION Ndw_Master_Calib_List_Events(CtrlEntId, Event, @PARAMS)
/*
Commuter module for MASTER_CALIB_LIST (Calibration List) dialog window
02/09/2010 - John C. Henry, J.C. Henry & Co., Inc.
01/10/2024 - DJS - Converted commuter module from MASTER_CALIB_LIST
*/
#pragma precomp SRP_PreCompiler
#Window NDW_MASTER_CALIB_LIST
Declare Subroutine Center_Window, ErrMsg, obj_AppWindow, Post_Event, Set_Property, End_Dialog, Send_Event, Send_Message
Declare Subroutine obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note, SRP_EditTable_Manager
Declare Subroutine SRP_Fastarray_Release, SRP_Fastarray, Memory_Services, Database_Services
Declare Function Get_Property, Get_Status, Dialog_Box, Popup, Printer_Select, obj_Install, Set_Printer, SRP_Fastarray_Create
Declare Function Send_Message, Msg, Security_Check, MemberOf, Get_Printer, Calibration_Services, SRP_Array, SRP_Fastarray
Declare Function SRP_Trim, Database_Services
// Control Name equates
Equ EquipmentTable$ To @Window : '.OLE_EDT_EQUIPMENT'
Equ NistTable$ To @Window : '.OLE_EDT_NIST'
$Insert EVENT_SETUP
$Insert MSG_EQUATES
$Insert APPCOLORS
$Insert LSL_USERS_EQU
$Insert SECURITY_RIGHTS_EQU
$Insert CALIB_LIST_EQUATES
$Insert POPUP_EQUATES
$Insert LOGICAL
$Insert QUOTE_SIGS_EQU
$Insert RLIST_EQUATES
$Insert OIPRINT_EQUATES
$Insert USER_CONFIG_EQUATES
Equ HIDDEN$ TO 32
Equ COL$CL_NO TO 1 ; // int
Equ COL$DEPT TO 2 ; // string
Equ COL$EQ_INSTRUMENT TO 3 ; // string
Equ COL$EQ_SN TO 4 ; // string
Equ COL$EQ_LOC TO 5 ; // string
Equ COL$EQ_CAL_INT TO 6 ; // int
Equ COL$EQ_INT_EXT TO 7 ; // string
Equ COL$EQ_LAST_CAL TO 8 ; // date
Equ COL$EQ_NEXT_CAL TO 9 ; // date
Equ COL$NIST_STANDARD TO 3 ; // string
Equ COL$NIST_TSN TO 4 ; // string
Equ COL$NIST_LOC TO 5 ; // string
Equ COL$NIST_CAL_INT TO 6 ; // int
Equ COL$NIST_INT_EXT TO 7 ; // string
Equ COL$NIST_LAST_CAL TO 8 ; // date
Equ COL$NIST_NEXT_CAL TO 9 ; // date
ErrTitle = 'Error in NDW_MASTER_CALIB_LIST_EVENTS routine'
ErrorMsg = ''
// 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 Param1 to Event
Transfer Param2 to Param1
Transfer Param3 to Param2
Transfer Param4 to Param3
Transfer Param5 to Param4
Transfer Param6 to Param5
Transfer Param7 to Param6
Transfer Param8 to Param7
end
GoToEvent Event for CtrlEntID
IF ErrorMsg NE '' THEN
ErrMsg(ErrTitle:@SVM:ErrorMsg)
END
Return EventFlow else EVENT_CONTINUE$
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Events
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Event WINDOW.CREATE(CreateParam)
obj_Appwindow('Create',@WINDOW)
IF MemberOf (@USER4, 'CALIBRATION') ELSE
Message = 'You do not have the proper security to enter the Master Calibration List...'
Message<MICON$> = 'H'
Void = Msg( '', Message )
Post_Event(@Window, 'CLOSE')
END
CalEngSigners = XLATE( 'CONFIG', 'QUOTE_SIGS', PSNPreProdSigs$, 'X' )
LOCATE @USER4 IN CalEngSigners USING @VM SETTING DUM THEN
IsCalEng = TRUE$
END ELSE
Set_Property(@WINDOW:'.PRINT)','VISIBLE',FALSE$)
IsCalEng = FALSE$
END
GoSub SetupOLEControls
end event
Event WINDOW.CLOSE(CancelFlag)
GoSub SaveUserFilters
Open 'CONFIG' to ConfigTable then
Unlock ConfigTable, 'MASTER_CALIB_LIST' else
Null
* may not have locked if user does not have proper security
end
end else
Void = msg( '', 'Unable to open CONFIG table' )
end
Memory_Services('RemoveKey', 'Cell_Size')
End_Dialog(@WINDOW,'')
end event
Event PUB_CANCEL.CLICK()
Send_Event(@Window, 'CLOSE')
end event
Event PRINT_EQUIP_LIST.CLICK()
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(EquipmentTable$, 'OLE.ARRAY')
colData = Insert(colData, 6, 0, 0, '':@FM:'')
colData = SRP_Array('Rotate', colData, @FM, @VM)
colHead = Get_Property(EquipmentTable$, 'OLE.TitleList')
colHead = Insert(colHead, 0, 6, 0, 'Equip. Class':@VM:'Cal/PM Class')
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
If Unassigned(fontSpacing) then fontSpacing = ''
stat = Set_Printer('FONT',font,fontSpacing)
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7)
stat = Set_Printer('TERM',1 )
end event
Event PRINT_NIST_LIST.CLICK()
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(NistTable$, 'OLE.LIST')
colHead = Get_Property(NistTable$, 'OLE.TitleList')
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 )
end event
Event NEW_EQUIPMENT.CLICK()
GoSub NewEquipment
end event
Event NEW_NIST.CLICK()
GoSub NewNIST
end event
Event OLE_EDT_EQUIPMENT.OnDblClick(Cell, Point, Button, Shift, Ctrl)
Row = Field(Cell, ';', 2)
RowData = Get_Property(EquipmentTable$, "OLE.RecordData[":Row:"]")
CLNo = RowData<0, 1>
obj_AppWindow('ViewRelated','CALIB_LIST':@RM:CLNo)
end event
Event OLE_EDT_NIST.OnDblClick(Cell, Point, Button, Shift, Ctrl)
Row = Field(Cell, ';', 2)
RowData = Get_Property(NistTable$, "OLE.RecordData[":Row:"]")
CLNo = RowData<0, 1>
obj_AppWindow('ViewRelated','CALIB_LIST':@RM:CLNo)
end event
Event WINDOW.OMNIEVENT(Message, Param1, Param2, Param3, Param4)
GoSub LoadSearchData
end event
Event OLE_EDT_EQUIPMENT.OnHeaderClick(Cell, Point, Button, Shift, Ctrl)
Set_Property(EquipmentTable$, 'OLE.Redraw', False$)
FilterOptions = ''
CellxPos = Cell[1, ';']
CellyPos = Cell[Col2() + 1, ';']
// Remove 1 cell position due to the hidden header column
CellSize = Send_Message(EquipmentTable$, "OLE.GetCellRect", (CellxPos - 1) : ';' CellyPos)
Memory_Services('SetValue', 'Cell_Size', CellSize)
If Button EQ 'Left' then
Header = Get_Property(EquipmentTable$, 'HeaderText[' : Cell : ']')
ColumnPos = CellxPos - 1
FilterArray = Get_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':ColumnPos)
// Build filter options based on the results of all other selected filters
GoSub GetEquipmentFilterData
EquipmentList = SRP_Array('Rotate', EquipmentList, @FM, @VM)
Column = EquipmentList<ColumnPos>
Blanks = False$
Locate "" in Column using @VM setting Dummy then Blanks = True$
CleanCol = SRP_Array('Clean', Column, 'TrimAndMakeUnique', @VM)
Begin Case
Case ( (ColumnPos EQ 1) or (ColumnPos EQ 6) )
// Numerical sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
Case ( (ColumnPos EQ 8) or (ColumnPos EQ 9) )
// Date sort
CleanCol = IConv(CleanCol, 'D')
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
CleanCol = OConv(CleanCol, 'D4/')
Case Otherwise$
// String sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingText', @VM)
End Case
If Blanks then CleanCol <0, -1> = '(Blanks)'
SelFilterArray = Get_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':ColumnPos)
// Build selected filter array from full selected filter list
SelectedFilterItems = ''
NewFilterArray = ''
For each Value in CleanCol using @VM
Locate Value in FilterArray using @VM setting vPos then
SelectedFilterItems<0, -1> = SelFilterArray<0, vPos>
end
Next Value
FilterArray = CleanCol
FormattedFilterArray = ''
// Build filter list in SRP Tree Control format
For Each Filter in FilterArray using @VM setting vPos
FormattedFilterArray := 1 : @SVM : vPos : @SVM : Filter : @SVM : @SVM : @SVM : @SVM : @SVM : @SVM : @SVM : @SVM : 'Left' : @SVM : @VM
Next FilterArray
// Call the Tree_Filter Window and place it under the column header. Pass in Tree Control formatted list
SelectedFilterItems = Dialog_Box('NDW_TREE_SORT_FILTER', @Window, FormattedFilterArray:@FM:SelectedFilterItems)
If SelectedFilterItems NE 'Cancel' then
FullFilterArray = Get_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':ColumnPos)
For each Filter in FilterArray using @VM setting fPos
Locate Filter in FullFilterArray using @VM setting vPos then
SelFilterArray<0, vPos> = SelectedFilterItems<0, fPos>
end
Next Filter
Set_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':ColumnPos, SelFilterArray)
GoSub ApplyEquipmentFilters
GoSub SaveUserFilters
end
end
Set_Property(EquipmentTable$, 'OLE.Redraw', True$)
end event
Event OLE_EDT_NIST.OnHeaderClick(Cell, Point, Button, Shift, Ctrl)
Set_Property(NistTable$, 'OLE.Redraw', False$)
FilterOptions = ''
CellxPos = Cell[1, ';']
CellyPos = Cell[Col2() + 1, ';']
// Remove 1 cell position due to the hidden header column
CellSize = Send_Message(NistTable$, "OLE.GetCellRect", (CellxPos - 1) : ';' CellyPos)
Memory_Services('SetValue', 'Cell_Size', CellSize)
If Button EQ 'Left' then
Header = Get_Property(NistTable$, 'HeaderText[' : Cell : ']')
ColumnPos = CellxPos - 1
FilterArray = Get_Property(@Window, '@NIST_FILTER_ARRAY_':ColumnPos)
// Build filter options based on the results of all other selected filters
GoSub GetNistFilterData
NistList = SRP_Array('Rotate', NistList, @FM, @VM)
Column = NistList<ColumnPos>
Blanks = False$
Locate "" in Column using @VM setting Dummy then Blanks = True$
CleanCol = SRP_Array('Clean', Column, 'TrimAndMakeUnique', @VM)
Begin Case
Case ( (ColumnPos EQ 1) or (ColumnPos EQ 6) )
// Numerical sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
Case ( (ColumnPos EQ 8) or (ColumnPos EQ 9) )
// Date sort
CleanCol = IConv(CleanCol, 'D')
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
CleanCol = OConv(CleanCol, 'D4/')
Case Otherwise$
// String sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingText', @VM)
End Case
If Blanks then CleanCol <0, -1> = '(Blanks)'
SelFilterArray = Get_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':ColumnPos)
// Build selected filter array from full selected filter list
SelectedFilterItems = ''
NewFilterArray = ''
For each Value in CleanCol using @VM
Locate Value in FilterArray using @VM setting vPos then
SelectedFilterItems<0, -1> = SelFilterArray<0, vPos>
end
Next Value
FilterArray = CleanCol
FormattedFilterArray = ''
// Build filter list in SRP Tree Control format
For Each Filter in FilterArray using @VM setting vPos
FormattedFilterArray := 1 : @SVM : vPos : @SVM : Filter : @SVM : @SVM : @SVM : @SVM : @SVM : @SVM : @SVM : @SVM : 'Left' : @SVM : @VM
Next FilterArray
// Call the Tree_Filter Window and place it under the column header. Pass in Tree Control formatted list
SelectedFilterItems = Dialog_Box('NDW_TREE_SORT_FILTER', @Window, FormattedFilterArray:@FM:SelectedFilterItems)
If SelectedFilterItems NE 'Cancel' then
FullFilterArray = Get_Property(@Window, '@NIST_FILTER_ARRAY_':ColumnPos)
For each Filter in FilterArray using @VM setting fPos
Locate Filter in FullFilterArray using @VM setting vPos then
SelFilterArray<0, vPos> = SelectedFilterItems<0, fPos>
end
Next Filter
Set_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':ColumnPos, SelFilterArray)
GoSub ApplyNistFilters
GoSub SaveUserFilters
end
end
Set_Property(NistTable$, 'OLE.Redraw', True$)
end event
Event PUB_TEST.CLICK()
GoSub SaveUserFilters
end event
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Internal GoSubs
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
NewEquipment:
NewNIST:
thisFormWindowUp = Get_Property('CALIB_LIST','VISIBLE') ;* Returns 0 = hidden, 1 = visible, 2 = minimized, 3 = maximized
If Unassigned(thisFormParms) then thisFormParms = ''
IF thisFormWindowUp = '' THEN Start_Window('CALIB_LIST',@WINDOW,thisFormParms) ;* Put up the card window - added thisFormParms 3/22/2010 JCH
IF thisFormWindowUp = 2 THEN Set_Property('CALIB_LIST','VISIBLE',9) ;* Restore the window if minimized
IF Get_Property('CALIB_LIST','SAVEWARN') THEN
Set_Property('CALIB_LIST','@SKIP_CARD_RETURN',1) ;* This stops the Return behavior
Send_Event('CALIB_LIST','CLEAR') ;* Clear anything existing (prompts for save first)
END
Send_Event('CALIB_LIST.NEW_ITEM','CLICK')
RETURN
SetupOLEControls:
// Setup Equipment OLE Edit Table
ArrayDimension = 9 : @FM : 50
TitleList = 'CL No ' : @VM
TitleList := 'Dept' : @VM
TitleList := 'Instrument ' : @VM
TitleList := 'S/N ' : @VM
TitleList := 'Location / Status ' : @VM
TitleList := 'Interval ' : @VM
ColumnWidths = '60' : @FM : '50' : @FM : '287' : @FM : '80' : @FM : '140' : @FM : '70' : @FM
ColumnAlignments = 'C' : @FM : 'C' : @FM : 'L' : @FM : 'L' : @FM : 'L' : @FM : 'C' : @FM
TitleList := 'Cal Loc' : @VM : 'Last Cal ' : @VM : 'Next Cal '
ColumnWidths := '60' : @FM : '70' : @FM : '70'
ColumnAlignments := 'C' : @FM : 'C' : @FM : 'C'
VirtualPos = ''
RowsAsColumns = ''
CellsAsFields = ''
ClearFill = ''
OIEditTable = ''
SRP_EditTable_Manager('Setup1', EquipmentTable$, ArrayDimension, TitleList, ColumnWidths, ColumnAlignments, VirtualPos, RowsAsColumns, CellsAsFields, ClearFill, OIEditTable)
Set_Property(EquipmentTable$, 'OLE.SelectionStyle', 'Black' : @VM : OI_HOT_BLUE$ : ' L=70' : @FM : 'Black' : @VM : OI_HOT_BLUE$) ; // Automatically highlight the current row with one color and highlight the current row with another color.
Set_Property(EquipmentTable$, 'OLE.HeaderFont[All; All]', 'Segoe UI' : @SVM : 8)
Set_Property(EquipmentTable$, 'OLE.CellFont[All; All]', 'Segoe UI' : @SVM : 8)
Set_Property(EquipmentTable$, 'OLE.HeaderColumn[1]', '' : @FM : False$ : @FM : False$ : @FM)
Set_Property(EquipmentTable$, 'OLE.CellProtection[ALL; All]', 'SEL')
Set_Property(EquipmentTable$, 'OLE.NewRowCount', 0)
Set_Property(EquipmentTable$, 'OLE.HeaderRow[ALL]', '' : @FM : '' : @FM : False$ : @FM)
Set_Property(EquipmentTable$, 'OLE.DataColumn[ALL]', '' : @FM : '' : @FM : False$ : @FM)
Set_Property(EquipmentTable$, 'OLE.DataRow[ALL]', '' : @FM : '' : @FM : False$ : @FM)
Set_Property(EquipmentTable$, 'OLE.HeaderColors[All; All]', 'Auto' : @FM : 'None' : @FM : 'None' : @FM : OI_HOT_BLUE$ : @FM : False$)
Set_Property(EquipmentTable$, 'OLE.ResetSelPos', False$)
HeaderAlignArray = 'Center':@FM:'Left':@FM:'Right'
Set_Property(EquipmentTable$, "OLE.HeaderAlignment[All; 1]", HeaderAlignArray)
Set_Property(EquipmentTable$, 'OLE.AllowDeletions', False$)
Set_Property(EquipmentTable$, 'OLE.AllowInserts', False$)
ImageList = '.\BMPS\calib_table.bmp'
ImageList<2> = 2
ImageList<3> = 'Auto'
Set_Property(EquipmentTable$, 'OLE.ImageList', ImageList)
// Qualify OLE events that we want to intercept
Qualifier = ''
Qualifier<1> = True$
Qualifier<4> = False$ ; * process synchronously (i.e. immediately)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.AfterUpdate', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnClick', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnButtonClick', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnContextMenuClick', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.PosChanged', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnComboClicked', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnHeaderClick', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnCheckChanged', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.AfterUpdate', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnContextMenuClick', Qualifier)
Send_Message(EquipmentTable$, 'QUALIFY_EVENT', 'OLE.OnDblClick', Qualifier)
//NIST Standard
// Setup Nist OLE Edit Table
ArrayDimension = 9 : @FM : 50
TitleList = 'CL No ' : @VM
TitleList := 'Dept' : @VM
TitleList := 'NIST Standard ' : @VM
TitleList := 'S/N ' : @VM
TitleList := 'Location / Status ' : @VM
TitleList := 'Interval ' : @VM
ColumnWidths = '60' : @FM : '50' : @FM : '287' : @FM : '80' : @FM : '140' : @FM : '70' : @FM
ColumnAlignments = 'C' : @FM : 'C' : @FM : 'L' : @FM : 'L' : @FM : 'L' : @FM : 'C' : @FM
TitleList := 'Cal Loc' : @VM : 'Last Cal ' : @VM : 'Next Cal '
ColumnWidths := '60' : @FM : '70' : @FM : '70'
ColumnAlignments := 'C' : @FM : 'C' : @FM : 'C'
VirtualPos = ''
RowsAsColumns = ''
CellsAsFields = ''
ClearFill = ''
OIEditTable = ''
SRP_EditTable_Manager('Setup1', NistTable$, ArrayDimension, TitleList, ColumnWidths, ColumnAlignments, VirtualPos, RowsAsColumns, CellsAsFields, ClearFill, OIEditTable)
Set_Property(NistTable$, 'OLE.SelectionStyle', 'Black' : @VM : OI_HOT_BLUE$ : ' L=70' : @FM : 'Black' : @VM : OI_HOT_BLUE$) ; // Automatically highlight the current row with one color and highlight the current row with another color.
Set_Property(NistTable$, 'OLE.HeaderFont[All; All]', 'Segoe UI' : @SVM : 8)
Set_Property(NistTable$, 'OLE.CellFont[All; All]', 'Segoe UI' : @SVM : 8)
Set_Property(NistTable$, 'OLE.HeaderColumn[1]', '' : @FM : False$ : @FM : False$ : @FM)
Set_Property(NistTable$, 'OLE.CellProtection[ALL; All]', 'SEL')
Set_Property(NistTable$, 'OLE.NewRowCount', 0)
Set_Property(NistTable$, 'OLE.HeaderRow[ALL]', '' : @FM : '' : @FM : False$ : @FM)
Set_Property(NistTable$, 'OLE.DataColumn[ALL]', '' : @FM : '' : @FM : False$ : @FM)
Set_Property(NistTable$, 'OLE.DataRow[ALL]', '' : @FM : '' : @FM : False$ : @FM)
Set_Property(NistTable$, 'OLE.HeaderColors[All; All]', 'Auto' : @FM : 'None' : @FM : 'None' : @FM : OI_HOT_BLUE$ : @FM : False$)
Set_Property(NistTable$, 'OLE.ResetSelPos', False$)
HeaderAlignArray = 'Center':@FM:'Left':@FM:'Right'
Set_Property(NistTable$, "OLE.HeaderAlignment[All; 1]", HeaderAlignArray)
Set_Property(NistTable$, 'OLE.AllowDeletions', False$)
Set_Property(NistTable$, 'OLE.AllowInserts', False$)
ImageList = '.\BMPS\calib_table.bmp'
ImageList<2> = 2
ImageList<3> = 'Auto'
Set_Property(NistTable$, 'OLE.ImageList', ImageList)
// Qualify OLE events that we want to intercept
Qualifier = ''
Qualifier<1> = True$
Qualifier<4> = False$ ; * process synchronously (i.e. immediately)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.AfterUpdate', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnClick', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnButtonClick', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnContextMenuClick', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.PosChanged', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnComboClicked', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnHeaderClick', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnCheckChanged', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.AfterUpdate', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnContextMenuClick', Qualifier)
Send_Message(NistTable$, 'QUALIFY_EVENT', 'OLE.OnDblClick', Qualifier)
GoSub LoadSearchData
return
LoadSearchData:
Set_Property(EquipmentTable$, 'OLE.Redraw', False$)
Set_Property(NistTable$, 'OLE.Redraw', False$)
EquipmentList = Calibration_Services('GetCalibListData', 'Equipment')
NistList = Calibration_Services('GetCalibListData', 'NIST')
NumRows = DCount(EquipmentList, @FM) + 1
ArrayDimension = 9 : @FM : NumRows
Set_Property(EquipmentTable$, 'OLE.LIST', EquipmentList)
NumRows = DCount(NistList, @FM) + 1
ArrayDimension = 9 : @FM : NumRows
Set_Property(NistTable$, 'OLE.LIST', NistList)
// Save the full lists to user defined properties for later reference by filters
Set_Property(@Window, '@MASTER_EQUIPMENT_LIST', EquipmentList)
Set_Property(@Window, '@MASTER_NIST_LIST', NistList)
GoSub BuildEquipmentFilterLists
GoSub ApplyEquipmentFilters
GoSub ColorEquipmentTable
GoSub BuildNistFilterLists
GoSub ApplyNistFilters
GoSub ColorNistTable
Set_Property(EquipmentTable$, 'OLE.Redraw', True$)
Set_Property(NistTable$, 'OLE.Redraw', True$)
return
BuildEquipmentFilterLists:
UserConfigRec = Database_Services('ReadDataRow', 'USER_CONFIG', @User4:'*':@Window)
UserConfigProps = UserConfigRec<USER_CONFIG.PROPERTY$>
UserConfigVals = UserConfigRec<USER_CONFIG.VALUE$>
EquipmentList = Get_Property(@Window, '@MASTER_EQUIPMENT_LIST')
EquipmentList = SRP_Array('Rotate', EquipmentList, @FM, @VM)
For each Column in EquipmentList using @FM setting fPos
Blanks = False$
Locate "" in Column using @VM setting Dummy then Blanks = True$
CleanCol = SRP_Array('Clean', Column, 'TrimAndMakeUnique', @VM)
Begin Case
Case ( (fPos EQ 1) or (fPos EQ 6) )
// Numerical sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
Case ( (fPos EQ 8) or (fPos EQ 9) )
// Date sort
CleanCol = IConv(CleanCol, 'D')
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
CleanCol = OConv(CleanCol, 'D4/')
Case Otherwise$
// String sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingText', @VM)
End Case
If Blanks then CleanCol <0, -1> = '(Blanks)'
NumVals = DCount(CleanCol, @VM)
SelFilterArray = Str(True$:@VM, NumVals)
SelFilterArray = Delete(SelFilterArray, 0, NumVals + 1, 0)
// Merge user preferences with any new filter values
UserFilterVals = ''
UserSelFilters = ''
Locate '@EQUIPMENT_FILTER_ARRAY_':fPos in UserConfigProps using @VM setting vPos then
UserFilterVals = UserConfigVals<0, vPos>
end
Locate '@EQUIPMENT_SEL_FILTER_ARRAY_':fPos in UserConfigProps using @VM setting vPos then
UserSelFilters = UserConfigVals<0, vPos>
end
If UserFilterVals NE '' then
For each UserFilterVal in UserFilterVals using @SVM setting svPos
Locate UserFilterVal in CleanCol using @VM setting cPos then
SelFilterArray<0, cPos> = UserSelFilters<0, 0, svPos>
end
Next UserFilterVal
end
Set_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':fPos, CleanCol)
Set_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':fPos, SelFilterArray)
Next Column
return
BuildNistFilterLists:
UserConfigRec = Database_Services('ReadDataRow', 'USER_CONFIG', @User4:'*':@Window)
UserConfigProps = UserConfigRec<USER_CONFIG.PROPERTY$>
UserConfigVals = UserConfigRec<USER_CONFIG.VALUE$>
NistList = Get_Property(@Window, '@MASTER_NIST_LIST')
NistList = SRP_Array('Rotate', NistList, @FM, @VM)
For each Column in NistList using @FM setting fPos
Blanks = False$
Locate "" in Column using @VM setting Dummy then Blanks = True$
CleanCol = SRP_Array('Clean', Column, 'TrimAndMakeUnique', @VM)
Begin Case
Case ( (fPos EQ 1) or (fPos EQ 6) )
// Numerical sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
Case ( (fPos EQ 8) or (fPos EQ 9) )
// Date sort
CleanCol = IConv(CleanCol, 'D')
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingNumbers', @VM)
CleanCol = OConv(CleanCol, 'D4/')
Case Otherwise$
// String sort
CleanCol = SRP_Array('SortSimpleList', CleanCol, 'AscendingText', @VM)
End Case
If Blanks then CleanCol <0, -1> = '(Blanks)'
NumVals = DCount(CleanCol, @VM)
SelFilterArray = Str(True$:@VM, NumVals)
SelFilterArray = Delete(SelFilterArray, 0, NumVals + 1, 0)
// Merge user preferences with any new filter values
UserFilterVals = ''
UserSelFilters = ''
Locate '@NIST_FILTER_ARRAY_':fPos in UserConfigProps using @VM setting vPos then
UserFilterVals = UserConfigVals<0, vPos>
end
Locate '@NIST_SEL_FILTER_ARRAY_':fPos in UserConfigProps using @VM setting vPos then
UserSelFilters = UserConfigVals<0, vPos>
end
If UserFilterVals NE '' then
For each UserFilterVal in UserFilterVals using @SVM setting svPos
Locate UserFilterVal in CleanCol using @VM setting cPos then
SelFilterArray<0, cPos> = UserSelFilters<0, 0, svPos>
end
Next UserFilterVal
end
Set_Property(@Window, '@NIST_FILTER_ARRAY_':fPos, CleanCol)
Set_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':fPos, SelFilterArray)
Next Column
return
ColorEquipmentTable:
Today = Date()
TableData = Get_Property(EquipmentTable$, 'OLE.LIST')
For each Row in TableData using @FM setting RowPos
CLNo = Row<0, COL$CL_NO>
NextCalDt = XLATE('CALIB_LIST', CLNo, 'NEXT_CAL_DT', 'X')
BEGIN CASE
CASE Row<0, COL$EQ_LOC>[1,14] = 'Out of Service' ; LineColor = LTGREY$
CASE NextCalDt = '' ; LineColor = WHITE$
CASE Row<0, COL$EQ_LOC>[1,19] = 'Out for Calibration' ; LineColor = ORANGE$
CASE (Today GT NextCalDt) ; LineColor = RED$
CASE (NextCalDt - Today) LE 15 ; LineColor = YELLOW$
CASE Otherwise$ ; LineColor = GREEN$
END CASE
ColorArray = Get_Property(EquipmentTable$, 'OLE.CellColors[All; ':RowPos:']')
ColorArray<2> = LineColor
Set_Property(EquipmentTable$, 'OLE.CellColors[All; ':RowPos:']', ColorArray)
Next Row
return
ColorNistTable:
Today = Date()
TableData = Get_Property(NistTable$, 'OLE.LIST')
For each Row in TableData using @FM setting RowPos
CLNo = Row<0, COL$CL_NO>
NextCalDt = XLATE('CALIB_LIST', CLNo, 'NEXT_CAL_DT', 'X')
BEGIN CASE
CASE Row<0, COL$EQ_LOC>[1,14] = 'Out of Service' ; LineColor = LTGREY$
CASE NextCalDt = '' ; LineColor = WHITE$
CASE Row<0, COL$EQ_LOC>[1,19] = 'Out for Calibration' ; LineColor = ORANGE$
CASE (Today GT NextCalDt) ; LineColor = RED$
CASE (NextCalDt - Today) LE 15 ; LineColor = YELLOW$
CASE Otherwise$ ; LineColor = GREEN$
END CASE
ColorArray = Get_Property(NistTable$, 'OLE.CellColors[All; ':RowPos:']')
ColorArray<2> = LineColor
Set_Property(NistTable$, 'OLE.CellColors[All; ':RowPos:']', ColorArray)
Next Row
return
GetEquipmentFilterData:
// Get available data with all other filters applied, but not with the current column filters applied.
Cols = 'CL_NO,DEPT,EQ_DESC,EQ_SN,EQ_LOC,CAL_INTERVAL,CAL_LOC,LAST_CAL_DT,NEXT_CAL_DT'
Swap ',' with @VM in Cols
SelectStr = 'SELECT CALIB_LIST '
// Check column filter lists 1 - 9 for selected filters and apply them.
For ColIndex = 1 to 9
// Ignore current column filters
If ColIndex NE ColumnPos then
FilterList = Get_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':ColIndex)
SelFilterList = Get_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':ColIndex)
For each SelFilter in SelFilterList using @VM setting vPos
If SelFilter EQ 0 then
If FilterList<0, vPos> NE '(Blanks)' then
FormatVal = FilterList<0, vPos>
end else
FormatVal = ''
end
If Index(FormatVal, '"', 1) then
SelectStr := "WITH ":Cols<0, ColIndex>:" NE '":FormatVal:"' AND "
end else
SelectStr := 'WITH ':Cols<0, ColIndex>:' NE "':FormatVal:'" AND '
end
end
Next SelFilter
end
Next ColIndex
If SelectStr[-1, -5] EQ ' DNA ' then SelectStr[-1, -5] = ''
RList(SelectStr, TARGET_ACTIVELIST$, '', '', '')
ErrCode = ''
If Not(Get_Status(ErrCode)) then
EquipmentList = Calibration_Services('GetCalibListData', 'Equipment', True$)
end
return
GetNistFilterData:
// Get available data with all other filters applied, but not with the current column filters applied.
Cols = 'CL_NO,DEPT,STD_DESC,STD_SN,STD_LOC,CAL_INTERVAL,CAL_LOC,LAST_CAL_DT,NEXT_CAL_DT'
Swap ',' with @VM in Cols
SelectStr = 'SELECT CALIB_LIST '
// Check column filter lists 1 - 9 for selected filters and apply them.
For ColIndex = 1 to 9
// Ignore current column filters
If ColIndex NE ColumnPos then
FilterList = Get_Property(@Window, '@NIST_FILTER_ARRAY_':ColIndex)
SelFilterList = Get_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':ColIndex)
For each SelFilter in SelFilterList using @VM setting vPos
If SelFilter EQ 0 then
If FilterList<0, vPos> NE '(Blanks)' then
FormatVal = FilterList<0, vPos>
end else
FormatVal = ''
end
If Index(FormatVal, '"', 1) then
SelectStr := "WITH ":Cols<0, ColIndex>:" NE '":FormatVal:"' AND "
end else
SelectStr := 'WITH ':Cols<0, ColIndex>:' NE "':FormatVal:'" AND '
end
end
Next SelFilter
end
Next ColIndex
If SelectStr[-1, -5] EQ ' DNA ' then SelectStr[-1, -5] = ''
RList(SelectStr, TARGET_ACTIVELIST$, '', '', '')
ErrCode = ''
If Not(Get_Status(ErrCode)) then
NistList = Calibration_Services('GetCalibListData', 'NIST', True$)
end
return
ApplyEquipmentFilters:
Cols = 'CL_NO,DEPT,EQ_DESC,EQ_SN,EQ_LOC,CAL_INTERVAL,CAL_LOC,LAST_CAL_DT,NEXT_CAL_DT'
Swap ',' with @VM in Cols
SelectStr = 'SELECT CALIB_LIST '
// Check column filter lists 1 - 9 for selected filters and apply them.
For ColIndex = 1 to 9
FilterList = Get_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':ColIndex)
SelFilterList = Get_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':ColIndex)
For each SelFilter in SelFilterList using @VM setting vPos
If SelFilter EQ 0 then
If FilterList<0, vPos> NE '(Blanks)' then
FormatVal = FilterList<0, vPos>
end else
FormatVal = ''
end
If Index(FormatVal, '"', 1) then
SelectStr := "WITH ":Cols<0, ColIndex>:" NE '":FormatVal:"' AND "
end else
SelectStr := 'WITH ':Cols<0, ColIndex>:' NE "':FormatVal:'" AND '
end
end
Next SelFilter
Next ColIndex
If SelectStr[-1, -5] EQ ' DNA ' then SelectStr[-1, -5] = ''
RList(SelectStr, TARGET_ACTIVELIST$, '', '', '')
ErrCode = ''
If Not(Get_Status(ErrCode)) then
EquipmentList = Calibration_Services('GetCalibListData', 'Equipment', True$)
Set_Property(EquipmentTable$, 'OLE.LIST', EquipmentList)
GoSub ColorEquipmentTable
GoSub UpdateEquipmentHeaders
end
return
ApplyNistFilters:
Cols = 'CL_NO,DEPT,STD_DESC,STD_SN,STD_LOC,CAL_INTERVAL,CAL_LOC,LAST_CAL_DT,NEXT_CAL_DT'
Swap ',' with @VM in Cols
SelectStr = 'SELECT CALIB_LIST '
// Check column filter lists 1 - 9 for selected filters and apply them.
For ColIndex = 1 to 9
FilterList = Get_Property(@Window, '@NIST_FILTER_ARRAY_':ColIndex)
SelFilterList = Get_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':ColIndex)
For each SelFilter in SelFilterList using @VM setting vPos
If SelFilter EQ 0 then
If FilterList<0, vPos> NE '(Blanks)' then
FormatVal = FilterList<0, vPos>
end else
FormatVal = ''
end
If Index(FormatVal, '"', 1) then
SelectStr := "WITH ":Cols<0, ColIndex>:" NE '":FormatVal:"' AND "
end else
SelectStr := 'WITH ':Cols<0, ColIndex>:' NE "':FormatVal:'" AND '
end
end
Next SelFilter
Next ColIndex
If SelectStr[-1, -5] EQ ' DNA ' then SelectStr[-1, -5] = ''
RList(SelectStr, TARGET_ACTIVELIST$, '', '', '')
ErrCode = ''
If Not(Get_Status(ErrCode)) then
NistList = Calibration_Services('GetCalibListData', 'NIST', True$)
Set_Property(NistTable$, 'OLE.LIST', NistList)
GoSub ColorNistTable
GoSub UpdateNistHeaders
end
return
SaveUserFilters:
UserConfigRec = Database_Services('ReadDataRow', 'USER_CONFIG', @User4:'*':@Window)
UserConfigProps = UserConfigRec<USER_CONFIG.PROPERTY$>
UserConfigVals = UserConfigRec<USER_CONFIG.VALUE$>
For ColumnPos = 1 to 9
EquipFilterVals = Get_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':ColumnPos)
SelEquipVals = Get_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':ColumnPos)
NistFilterVals = Get_Property(@Window, '@NIST_FILTER_ARRAY_':ColumnPos)
SelNistVals = Get_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':ColumnPos)
Swap @VM with @SVM in EquipFilterVals
Swap @VM with @SVM in SelEquipVals
Swap @VM with @SVM in NistFilterVals
Swap @VM with @SVM in SelNistVals
Property = '@EQUIPMENT_FILTER_ARRAY_':ColumnPos
Locate Property in UserConfigProps using @VM setting PropVpos else
PropVpos = -1
end
UserConfigProps<0, PropVpos> = Property
UserConfigVals<0, PropVpos> = EquipFilterVals
Property = '@EQUIPMENT_SEL_FILTER_ARRAY_':ColumnPos
Locate Property in UserConfigProps using @VM setting PropVpos else
PropVpos = -1
end
UserConfigProps<0, PropVpos> = Property
UserConfigVals<0, PropVpos> = SelEquipVals
Property = '@NIST_FILTER_ARRAY_':ColumnPos
Locate Property in UserConfigProps using @VM setting PropVpos else
PropVpos = -1
end
UserConfigProps<0, PropVpos> = Property
UserConfigVals<0, PropVpos> = NistFilterVals
Property = '@NIST_SEL_FILTER_ARRAY_':ColumnPos
Locate Property in UserConfigProps using @VM setting PropVpos else
PropVpos = -1
end
UserConfigProps<0, PropVpos> = Property
UserConfigVals<0, PropVpos> = SelNistVals
Next ColumnPos
UserConfigRec<USER_CONFIG.PROPERTY$> = UserConfigProps
UserConfigRec<USER_CONFIG.VALUE$> = UserConfigVals
Database_Services('WriteDataRow', 'USER_CONFIG', @User4:'*':@Window, UserConfigRec)
return
UpdateEquipmentHeaders:
For Column = 1 to 9
FilterVals = Get_Property(@Window, '@EQUIPMENT_FILTER_ARRAY_':Column)
SelFilters = Get_Property(@Window, '@EQUIPMENT_SEL_FILTER_ARRAY_':Column)
NumFilters = DCount(FilterVals, @VM)
NumSelFilters = Sum(SelFilters)
If NumFilters NE NumSelFilters then
Set_Property(EquipmentTable$, "OLE.HeaderImage[":Column + 1:"; 1]", 2)
end else
Set_Property(EquipmentTable$, "OLE.HeaderImage[":Column + 1:"; 1]", 1)
end
Next Column
return
UpdateNistHeaders:
For Column = 1 to 9
FilterVals = Get_Property(@Window, '@NIST_FILTER_ARRAY_':Column)
SelFilters = Get_Property(@Window, '@NIST_SEL_FILTER_ARRAY_':Column)
NumFilters = DCount(FilterVals, @VM)
NumSelFilters = Sum(SelFilters)
If NumFilters NE NumSelFilters then
Set_Property(NistTable$, "OLE.HeaderImage[":Column + 1:"; 1]", 2)
end else
Set_Property(NistTable$, "OLE.HeaderImage[":Column + 1:"; 1]", 1)
end
Next Column
return