open-insight/LSL2/STPROC/DIALOG_REACT_ITEM_QUERY.txt
2025-05-27 18:38:30 +02:00

505 lines
9.9 KiB
Plaintext

COMPILE FUNCTION Dialog_React_Item_Query(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5)
/*
Commuter module for Dialog_React_Item_Query window.
03/05/2014 - John C. Henry, J.C. Henry & Co., Inc.
*/
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, ErrMsg, RList
DECLARE SUBROUTINE obj_Appwindow, Start_Window, Btree.Extract, Msg, Send_Info
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Send_Message, Popup, Collect.IXVals, Msg
$INSERT APPCOLORS
$INSERT MSG_EQUATES
$INSERT RLIST_EQUATES
$INSERT POPUP_EQUATES
EQU CRLF$ TO \0D0A\
EQU COL$CODE TO 1
EQU COL$DESC TO 2
ErrTitle = 'Error in Dialog_React_Item_Query'
ErrorMsg = ''
ErrCode = ''
Result = ''
BEGIN CASE
CASE EntID = @WINDOW
BEGIN CASE
CASE Event = 'Create' ; GOSUB Create
END CASE
CASE EntID = @WINDOW:'.LU_RI_TYPE' AND Event = 'CLICK' ; GOSUB LURIType
CASE EntID = @WINDOW:'.LU_PART_TYPE' AND Event = 'CLICK' ; GOSUB LUPartTYpe
CASE EntID = @WINDOW:'.LU_MFR_CD' AND Event = 'CLICK' ; GOSUB LUMfrCd
CASE EntID = @WINDOW:'.LU_MFR_PART_NO' AND Event = 'CLICK' ; GOSUB LUMfrPartNo
CASE EntID = @WINDOW:'.LU_SERIAL_NO' AND Event = 'CLICK' ; GOSUB LUSerialNo
CASE EntID = @WINDOW:'.LU_CURR_STATUS' AND Event = 'CLICK' ; GOSUB LUCurrStatus
CASE EntID = @WINDOW:'.LU_ENTER_START_DT' AND Event = 'CLICK' ; GOSUB LUEnterStartDt
CASE EntID = @WINDOW:'.LU_ENTER_END_DT' AND Event = 'CLICK' ; GOSUB LUEnterEndDt
CASE EntID = @WINDOW:'.QUERY_BUTTON' AND Event = 'CLICK' ; GOSUB Query
CASE EntID = @WINDOW:'.CANCEL_BUTTON' AND Event = 'CLICK' ; GOSUB Cancel
CASE EntID = @WINDOW:'.ALL_ACTIVE' AND Event = 'CLICK' ; GOSUB AllActive
/*
CASE EntID = @WINDOW:'.LU_SUSC_SIZE' AND Event = 'CLICK' ; GOSUB LUSuscSize
CASE EntID = @WINDOW:'.LU_PKT_SIZE' AND Event = 'CLICK' ; GOSUB LUPktSize
CASE EntID = @WINDOW:'.LU_PKT_QTY' AND Event = 'CLICK' ; GOSUB LUPktQty
*/
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')
Set_Property(@WINDOW,'STATUSLINE',@WINDOW:'.STATUSLINE_FIX')
GOSUB Refresh
RETURN
* * * * * * *
Refresh:
* * * * * * *
RETURN
* * * * * * *
LURIType:
* * * * * * *
Set_Status(0)
TypeOver = ''
TypeOver<PSELECT$> = '2' ;* Multiple Select
TypeOver<PTYPE$> = 'E' ;* Return entire row
RetVal = Popup(@WINDOW,TypeOver,'REACT_ITEM_TYPE')
IF RetVal NE '' THEN
Set_Property(@WINDOW:'.REACT_ITEM_TYPE','LIST',RetVal)
LineCnt = COUNT(RetVal,@FM) + (RetVal NE '')
ColCnt = 2
FOR Line = 1 TO LineCnt
FOR Column = 2 TO ColCnt
stat = Send_Message(@WINDOW:'.REACT_ITEM_TYPE','COLOR_BY_POS',Column,Line,GREEN$)
NEXT Column
NEXT Line
END
RETURN
* * * * * * *
LUPartType:
* * * * * * *
Set_Status(0)
TypeOver = ''
TypeOver<PSELECT$> = '2' ;* Multiple Select
TypeOver<PTYPE$> = 'E' ;* Return entire row
RetVal = Popup(@WINDOW,TypeOver,'RI_PART_TYPE')
IF RetVal NE '' THEN
Set_Property(@WINDOW:'.PART_TYPE','LIST',RetVal)
LineCnt = COUNT(RetVal,@FM) + (RetVal NE '')
ColCnt = 2
FOR Line = 1 TO LineCnt
FOR Column = 2 TO ColCnt
stat = Send_Message(@WINDOW:'.PART_TYPE','COLOR_BY_POS',Column,Line,GREEN$)
NEXT Column
NEXT Line
END
RETURN
* * * * * * *
LUMfrCd:
* * * * * * *
Set_Status(0)
TypeOver = ''
TypeOver<PSELECT$> = '2' ;* Multiple Select
TypeOver<PTYPE$> = 'E' ;* Return entire row
RetVal = Popup(@WINDOW,TypeOver,'REACT_VENDOR')
IF RetVal NE '' THEN
Set_Property(@WINDOW:'.MFR_CD','LIST',RetVal)
LineCnt = COUNT(RetVal,@FM) + (RetVal NE '')
ColCnt = 2
FOR Line = 1 TO LineCnt
FOR Column = 2 TO ColCnt
stat = Send_Message(@WINDOW:'.MFR_CD','COLOR_BY_POS',Column,Line,GREEN$)
NEXT Column
NEXT Line
END
RETURN
* * * * * * *
LUMfrPartNo:
* * * * * * *
MfrPartNos = Collect.IXVals('REACT_ITEM', 'MFR_PART_NO')
CONVERT @FM TO @VM IN MfrPartNos
TypeOver = ''
TypeOver<PSELECT$> = '2'
TypeOver<PDISPLAY$> = MfrPartNos
RetVal = Popup(@WINDOW,TypeOver,'REACT_ITEM_PART_NO')
CONVERT @VM TO @FM IN RetVAl
IF RetVal NE '' THEN
Set_Property(@WINDOW:'.MFR_PART_NO','LIST',RetVal)
END
RETURN
* * * * * * *
LUSerialNo:
* * * * * * *
SerialNos = Collect.IXVals('REACT_ITEM', 'SERIAL_NO')
CONVERT @FM TO @VM IN SerialNos
TypeOver = ''
TypeOver<PSELECT$> = '2'
TypeOver<PDISPLAY$> = SerialNos
RetVal = Popup(@WINDOW,TypeOver,'REACT_ITEM_SERIAL_NO')
CONVERT @VM TO @FM IN RetVAl
IF RetVal NE '' THEN
Set_Property(@WINDOW:'.SERIAL_NO','LIST',RetVal)
END
RETURN
* * * * * * *
LUCurrStatus:
* * * * * * *
Set_Status(0)
TypeOver = ''
TypeOver<PSELECT$> = '2' ;* Multiple Select
TypeOver<PTYPE$> = 'E' ;* Return entire row
RetVal = Popup(@WINDOW,TypeOver,'REACT_ITEM_STATUS')
IF RetVal NE '' THEN
Set_Property(@WINDOW:'.CURR_STATUS','LIST',RetVal)
LineCnt = COUNT(RetVal,@FM) + (RetVal NE '')
ColCnt = 2
FOR Line = 1 TO LineCnt
FOR Column = 2 TO ColCnt
stat = Send_Message(@WINDOW:'.CURR_STATUS','COLOR_BY_POS',Column,Line,GREEN$)
NEXT Column
NEXT Line
END
RETURN
* * * * * * *
LUEnterStartDt:
* * * * * * *
ReturnCtrl = @WINDOW:'.ENTER_START_DT'
DateSelected = Dialog_Box('POPUP_YEAR',@WINDOW)
RetVal = OCONV(DateSelected, 'D4/')
IF RetVal NE '' THEN
obj_Appwindow('LUValReturn',RetVal:@RM:ReturnCtrl)
END
RETURN
* * * * * * *
LUEnterEndDt:
* * * * * * *
ReturnCtrl = @WINDOW:'.ENTER_END_DT'
DateSelected = Dialog_Box('POPUP_YEAR',@WINDOW)
RetVal = OCONV(DateSelected, 'D4/')
IF RetVal NE '' THEN
obj_Appwindow('LUValReturn',RetVal:@RM:ReturnCtrl)
END
RETURN
* * * * * * *
AllActive:
* * * * * * *
CtrlList = Get_Property(@WINDOW:'.CURR_STATUS','LIST')
LineCnt = COUNT(CtrlList,@FM) + (CtrlList NE '')
Vals = XLATE('SYSREPOSPOPUPS','LSL2**REACT_ITEM_STATUS',PDISPLAY$,'X')
ValCnt = COUNT(Vals,@VM) + (Vals NE '')
Line = 1
FOR I = 1 TO ValCnt
Code = Vals<1,I,1>
IF Code NE 'R' THEN
CtrlList<Line,1> = Code
CtrlList<Line,2> = Vals<1,I,2>
Line += 1
END
NEXT I
Set_Property(@WINDOW:'.CURR_STATUS','LIST',CtrlList)
ColCnt = 2
FOR Line = 1 TO LineCnt
FOR Column = 2 TO ColCnt
stat = Send_Message(@WINDOW:'.CURR_STATUS','COLOR_BY_POS',Column,Line,GREEN$)
NEXT Column
NEXT Line
RETURN
* * * * * * *
Cancel:
* * * * * * *
End_Dialog(@WINDOW,'')
RETURN
* * * * * * *
Query:
* * * * * * *
* ReactItemTypes *
ReactItemTypes = Get_Property(@WINDOW:'.REACT_ITEM_TYPE','ARRAY')<COL$CODE>
LOOP
TestChar = ReactItemTypes[-1,1]
UNTIL TestChar NE @VM OR ReactItemTypes = ''
ReactItemTypes[-1,1] = ''
REPEAT
* CurrStatus *
CurrStatus = Get_Property(@WINDOW:'.CURR_STATUS','ARRAY')<COL$CODE>
LOOP
TestChar = CurrStatus[-1,1]
UNTIL TestChar NE @VM OR CurrStatus = ''
CurrStatus[-1,1] = ''
REPEAT
* SerialNos *
SerialNos = Get_Property(@WINDOW:'.SERIAL_NO','DEFPROP')<COL$CODE>
LOOP
TestChar = SerialNos[-1,1]
UNTIL TestChar NE @VM OR SerialNos = ''
SerialNos[-1,1] = ''
REPEAT
* PartTypes *
PartTypes = Get_Property(@WINDOW:'.PART_TYPE','ARRAY')<COL$CODE>
LOOP
TestChar = PartTypes[-1,1]
UNTIL TestChar NE @VM OR PartTypes = ''
PartTypes[-1,1] = ''
REPEAT
* MfrCodes *
MfrCodes = Get_Property(@WINDOW:'.MFR_CD','ARRAY')<COL$CODE>
LOOP
TestChar = MfrCodes[-1,1]
UNTIL TestChar NE @VM OR MfrCodes = ''
MfrCodes[-1,1] = ''
REPEAT
* MfrPartNos *
MfrPartNos = Get_Property(@WINDOW:'.MFR_PART_NO','ARRAY')<COL$CODE>
LOOP
TestChar = MfrPartNos[-1,1]
UNTIL TestChar NE @VM OR MfrPartNos = ''
MfrPartNos[-1,1] = ''
REPEAT
* Start and End Enter Dates
EnterStartDt = OCONV(ICONV(Get_Property(@WINDOW:'.ENTER_START_DT','TEXT'),'D'),'D4')
EnterEndDt = OCONV(ICONV(Get_Property(@WINDOW:'.ENTER_END_DT','TEXT'),'D'),'D4')
SelectSent = ''
BEGIN CASE
CASE EnterStartDt NE '' AND EnterEndDt = ''
SelectSent := 'WITH ENTER_DT GE ':QUOTE(EnterStartDt)
CASE EnterStartDt = '' AND EnterEndDt NE ''
SelectSent := 'WITH ENTER_DT LE ':QUOTE(EnterEndDt)
CASE EnterStartDt NE '' AND EnterEndDt NE ''
SelectSent := 'WITH ENTER_DT GE ':QUOTE(EnterStartDt):' AND WITH ENTER_DT LE ':QUOTE(EnterEndDt)
CASE 1
NULL
END CASE
IF ReactItemTypes NE '' THEN
SWAP @VM WITH '" "' IN ReactItemTypes
IF SelectSent NE '' THEN SelectSent := ' AND'
SelectSent := ' WITH RI_TYPE ':QUOTE(ReactItemTypes)
END
IF CurrStatus NE '' THEN
SWAP @VM WITH '" "' IN CurrStatus
IF SelectSent NE '' THEN SelectSent := ' AND'
SelectSent := ' WITH CURR_STATUS_STATIC ':QUOTE(CurrStatus)
END
IF PartTypes NE '' THEN
SWAP @VM WITH '" "' in PartTypes
IF SelectSent NE '' THEN SelectSent := ' AND'
SelectSent := ' WITH PART_TYPE ':QUOTE(PartTypes)
END
IF SerialNos NE '' THEN
SWAP @VM WITH '" "' IN SerialNos
IF SelectSent NE '' THEN SelectSent := ' AND'
SelectSent := ' WITH SERIAL_NO ':QUOTE(SerialNos)
END
IF MfrCodes NE '' THEN
SWAP @VM WITH '" "' in MfrCodes
IF SelectSent NE '' THEN SelectSent := ' AND'
SelectSent := ' WITH MFR_CODE ':QUOTE(MfrCodes)
END
IF MfrPartNos NE '' THEN
SWAP @VM WITH '" "' in MfrPartNos
IF SelectSent NE '' THEN SelectSent := ' AND'
SelectSent := ' WITH MFR_PART_NO ':QUOTE(MfrPartNos)
END
SelectSent = 'SELECT REACT_ITEM ':SelectSent
Def = ""
Def<MTEXT$> = "Selecting Reactor Items..."
Def<MTYPE$> = "U"
* display the processing message and do the processing
MsgUp = Msg(@window, Def)
RList(SelectSent,TARGET_ACTIVELIST$,'','','')
IF Get_Status(errCode) THEN
Msg(@window, MsgUp)
ErrMsg(errCode)
RETURN
END ELSE
Msg(@window, MsgUp)
END
RINos = ''
Done = ''
LOOP
READNEXT RINo ELSE Done = 1
UNTIL Done
RINos := RINo:@VM
REPEAT
RINos [-1,1] = ''
End_Dialog(@WINDOW,RINos)
RETURN