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 = '2' ;* Multiple Select TypeOver = '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 = '2' ;* Multiple Select TypeOver = '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 = '2' ;* Multiple Select TypeOver = '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 = '2' TypeOver = 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 = '2' TypeOver = 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 = '2' ;* Multiple Select TypeOver = '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 = Code CtrlList = 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') LOOP TestChar = ReactItemTypes[-1,1] UNTIL TestChar NE @VM OR ReactItemTypes = '' ReactItemTypes[-1,1] = '' REPEAT * CurrStatus * CurrStatus = Get_Property(@WINDOW:'.CURR_STATUS','ARRAY') LOOP TestChar = CurrStatus[-1,1] UNTIL TestChar NE @VM OR CurrStatus = '' CurrStatus[-1,1] = '' REPEAT * SerialNos * SerialNos = Get_Property(@WINDOW:'.SERIAL_NO','DEFPROP') LOOP TestChar = SerialNos[-1,1] UNTIL TestChar NE @VM OR SerialNos = '' SerialNos[-1,1] = '' REPEAT * PartTypes * PartTypes = Get_Property(@WINDOW:'.PART_TYPE','ARRAY') LOOP TestChar = PartTypes[-1,1] UNTIL TestChar NE @VM OR PartTypes = '' PartTypes[-1,1] = '' REPEAT * MfrCodes * MfrCodes = Get_Property(@WINDOW:'.MFR_CD','ARRAY') LOOP TestChar = MfrCodes[-1,1] UNTIL TestChar NE @VM OR MfrCodes = '' MfrCodes[-1,1] = '' REPEAT * MfrPartNos * MfrPartNos = Get_Property(@WINDOW:'.MFR_PART_NO','ARRAY') 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 ':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 = "Selecting Reactor Events..." Def = "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