COMPILE FUNCTION Comm_Dialog_COC_Query(Method, Parm1) /* Commuter module for Dialog_COC_Query window. 10/28/2005 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Set_Status, ErrMsg DECLARE SUBROUTINE obj_Appwindow, Start_Window, Msg, Btree.Extract, Comm_Dialog_Order_Find DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Popup, Utility, Key_Sort, Msg, Send_Message EQU CRLF$ TO \0D0A\ EQU COL$CUST_NO TO 1 ;* Customer edit table column equates EQU COL$CUST_NAME TO 2 EQU DTS_MULTIROW$ TO 512 EQU DTS_LARGEDATA$ TO 4096 $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT COC_EQU $INSERT APPCOLORS ErrTitle = 'Error in Comm_Dialog_COC_Query' ErrorMsg = '' Result = '' BEGIN CASE CASE Method = 'Create' ; GOSUB Create CASE Method = 'CustChar' ; GOSUB CustChar CASE Method = 'CustPC' ; GOSUB CustPC CASE Method = 'CustDC' ; GOSUB CustDC CASE Method = 'WONoDC' ; GOSUB WONoDC CASE Method = 'PONoDC' ; GOSUB PONoDC CASE Method = 'LotDC' ; GOSUB LotDC CASE Method = 'PartDC' ; GOSUB PartDC CASE Method = 'LUDate' ; GOSUB LUDate CASE Method = 'PerformQuery' ; GOSUB PerformQuery CASE Method = 'Cancel' ; GOSUB Cancel CASE Method = 'SelectStatusCodes' ; GOSUB SelectStatusCodes CASE 1 ErrMsg(ErrTitle:@SVM:'Unknown method ':QUOTE(Method):' passed to routine.') END CASE RETURN Result * * * * * * * Create: * * * * * * * obj_AppWindow('Create') Set_Property(@WINDOW:'.USER_ID','INVALUE',@USER4) * * * * * * * Refresh: * * * * * * * * Turn edit table symbolic column backgrounds to green stat = Send_Message(@WINDOW:'.CUST_INFO','COLOR_BY_POS',2,0,GREEN$) ;* Turn names column all rows green stat = Send_Message(@WINDOW:'.CURR_STATUS','COLOR_BY_POS',2,0,GREEN$) ;* Turn names column all rows green RETURN * * * * * * * CustChar: * * * * * * * CtrlName = @WINDOW:'.CUST_INFO' CustArray = Get_Property(CtrlName,'ARRAY') ;* Customer Information table CurrPos = Get_Property(CtrlName,'SELPOS') CurrRow = CurrPos<2> DataIn = CustArray IF LEN(DataIn) > 2 THEN ReturnToCtrl = CtrlName ReturnToPos = CurrPos IF NOT(NUM(DataIn)) THEN Set_Property(CtrlName,'CELLPOS','',CurrPos) ;* Clear characters input Start_Window('COMP_LOOKUP',@WINDOW,DataIn:@VM:'C':@FM:ReturnToCtrl:@FM:ReturnToPos,'','') END END RETURN * * * * * * * CustPC: * * * * * * * CtrlName = @WINDOW:'.CUST_INFO' CustList = Get_Property(CtrlName,'LIST') ;* Customer Information table CurrPos = Get_Property(CtrlName,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> CustNo = CustList IF CustNo NE '' THEN Set_Property(CtrlName,'CELLPOS',XLATE('COMPANY',CustNo,4,'X'),COL$CUST_NAME:@FM:CurrRow) END RETURN * * * * * * * CustDC: * * * * * * * CtrlName = @WINDOW:'.CUST_INFO' CustList = Get_Property(CtrlName,'LIST') ;* Customer Information table CurrPos = Get_Property(CtrlName,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> CustNo = CustList LineCnt = COUNT(CustList,@FM) + (CustList NE '') IF CustNo = '' THEN CustNos = Popup(@WINDOW,'','CUSTOMER') CustCnt = COUNT(CustNos,@VM) + (CustNos NE '') IF CustCnt > LineCnt THEN FOR I = 1 TO CustCnt stat = Send_Message(CtrlName,'INSERT',-1,@VM:@FM) ; * Add blank lines NEXT I END FOR I = CurrRow TO CurrRow + CustCnt CustNo = CustNos<1,I> CustName = XLATE('COMPANY',CustNo,4,'X') Set_Property(CtrlName,'CELLPOS',CustNo,COL$CUST_NO:@FM:I) Set_Property(CtrlName,'CELLPOS',CustName,COL$CUST_NAME:@FM:I) Set_Property(CtrlName,'SELPOS',COL$CUST_NO:@FM:I+1) NEXT I END ELSE ErrMsg('DoubleClick on the first empty Cust No field to view a popup of all Customers') END RETURN * * * * * * * PONoDC: * * * * * * * CustArray = Get_Property(@WINDOW:'.CUST_INFO','ARRAY') CustNos = CustArray LOOP LastCustNo = CustNos[-1,'B':@VM] UNTIL LastCustNo NE '' OR CustNos = '' CustNos[COL1(),99] = '' ;* Trim trailing blanks REPEAT IF CustNos = '' THEN RETURN * display the processing message and do the processing Def = "" Def = "Selecting PO Numbers..." Def = "U" MsgUp = Msg(@window, Def) OPEN 'DICT.ORDER' TO DictVar THEN SearchString = 'CUST_NO':@VM:CustNos:@VM:@FM SearchString := 'PO_NO':@VM:'#':@FM Btree.Extract(SearchString, 'ORDER', DictVar, OrderKeys, '', Flag) IF Get_Status(errCode) THEN Msg(@WINDOW,MsgUp) ErrMsg(errCode) RETURN END IF OrderKeys NE '' THEN RawPONos = XLATE('ORDER',OrderKeys,ORDER_PO_NO$,'X') IF Get_Status(errCode) THEN DEBUG PONos = '' FOR I = 1 TO COUNT(RawPONos,@VM) + (RawPONos NE '') RawPONo = RawPONos<1,I> LOCATE RawPONo IN PONos BY 'AL' USING @VM SETTING Pos ELSE PONos = INSERT(PONos,1,Pos,0,RawPONo) END NEXT I END ELSE PONos = '' END Msg(@WINDOW,MsgUp) IF PONos = '' THEN ErrMsg('No Purchase Orders on file for specified customer.') RETURN END PONos := @VM CONVERT @VM TO @RM IN PONos CALL V119('S','','D','R',PONos,'') IF Get_Status(errCode) THEN DEBUG CONVERT @RM TO @VM IN PONos PONos[-1,1] = '' ;* Strip trailing delimiter TypeOver = '' TypeOver = PONos PONos = Popup(@WINDow,TypeOver,'CUST_PO') IF Get_Status(errCode) THEN DEBUG IF PONos NE '' THEN PONos := @VM:@VM Set_Property(@WINDOW:'.PO_NO','DEFPROP',PONos) END END ELSE ErrMsg('Unable to open DICT.ORDER in COMM_DIALOG_ORDER_FIND.') END RETURN * * * * * * * WONoDC: * * * * * * * DEBUG CustArray = Get_Property(@WINDOW:'.CUST_INFO','ARRAY') CustNos = CustArray LOOP LastCustNo = CustNos[-1,'B':@VM] UNTIL LastCustNo NE '' OR CustNos = '' CustNos[COL1(),99] = '' ;* Trim trailing blanks REPEAT IF CustNos = '' THEN RETURN * display the processing message and do the processing Def = "" Def = "Selecting Work Order Numbers..." Def = "U" MsgUp = Msg(@window, Def) OPEN 'DICT.COC' TO DictVar THEN SearchString = 'CUST_NO':@VM:CustNos:@VM:@FM SearchString := 'WO':@VM:'#':@FM Btree.Extract(SearchString, 'COC', DictVar, ShipmentKeys, '', Flag) IF Get_Status(errCode) THEN Msg(@WINDOW,MsgUp) ErrMsg(errCode) RETURN END IF ShipmentKeys NE '' THEN RawWONos = XLATE('COC',ShipmentKeys,COC_WO$,'X') IF Get_Status(errCode) THEN DEBUG WONos = '' FOR I = 1 TO COUNT(RawWONos,@VM) + (RawWONos NE '') RawWONo = RawWONos<1,I> LOCATE RawWONo IN WONos BY 'AL' USING @VM SETTING Pos ELSE WONos = INSERT(WONos,1,Pos,0,RawWONo) END NEXT I END ELSE WONos = '' END Msg(@WINDOW,MsgUp) IF WONos = '' THEN ErrMsg('No Work Orders on file for specified customer.') RETURN END WONos := @VM CONVERT @VM TO @RM IN WONos CALL V119('S','','D','R',WONos,'') IF Get_Status(errCode) THEN DEBUG CONVERT @RM TO @VM IN WONos WONos[-1,1] = '' ;* Strip trailing delimiter TypeOver = '' TypeOver = WONos WONos = Popup(@WINDow,TypeOver,'CUST_PO') IF Get_Status(errCode) THEN DEBUG IF WONos NE '' THEN WONos := @VM:@VM Set_Property(@WINDOW:'.WO_NO','DEFPROP',WONos) END END ELSE ErrMsg('Unable to open DICT.COC in COMM_DIALOG_COC_QUERY.') END RETURN * * * * * * * LotDC: * * * * * * * DEBUG CustArray = Get_Property(@WINDOW:'.CUST_INFO','ARRAY') CustNos = CustArray LOOP LastCustNo = CustNos[-1,'B':@VM] UNTIL LastCustNo NE '' OR CustNos = '' CustNos[COL1(),99] = '' ;* Trim trailing blanks REPEAT IF CustNos = '' THEN RETURN * display the processing message and do the processing Def = "" Def = "Selecting PO Numbers..." Def = "U" MsgUp = Msg(@window, Def) OPEN 'DICT.ORDER' TO DictVar THEN SearchString = 'CUST_NO':@VM:CustNos:@VM:@FM SearchString := 'PO_NO':@VM:'#':@FM Btree.Extract(SearchString, 'ORDER', DictVar, OrderKeys, '', Flag) IF Get_Status(errCode) THEN Msg(@WINDOW,MsgUp) ErrMsg(errCode) RETURN END IF OrderKeys NE '' THEN RawPONos = XLATE('ORDER',OrderKeys,ORDER_PO_NO$,'X') IF Get_Status(errCode) THEN DEBUG PONos = '' FOR I = 1 TO COUNT(RawPONos,@VM) + (RawPONos NE '') RawPONo = RawPONos<1,I> LOCATE RawPONo IN PONos BY 'AL' USING @VM SETTING Pos ELSE PONos = INSERT(PONos,1,Pos,0,RawPONo) END NEXT I END ELSE PONos = '' END Msg(@WINDOW,MsgUp) IF PONos = '' THEN ErrMsg('No Purchase Orders on file for specified customer.') RETURN END PONos := @VM CONVERT @VM TO @RM IN PONos CALL V119('S','','D','R',PONos,'') IF Get_Status(errCode) THEN DEBUG CONVERT @RM TO @VM IN PONos PONos[-1,1] = '' ;* Strip trailing delimiter TypeOver = '' TypeOver = PONos PONos = Popup(@WINDow,TypeOver,'CUST_PO') IF Get_Status(errCode) THEN DEBUG IF PONos NE '' THEN PONos := @VM:@VM Set_Property(@WINDOW:'.PO_NO','DEFPROP',PONos) END END ELSE ErrMsg('Unable to open DICT.ORDER in COMM_DIALOG_ORDER_FIND.') END RETURN * * * * * * * PartDC: * * * * * * * DEBUG CustArray = Get_Property(@WINDOW:'.CUST_INFO','ARRAY') CustNos = CustArray LOOP LastCustNo = CustNos[-1,'B':@VM] UNTIL LastCustNo NE '' OR CustNos = '' CustNos[COL1(),99] = '' ;* Trim trailing blanks REPEAT IF CustNos = '' THEN RETURN * display the processing message and do the processing Def = "" Def = "Selecting Part Numbers..." Def = "U" MsgUp = Msg(@window, Def) OPEN 'DICT.WO_LOG' TO DictVar THEN SearchString = 'CUST_NO':@VM:CustNos:@VM:@FM SearchString := 'PART_NO':@VM:'#':@FM Btree.Extract(SearchString, 'WO_LOG', DictVar, WOKeys, '', Flag) IF Get_Status(errCode) THEN Msg(@WINDOW,MsgUp) ErrMsg(errCode) RETURN END IF WOKeys NE '' THEN PartNos = '' OrderNos = '' FOR N = 1 TO COUNT(WOKeys,@VM) + (WOKeys NE '') WOKey = WOKeys<1,N> RawPartNos = XLATE('WO_LOG',WOKey,'PART_NO','X') OrderNo = XLATE('WO_LOG',WOKey,WO_LOG_ORDER_NO$,'X') FOR I = 1 TO COUNT(RawPartNos,@VM) + (RawPartNos NE '') RawPartNo = RawPartNos<1,I> LOCATE RawPartNo IN PartNos BY 'AL' USING @VM SETTING Pos ELSE PartNos = INSERT(PartNos,1,Pos,0,RawPartNo) END LOCATE OrderNo IN OrderNos BY 'DR' USING @VM SETTING OPos ELSE OrderNos = INSERT(OrderNos,Pos,OPos,0,OrderNo) END NEXT I NEXT N END ELSE PartNos = '' END Msg(@WINDOW,MsgUp) IF PartNos = '' THEN ErrMsg('No Purchase Orders on file for specified customer.') RETURN END PartNos := @VM CONVERT @VM TO @RM IN PartNos CALL V119('S','','D','R',PartNos,'') IF Get_Status(errCode) THEN DEBUG CONVERT @RM TO @VM IN PartNos PartNos[-1,1] = '' ;* Strip trailing delimiter TypeOver = '' TypeOver = PartNos PartNos = Popup(@WINDow,TypeOver,'CUST_PO') IF Get_Status(errCode) THEN DEBUG IF PartNos NE '' THEN debug END END ELSE ErrMsg('Unable to open DICT.WO_LOG in COMM_DIALOG_ORDER_FIND.') END RETURN * * * * * * * SelectStatusCodes: * * * * * * * ReturnCtrl = @WINDOW:'.CURR_STATUS' TypeOver = '' TypeOver = 2 ;* Multiple select StatusCodes = Popup(@WINDOW,TypeOver,'RDS_CURR_STATUS') IF StatusCodes NE '' THEN ExistingArray = '' FOR I = 1 TO COUNT(StatusCodes,@VM) + (StatusCodes NE '') + 1 ExistingArray<1,I> = StatusCodes<1,I> ExistingArray<2,I> = OCONV(StatusCodes<1,I>,'[RDS_CURR_STATUS_CONV]') NEXT I Set_Property(@WINDOW:'.CURR_STATUS','DEFPROP',ExistingArray) END GOSUB Refresh RETURN * * * * * * * LUDate: * * * * * * * ReturnCtrl = Parm1[1,@RM] IF ReturnCtrl = '' THEN ReturnCtrl = Get_Property(@WINDOW,'FOCUS') DateSelected = Dialog_Box('POPUP_YEAR',@WINDOW) RetVal = OCONV(DateSelected, 'D4/') IF RetVal NE '' THEN obj_Appwindow('LUValReturn',RetVal:@RM:ReturnCtrl) END RETURN * * * * * * * Close: * * * * * * * * * * * * * * Cancel: * * * * * * * End_Dialog(@WINDOW,'Cancel') RETURN * * * * * * * PerformQuery: * * * * * * * open 'DICT.COC' to DictCOCTable else Void = msg( '', 'Unable to open DICT.COC...' ) return 0 end SearchStr = '' CustIds = Get_Property(@WINDOW:'.CUSTOMER_INFO','ARRAY')<1> EntryDateFrom = Get_Property(@WINDOW:'.ENTRY_DATE_FROM','TEXT') EntryDateThru = Get_Property(@WINDOW:'.ENTRY_DATE_THRU','TEXT') EntryIds = Get_Property(@WINDOW:'.ENTRY_IDS','ARRAY')<1> Wo = Get_Property(@WINDOW:'.WO','ARRAY') Po = Get_Property(@WINDOW:'.PO','ARRAY') swap @vm:@vm with '' in Wo if Wo[-1,1] = @vm then Wo[-1,1] = '' swap @vm:@vm with '' in Po if Po[-1,1] = @vm then Po[-1,1] = '' swap @vm:@vm with '' in CustIds if CustIds[-1,1] = @vm then CustIds[-1,1] = '' swap @vm:@vm with '' in EntryIds if EntryIds[-1,1] = @vm then EntryIds[-1,1] = '' if CustIds then SearchStr<-1> = 'WO_CUST_NO_SHIP_TO':@vm:CustIds end if EntryDateFrom and EntryDateThru then SearchStr<-1> = 'ENTRY_DATE':@vm:EntryDateFrom:'...':EntryDateThru end else if EntryDateFrom then SearchStr<-1> = 'ENTRY_DATE':@vm:'>=':EntryDateFrom end if EntryDateThru then SearchStr<-1> = 'ENTRY_DATE':@vm:'<=':EntryDateThru end end if EntryIds then SearchStr<-1> = 'ENTRY_ID':@vm:EntryIds end if Wo then SearchStr<-1> = 'WO':@vm:Wo end if Po then SearchStr<-1> = 'PO':@VM:Po end if SearchStr then SearchStr := @fm Void = utility( 'CURSOR', 'H' ) * do a btree.extract btree.extract( SearchStr, 'COC', DictCOCTable, Keys, '', Flag ) if Flag <> 0 then Void = msg( '', 'Error while extracting COC records...' ) return 0 end if Keys then convert @vm to @fm in Keys Keys = key_sort( Keys, 'COC', 'CUST_NAME_BILL_TO':@fm:'#ENTRY_DATE', 1 ) end_dialog( @window, Keys ) end else MsgInfo = '' MsgInfo = 'No records found meeting your criteria...' MsgInfo = '!' Void = msg( '', MsgInfo ) end Void = utility( 'CURSOR', 'A' ) end else MsgInfo = '' MsgInfo = 'You have not entered any search criteria...' MsgInfo = '!' Void = msg( '', MsgInfo ) end OPEN 'DICT.RDS' TO DictRDSTable ELSE ErrMsg( 'Unable to open DICT.RDS...' ) End_Dialog( @WINDOW,'') END WONos = Get_Property(@WINDOW:'.WO','ARRAY')<1> Reactors = Get_Property(@WINDOW:'.REACTORS','ARRAY')<1> PSNs = Get_Property(@WINDOW:'.PSN_NOS','ARRAY')<1> QuoteNos = Get_Property(@WINDOW:'.QUOTE_NOS','ARRAY')<1> PONos = Get_Property(@WINDOW:'.PO','ARRAY')<1> PartNos = Get_Property(@WINDOW:'.PART_NUM','ARRAY')<1> LotNos = Get_Property(@WINDOW:'.LOT_NUM','ARRAY')<1> CurrStatusCds = Get_Property(@WINDOW:'.CURR_STATUS','ARRAY')<1> CustIds = Get_Property(@WINDOW:'.CUST_INFO','ARRAY')<1> SWAP @VM:@VM WITH '' IN WONos ; IF WONos[-1,1] = @VM THEN WONos[-1,1] = '' SWAP @VM:@VM WITH '' IN Reactors ; IF Reactors[-1,1] = @VM THEN Reactors[-1,1] = '' SWAP @VM:@VM WITH '' IN PSNs ; IF PSNs[-1,1] = @VM THEN PSNs[-1,1] = '' SWAP @VM:@VM WITH '' IN QuoteNos ; IF QuoteNos[-1,1] = @VM THEN QuoteNos[-1,1] = '' SWAP @VM:@VM WITH '' IN PONos ; IF PONos[-1,1] = @VM THEN PONos[-1,1] = '' SWAP @VM:@VM WITH '' IN PartNos ; IF PartNos[-1,1] = @VM THEN PartNos[-1,1] = '' SWAP @VM:@VM WITH '' IN LotNos ; IF LotNos[-1,1] = @VM THEN LotNos[-1,1] = '' SWAP @VM:@VM WITH '' IN CurrStatusCds ; IF CurrStatusCds[-1,1] = @VM THEN CurrStatusCds[-1,1] = '' SWAP @VM:@VM WITH '' IN CustIDs ; IF CustIDs[-1,1] = @VM THEN CustIds[-1,1] = '' DateInFrom = Get_Property(@WINDOW:'.DATE_IN_FROM','TEXT') DateInThru = Get_Property(@WINDOW:'.DATE_IN_THRU','TEXT') DateOutFrom = Get_Property(@WINDOW:'.DATE_OUT_FROM','TEXT') DateOutThru = Get_Property(@WINDOW:'.DATE_OUT_THRU','TEXT') TimeInFrom = Get_Property(@WINDOW:'.TIME_IN_FROM','TEXT') TimeInThru = Get_Property(@WINDOW:'.TIME_IN_THRU','TEXT') TimeOutFrom = Get_Property(@WINDOW:'.TIME_OUT_FROM','TEXT') TimeOutThru = Get_Property(@WINDOW:'.TIME_OUT_THRU','TEXT') SearchStr = '' IF WONos THEN SearchStr<-1> = 'WO':@VM:WONos IF Reactors THEN SearchStr<-1> = 'REACTOR':@VM:Reactors IF PSNs THEN SearchStr<-1> = 'PROD_SPEC_ID':@VM:PSNs IF QuoteNos THEN SearchStr<-1> = 'QUOTE_NO':@VM:QuoteNos IF PONos THEN SearchStr<-1> = 'PO':@VM:PONos IF PartNos THEN SearchStr<-1> = 'PART_NUM':@VM:PartNos IF LotNos THEN SearchStr<-1> = 'LOT_NUM':@VM:LotNos IF CurrStatusCds THEN SearchStr<-1> = 'CURR_STATUS':@VM:CurrStatusCds IF CustIds THEN SearchStr<-1> = 'CUST_NO':@VM:CustIds IF DateInFrom AND DateInThru THEN SearchStr<-1> = 'DATE_IN':@VM:DateInFrom:'...':DateInThru END ELSE IF DateInFrom THEN SearchStr<-1> = 'DATE_IN':@VM:'>=':DateInFrom IF DateInThru THEN SearchStr<-1> = 'DATE_IN':@VM:'<=':DateInThru END IF DateOutFrom and DateOutThru THEN SearchStr<-1> = 'DATE_OUT':@VM:DateOutFrom:'...':DateOutThru END ELSE IF DateOutFrom THEN SearchStr<-1> = 'DATE_OUT':@VM:'>=':DateOutFrom IF DateOutThru THEN SearchStr<-1> = 'DATE_OUT':@VM:'<=':DateOutThru END IF TimeInFrom and TimeInThru THEN SearchStr<-1> = 'TIME_IN':@VM:TimeInFrom:'...':TimeInThru END ELSE IF TimeInFrom THEN SearchStr<-1> = 'TIME_IN':@VM:'>=':TimeInFrom IF TimeInThru THEN SearchStr<-1> = 'TIME_IN':@VM:'<=':TimeInThru END IF TimeOutFrom and TimeOutThru THEN SearchStr<-1> = 'TIME_OUT':@VM:TimeOutFrom:'...':TimeOutThru END ELSE IF TimeOutFrom THEN SearchStr<-1> = 'TIME_OUT':@VM:'>=':TimeOutFrom IF TimeOutThru THEN SearchStr<-1> = 'TIME_OUT':@VM:'<=':TimeOutThru END IF SearchStr THEN SearchStr := @FM Void = Utility( 'CURSOR', 'H' ) * do a btree.extract Btree.Extract( SearchStr, 'RDS', DictRDSTable, RDSNos, '', Flag ) IF Get_Status(errCode) THEN ErrMsg(errCode) End_Dialog( @WINDOW,'') END IF RDSNos THEN CONVERT @VM TO @FM IN RDSNos RDSNos = Key_Sort( RDSNos, 'RDS', 'CUST_NAME':@fm:'WO':@fm:'RUN_ORDER_NUM', 0 ) End_Dialog( @WINDOW, RDSNos ) END ELSE MsgInfo = '' MsgInfo = 'No records found meeting your criteria...' MsgInfo = '!' Void = msg( '', MsgInfo ) END Void = utility( 'CURSOR', 'A' ) END ELSE MsgInfo = '' MsgInfo = 'You have not entered any search criteria...' MsgInfo = '!' Void = msg( '', MsgInfo ) END RETURN