COMPILE FUNCTION Comm_Order(Instruction, Parm1,Parm2) /* Commuter module for ORDER2 (Order) window 08/16/2004 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, Set_List_Box_Data DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, Make.List, Print_Order DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, obj_Order_Det, Create_Note DECLARE SUBROUTINE obj_Order DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals DECLARE FUNCTION Send_Message, Msg, Security_Check, RowExists, obj_Order, NextKey, obj_WO_Log $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT QUOTE_SIGS_EQU $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT COMPANY_EQU $INSERT QUOTE_EQU $INSERT ORDER_EQU $INSERT ORDER_DET_EQU $INSERT NOTIFICATION_EQU $INSERT ANNUAL_CONTRACTS_EQU EQU CRLF$ TO \0D0A\ EQU COL$ITEM_NO TO 1 ;* Equates for ORDER_DET (line item) edit table. EQU COL$QUOTE_NO TO 2 EQU COL$PROMISE_DT TO 3 EQU COL$EPI_PN TO 4 EQU COL$CUST_PN TO 5 EQU COL$CUST_PN_DESC TO 6 EQU COL$WO_NO TO 7 EQU COL$ITEM_DESC TO 8 EQU COL$ITEM_QTY TO 9 EQU COL$UNIT_PRICE TO 10 EQU COL$ITEM_AMT TO 11 ErrTitle = 'Error in Comm_Order' ErrorMsg = '' Result = '' BEGIN CASE CASE Instruction = 'Create' ; GOSUB Create CASE Instruction = 'Refresh' ; GOSUB Refresh CASE Instruction = 'Read' ; GOSUB Read CASE Instruction = 'Write' ; GOSUB Write CASE Instruction = 'Clear' ; GOSUB Clear CASE Instruction = 'Delete' ; GOSUB Delete CASE Instruction = 'Page' ; GOSUB Page CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'LUOrdNo' ; GOSUB LUOrdNo CASE Instruction = 'NewOrder' ; GOSUB NewOrder CASE Instruction = 'NewItem' ; GOSUB NewItem CASE Instruction = 'ItemPC' ; GOSUB ItemPC CASE Instruction = 'ItemDC' ; GOSUB ItemDC CASE Instruction = 'CustChar' ; GOSUB CustChar CASE Instruction = 'LUCustNo' ; GOSUB LUCustNo CASE Instruction = 'CustNoLF' ; GOSUB CustNoLF CASE Instruction = 'ViewCust' ; GOSUB ViewCust CASE Instruction = 'LUNameNo' ; GOSUB LUNameNo CASE Instruction = 'NameNoLF' ; GOSUB NameNoLF CASE Instruction = 'ViewName' ; GOSUB ViewName CASE Instruction = 'LUAnnCont' ; GOSUB LUAnnCont CASE Instruction = 'ViewAnnCont' ; GOSUB ViewAnnCont CASE Instruction = 'ShipToEdit' ; GOSUB ShipToEdit CASE Instruction = 'BillToEdit' ; GOSUB BillToEdit CASE Instruction = 'ShipInfoGF' ; GOSUB ShipInfoGF CASE Instruction = 'ACIdLF' ; GOSUB ACIdLF CASE Instruction = 'CreateWO' ; GOSUB CreateWO CASE Instruction = 'PrintOrder' ; GOSUB PrintOrder CASE Instruction = 'ChangeNoDC' ; GOSUB ChangeNoDC CASE Instruction = 'OrdNoLF' ; GOSUB OrdNoLF CASE Instruction = 'ChangeVisionOrder' ; GOSUB ChangeVisionOrder CASE Instruction = 'PONoLF' ; GOSUB PONoLF CASE Instruction = 'INCOTermsGF' ; GOSUB INCOTermsGF CASE 1 ErrorMsg = 'Unknown Instruction ':QUOTE(Instruction):' passed to routine.' ErrMsg(ErrorMsg) END CASE RETURN Result * * * * * * * Create: * * * * * * * IF NOT(Security_Check('Order',READ$)) THEN Security_Err_Msg('Order',READ$) End_Window(@WINDOW) RETURN END obj_Appwindow('Create',@WINDOW) Set_List_Box_Data(@WINDOW) * Provides compatibility with the existing messaging attachment system IF Parm1 NE '' THEN PassedKeys = FIELD(Parm1,'*',1) obj_Appwindow('ViewRelated',@WINDOW:@RM:PassedKeys) END IOOptions = Get_Property(@WINDOW,'IOOPTIONS') IOOptions<11> = 1 ;* Generate READ event on QBFLoad Set_Property(@WINDOW,'IOOPTIONS',IOOptions) GOSUB Refresh RETURN * * * * * * * Clear: * * * * * * * Send_Event(@WINDOW,'PAGE',1) IF Get_Property(@WINDOW,'@READONLY') THEN obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls Set_Property(@WINDOW,'@READONLY',0) ;* Clear flag on window END * * * * * * * Refresh: * * * * * * * Ctrls = @WINDOW:'.ENTRY_ID':@RM ; Props = 'TEXT':@RM Ctrls := @WINDOW:'.ENTRY_DT':@RM ; Props := 'TEXT':@RM Ctrls := @WINDOW:'.CLOSE_DT' ; Props := 'TEXT' Vals = Get_Property(Ctrls,Props) EntryID = Vals[1,@RM] EntryDt = Vals[COL2()+1,@RM] CloseDt = Vals[COL2()+1,@RM] IF EntryID = '' THEN Vals = 1:@RM ELSE Vals = 0:@RM IF EntryDt = '' THEN Vals := 1:@RM ELSE Vals := 0:@RM IF CloseDt = '' THEN Vals := 1 ELSE Vals := 0 Props = 'ENABLED':@RM:'ENABLED':@RM:'ENABLED' Set_Property(Ctrls,Props,Vals) NextNumber = XLATE('DICT.ORDER','%SK%',1,'X') Set_Property(@WINDOW:'.NEW_BUTTON','TEXT',NextNumber) IF CloseDt = '' THEN Set_Property(@WINDOW:'.STATUS','TEXT','Open') END ELSE Set_Property(@WINDOW:'.STATUS','TEXT','Closed') END ACBalance = Get_Property(@WINDOW:'.AC_BALANCE','TEXT') IF ACBalance NE '' THEN IF ACBalance <= 0 THEN Set_Property(@WINDOW:'.AC_BALANCE','BACKCOLOR',RED$) END ELSE Set_Property(@WINDOW:'.AC_BALANCE','BACKCOLOR',GREEN$) END END ACStatus = Get_Property(@WINDOW:'.AC_STATUS','TEXT') IF ACStatus NE '' THEN IF ACStatus[1,1] = 'C' THEN Set_Property(@WINDOW:'.AC_STATUS','BACKCOLOR',RED$) END ELSE Set_Property(@WINDOW:'.AC_STATUS','BACKCOLOR',GREEN$) END END Captive = Get_Property(@WINDOW:'.CAPTIVE','CHECK') Consignment = Get_Property(@WINDOW:'.CONSIGNMENT','CHECK') BEGIN CASE CASE Captive Set_Property(@WINDOW:'.ORD_TYPE','BACKCOLOR',LTBLUE$) CASE Consignment Set_Property(@WINDOW:'.ORD_TYPE','BACKCOLOR',YELLOW$) CASE 1 Set_Property(@WINDOW:'.ORD_TYPE','BACKCOLOR',GREEN$) END CASE IF CloseDt = '' THEN WOItems = Get_Property(@WINDOW:'.QUOTE_NO','ARRAY')<1> OrdNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') WOKeys = '' OrdCnt = 0 FOR I = 1 TO COUNT(WOItems,@VM) + (WOItems NE '') IF WOItems<1,I> NE '' THEN WOKeys<1,-1> = OrdNo:'*':WOItems<1,I> OrdCnt += 1 END NEXT I WORecDTMs = XLATE('WO',WOKeys,3,'X') RecCnt = 0 FOR I = 1 TO OrdCnt IF WORecDTMs<1,I> NE '' THEN RecCnt += 1 NEXT I BEGIN CASE CASE OrdCnt = 0 ; RecStatus = 'Incomplete' CASE OrdCnt = RecCnt ; RecStatus = 'Received Complete' CASE RecCnt = 0 AND OrdCnt > 0 ; RecStatus = 'Due In' CASE RecCnt < OrdCnt ; RecStatus = 'Received Partial' CASE 1 ; RecStatus = 'Lost in the Ozone' END CASE Set_Property(@WINDOW:'.REC_STATUS_FIX','TEXT',RecStatus) IF RecStatus = 'Received Complete' THEN Set_Property(@WINDOW:'.SHIPMENT_ID','BACKCOLOR',WHITE$) END ELSE Set_Property(@WINDOW:'.SHIPMENT_ID','BACKCOLOR',LTBLUE$) END END ELSE Set_Property(@WINDOW:'.REC_STATUS_FIX','TEXT','') Set_Property(@WINDOW:'.SHIPMENT_ID','BACKCOLOR',WHITE$) END Ctrls = @WINDOW:'.CHANGE_VISION_ORD_NO':@RM ; Props = 'ENABLED':@RM Ctrls := @WINDOW:'.CUST_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.CONTACT_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.CREATE_WO_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.VIEW_AC':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.NEW_ITEM_BUTTON':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.SHIP_TO_EDIT':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.BILL_TO_EDIT':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.LU_CUST_NO':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.LU_COMP_CONTACT':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.LU_AC' ; Props := 'ENABLED' IF Get_Property(@WINDOW,'@READONLY') THEN Vals = STR('0':@RM,11) ;* ReadOnly mode - kill the buttons END ELSE Vals = STR('1':@RM,11) ;* Normal mode - enable the buttons END Vals[-1,1] = '' Set_Property(Ctrls,Props,Vals) ;* Kill the function buttons when in view only mode * QBF buttons Ctrls = @WINDOW:'.QBF_FIRST_FIX':@RM ; Props = 'ENABLED':@RM Ctrls := @WINDOW:'.QBF_PREV_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.QBF_ABS_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.QBF_NEXT_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.QBF_LAST_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := @WINDOW:'.QBF_STOP_FIX' ; Props := 'ENABLED' IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Vals = 0:@RM:0:@RM:0:@RM:0:@RM:0:@RM:0 END ELSE Vals = 1:@RM:1:@RM:1:@RM:1:@RM:1:@RM:1 END Set_Property(Ctrls,Props,Vals) * Turn edit table symbolic column backgrounds to green ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow ETCtrls = ETSymbolics<1> ETCols = ETSymbolics<2> FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '') ETCtrl = ETCtrls<1,I> ETList = Get_Property(ETCtrl,'LIST') FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '') IF ETList NE '' THEN FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '') stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$) NEXT N END NEXT I NEXT I RETURN * * * * * * * Page: * * * * * * * obj_Appwindow('Page') RETURN * * * * * * * Read: * * * * * * * OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') IF RowExists('ORDER',OrderNo) THEN IF NOT(Security_Check('Order',EDIT$)) THEN obj_AppWindow('ReadOnly',@WINDOW) ;* disable all database controls Set_Property(@WINDOW,'@READONLY',1) END END ELSE IF NOT(Security_Check('Order',WRITE$)) THEN Send_Event(@WINDOW,'CLEAR') Security_Err_Msg('Order',WRITE$) RETURN END END EntryID = Get_Property(@WINDOW:'.ENTRY_ID','TEXT') GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') Message = '' IF RowExists('ORDER',OrderNo) THEN IF Get_Property(@WINDOW,'SAVEWARN') THEN Message = 'Order No. ':OrderNo:' has been changed.' END END ELSE Message = 'New Order ':QUOTE(OrderNo):' entered into system.' END IF Message NE '' THEN Recipients = XLATE('NOTIFICATION','ORDER_ENTRY',NOTIFICATION_USER_ID$,'X') SentFrom = @USER4 Subject = 'New/Update Order':OrderNo AttachWindow = 'ORDER2' AttachKey = OrderNo SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup *obj_Notes('Create',Parms) ;* Per Request from Customer Service IF Get_Status(errCode) THEN ErrMsg(errCode) END END Result = 1 RETURN * * * * * * * Delete: * * * * * * * IF Security_Check('Order',Delete$) THEN Result = 1 ;* Proceed with delete END ELSE Security_Err_Msg('Order',Delete$) Result = 0 ;* Stop event chain END RETURN * * * * * * * LUOrdNo: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 Set_Status(0) OrderKeys = obj_Order('Find') IF Get_Status(errCode) THEN ErrMsg(ErrCode) IF INDEX(OrderKeys,@VM,1) THEN TypeOver = '' TypeOver = 'K' TypeOver = OrderKeys OrderKeys = Popup(@WINDOW,TypeOver,'ORDER_QUERY') END CONVERT @VM TO @FM IN OrderKeys IF INDEX(OrderKeys,@FM,1) THEN Send_Event(@WINDOW,'QBFINIT') Set_Property(@WINDOW,'QBFLIST',OrderKeys) GOSUB Refresh Send_Event(@WINDOW,'QBFIRST') END ELSE obj_Appwindow('LoadFormKeys',@WINDOW:@RM:OrderKeys) END RETURN * * * * * * * NewOrder: * * * * * * * OrderNo = Get_Property(@WINDOW,'ID') IF NOT(Security_Check('WO Log',WRITE$)) THEN Security_Err_Msg('WO Log',WRITE$) RETURN END IF OrderNo = '' THEN NextOrderNo = NextKey('ORDER') obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NextOrderNo) END RETURN * * * * * * * CustNoLF: * * * * * * * UpdateFlag = Parm1 CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') Ctrls = @WINDOW:'.BILL_TO_COMPANY':@RM ; Props = 'DEFPROP':@RM ; Vals = '':@RM Ctrls := @WINDOW:'.BILL_TO_ATTN':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.BILL_TO_ADDR':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.BILL_TO_CITY':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.BILL_TO_ST':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.BILL_TO_ZIP':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.BILL_TO_COUNTRY':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_COMPANY':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_ATTN':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_ADDR':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_CITY':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_ST':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_ZIP':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.SHIP_TO_COUNTRY':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.TERMS':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.INVOICE_NOTES':@RM ; Props := 'DEFPROP':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.CAPTIVE':@RM ; Props := 'CHECK':@RM ; Vals := '':@RM Ctrls := @WINDOW:'.CONSIGNMENT' ; Props := 'CONSIGNMENT' ; Vals := '' BillToCustNo = Get_Property(@WINDOW:'.BILL_TO_CUST_NO','TEXT') ShipToCustNo = Get_Property(@WINDOW:'.SHIP_TO_CUST_NO','TEXT') ExistingShipToCity = Get_Property(@WINDOW:'.SHIP_TO_CITY','DEFPROP') ExistingShipToAddr = Get_Property(@WINDOW:'.SHIP_TO_ADDR','DEFPROP') IF CustNo NE '' THEN IF ExistingShipToCity NE '' OR ExistingShiptoAddr NE '' THEN IF NOT(UpdateFlag) THEN RETURN ;* Update flag is set when called from Update from Master button (2nd tab) END ShipToCompany = Get_Property(@WINDOW:'.SHIP_TO_COMPANY','TEXT') CustRec = XLATE('COMPANY',CustNo,'','X') CustBillTo = CustRec IF CustBillTo = '' THEN CustBillTo = CustNo END BillCustRec = XLATE('COMPANY',CustBillTo,'','X') IF CustRec = 1 THEN ShipVisionCustNo = CustRec BillVisionCustNo = XLATE('COMPANY',CustBillTo,COMPANY_VISION_CUST_NO$,'X') VCtrls = @WINDOW:'.SHIP_TO_CUST_NO':@RM:@WINDOW:'.BILL_TO_CUST_NO' VProps = 'TEXT':@RM:'TEXT' VVals = ShipVisionCustNo:@RM:BillVisionCustNo Set_Property(VCtrls,VProps,VVals) END IF CustRec = '' THEN ErrMsg('Cust No ':QUOTE(CustNo):' is not on file in the COMPANY table.') Set_Property(@WINDOW:'.CUST_NO','TEXT','') Set_Property(@WINDOW:'.CUST_NO','FOCUS',1) RETURN END IF CustBillTo = '' OR (ShipToCustNo NE '' AND (BillToCustNo = ShipToCustNo)) THEN Vals = CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM END ELSE Vals = BillCustRec:@RM Vals := BillCustRec:@RM Vals := BillCustRec:@RM Vals := BillCustRec:@RM Vals := BillCustRec:@RM Vals := BillCustRec:@RM Vals := BillCustRec:@RM END Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec:@RM IF CustRec = '' THEN Vals := 'USA':@RM END ELSE Vals := CustRec:@RM END Vals := CustRec:@RM Vals := CustRec:@RM Vals := CustRec Vals := CustRec END Set_Property(Ctrls,Props,Vals) Send_Event(@WINDOW:'.SHIP_TO_INFO','CALCULATE') Send_Event(@WINDOW:'.BILL_TO_INFO','CALCULATE') RETURN * * * * * * * ShipInfoGF: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') ShipperInfo = Get_Property(@WINDOW:'.SHIPPERINFO','TEXT') IF CustNo NE '' AND ShipperInfo = '' THEN CustRec = XLATE('COMPANY',CustNo,'','X') ShipperInfos = CustRec IF INDEX(ShipperInfos,@VM,1) THEN Display = '' FOR I = 1 TO COUNT(ShipperInfos,@VM) + (ShipperInfos NE '') Display<1,I> = ShipperInfos<1,I>:@SVM:CustRec NEXT I TypeOver = '' TypeOver = Display SelectedItems = Popup(@WINDOW,TypeOver,'ORDER_SHIPPER_INFO') IF SelectedItems = '' THEN RETURN ShipperInfo = SelectedItems<1,1> AcctNo = SelectedItems<1,2> END ELSE ShipperInfo = ShipperInfos AcctNo = CustRec END Set_Property(@WINDOW:'.SHIPPERINFO','TEXT',ShipperInfo) Set_Property(@WINDOW:'.ACCT_NO','TEXT',AcctNo) END RETURN * * * * * * * Close: * * * * * * * obj_Notes('Inbox',@USER4) ;* Checks for any new messages obj_Appwindow('CardReturn',@WINDOW) RETURN * * * * * * * NewItem: * * * * * * * CtrlEntID = @WINDOW:'.ORDER_DET' OrderNo = Get_Property(@WINDOW,'ID') IF OrderNo = '' THEN RETURN DetItemNos = Get_Property(CtrlEntID,'ARRAY')<1> ;* Just need the first column LastItemNo = 0 DetItemCnt = COUNT(DetItemNos,@VM) + (DetItemNos NE '') FOR I = 1 TO DetItemCnt DetItemNo = DetItemNos<1,I> IF DetItemNo = '' THEN DetItemNo = 0 IF DetItemNo > LastItemNo THEN LastItemNo = DetItemNo NEXT I Send_Event(@WINDOW,'WRITE') OrderDetKey = OrderNo:'*':LastItemNo + 1 DetWindow = 'ORDER_DET' DetKeys = OrderDetKey DefaultRec = '' RetKey = OrderNo RetWin = @WINDOW RetPage = 1 RetCtrl = CtrlEntID RetPos = 1:@FM:LastItemNo + 1 obj_Appwindow('ViewNewDetail',DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos) RETURN * * * * * * * ItemPC: * * * * * * * RETURN * * * * * * * ItemDC: * * * * * * * OrderNo = Get_Property(@WINDOW,'ID') CtrlEntID = @WINDOW:'.ORDER_DET' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> IF CurrCol = COL$ITEM_NO THEN ItemNo = Get_Property(CtrlEntID,'CELLPOS',COL$ITEM_NO:@FM:CurrRow) IF OrderNo NE '' AND ItemNo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'ORDER_DET' DetKeys = OrderNo:'*':ItemNo DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of ItemNo column IF CurrCol = COL$QUOTE_NO THEN QuoteNo = Get_Property(CtrlEntID,'CELLPOS',COL$QUOTE_NO:@FM:CurrRow) IF OrderNo NE '' AND QuoteNo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'QUOTE2' DetKeys = QuoteNo DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of QuoteNo column IF CurrCol = COL$WO_NO THEN WONo = Get_Property(CtrlEntID,'CELLPOS',COL$WO_NO:@FM:CurrRow) IF OrderNo NE '' AND WONo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END NewForm = Xlate('APP_INFO', 'NEW_WO_FORM', '', 'X') If NewForm then Start_Window('NDW_WO_LOG', @Window, WONo) end else DetWindow = 'WO_LOG2' DetKeys = WONo DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) end IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of WO column IF CurrCol = COL$EPI_PN THEN EpiPN = Get_Property(CtrlEntID,'CELLPOS',COL$EPI_PN:@FM:CurrRow) IF OrderNo NE '' AND EpiPN NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'EPI_PART' DetKeys = EpiPN DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END END ;* End of Epi Part Number column IF CurrCol = COL$CUST_PN THEN /* * Hold until customer part number window is ready to go CustPN = Get_Property(CtrlEntID,'CELLPOS',COL$CUST_PN:@FM:CurrRow) IF OrderNo NE '' AND CustPN NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'CUST_PART' DetKeys = CustPN DefaultRec = '' RetKey = OrderNo RetPage = 1 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END END */ END ;* End of Epi Part Number column RETURN * * * * * * * CustChar: * * * * * * * CtrlName = @WINDOW:'.CUST_NO' DataIn = Get_Property(CtrlName,'TEXT') IF LEN(DataIn) > 2 THEN ReturnToCtrl = CtrlName IF NOT(NUM(DataIn)) THEN Set_Property(CtrlName,'TEXT','') ;* Clear characters input Start_Window('COMP_LOOKUP',@WINDOW,DataIn:@VM:'C':@FM:ReturnToCtrl,'','') END END RETURN * * * * * * * LUCustNo: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 TypeOver = '' TypeOver = 1 CustNo = Popup(@WINDOW,TypeOver,'CUSTOMER') IF CustNo NE '' THEN obj_Appwindow('LUValReturn',CustNo:@RM:FocusControl:@RM:FocusPos) END RETURN * * * * * * * ViewCust: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF CustNo NE '' THEN obj_Appwindow('ViewRelated','CUSTOMER_EPI':@RM:CustNo) END RETURN * * * * * * * LUNameNo: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 CompNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF CompNo NE '' THEN * This is the pushbutton - show the short name list OPEN 'DICT.NAMES' TO DictVar THEN SearchString = 'CO_ID':@VM:CompNo:@FM Btree.Extract(SearchString,'NAMES',DictVar,NameNos,'',Flag) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END IF NameNos = '' THEN ErrMsg('No names on file for Customer Number ':CompNo) RETURN END ELSE IF INDEX(NameNos,@VM,1) THEN TypeOver = '' TypeOver = NameNos TypeOver = 'Contact Names for ':XLATE('COMPANY',CompNo,4,'X') NameNo = Popup(@WINDOW,TypeOver,'COMP_NAME') END ELSE NameNo = NameNos END obj_AppWindow('LUValReturn',NameNo:@RM:FocusControl:@RM:FocusPos) END END ELSE ErrMsg('Unable to open DICT.NAMES in COMM_PROD_ORD routine.') RETURN END END ELSE NameNo = Popup(@WINDOW,'','NAMES') IF NameNo NE '' THEN obj_AppWindow('LUValReturn',NameNo:@RM:FocusControl:@RM:FocusPos) END END RETURN * * * * * * * ViewName: * * * * * * * NameNo = Get_Property(@WINDOW:'.NAME_NO','TEXT') IF NameNo NE '' THEN obj_Appwindow('ViewRelated','NAMES':@RM:NameNo) END RETURN * * * * * * * LUAnnCont: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF CustNo NE '' THEN * This is the pushbutton - show the short name list OPEN 'DICT.ANNUAL_CONTRACTS' TO DictVar THEN SearchString = 'CUST_NO':@VM:CustNo:@FM SearchString := 'STATUS':@VM:'O':@FM Btree.Extract(SearchString,'ANNUAL_CONTRACTS',DictVar,ACIDs,'',Flag) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END IF ACIDs= '' THEN ErrMsg('No Annual Contracts on file for Customer Number ':CustNo) RETURN END ELSE IF INDEX(ACIDs,@VM,1) THEN ACIDs := @VM CONVERT @VM TO @RM IN ACIDs CALL V119('S','','D','R',ACIDs,'') IF Get_Status(errCode) THEN DEBUG CONVERT @RM TO @VM IN ACIDs ACIDs[-1,1] = '' ;* Strip trailing delimiter TypeOver = '' TypeOver = ACIDs TypeOver = 'Annual Contracts for ':XLATE('COMPANY',CustNo,4,'X') ACID = Popup(@WINDOW,TypeOver,'COMP_ANN_CONT') END ELSE ACID = ACIDs END obj_AppWindow('LUValReturn',ACID:@RM:FocusControl:@RM:FocusPos) *ACRec = XLATE('ANNUAL_CONTRACTS',ACID,'','X') *ACPONo = ACRec IF Captive THEN IF CustNo NE ACCustNo THEN ErrMsg('Annual Contract does not belong to this customer!') Set_Property(@WINDOW:'.AC_ID','FOCUS',1) Set_Property(@WINDOW:'.AC_ID','SELECTION',1:@FM:65534) RETURN END IF ACRec = 'C' THEN ErrMsg('Annual Contract is Closed') Set_Property(@WINDOW:'.AC_ID','FOCUS',1) Set_Property(@WINDOW:'.AC_ID','SELECTION',1:@FM:65534) RETURN END END AC_PONo = ACRec IF AC_PONo NE '' THEN obj_Appwindow('LUValReturn',AC_PONo:@RM:@WINDOW:'.PO_NO') END END RETURN * * * * * * * CreateWO: * * * * * * * UQuoteArray = Get_Property(@WINDOW:'.UQUOTE_NO','INVALUE') UQuotes = UQuoteArray<1> UPromiseDts = UQuoteArray<2> UQItemNos = UQuoteArray<3> LOOP UNTIL UQuotes[-1,1] NE @VM OR UQuotes = '' UQuotes[-1,1] = '' REPEAT LOOP UNTIL UPromiseDts[-1,1] NE @VM OR UPromiseDts = '' UPromiseDts[-1,1] = '' REPEAT LOOP UNTIL UQItemNos[-1,1] NE @VM OR UQItemNos = '' UQItemNos[-1,1] = '' REPEAT SWAP ', ' WITH @SVM IN UQItemNos OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') IF OrderNo = '' THEN RETURN ItemWOs = Get_Property(@WINDOW:'.ORDER_DET','DEFPROP') Send_Event(@WINDOW,'WRITE') FOR I = 1 TO COUNT(UQuotes,@VM) + (UQuotes NE '') UQuote = UQuotes<1,I> UPromiseDt = UPromiseDts<1,I> UItemNos = UQItemNos<1,I> ;* UItemNos is SVM's ORDER_DET Item Numbers OrderItems = UItemNos CONVERT @SVM TO @VM IN OrderItems FOR N = 1 TO COUNT(OrderItems,@VM) + (OrderItems NE '') IF ItemWOs<1,OrderItems<1,N>> NE '' THEN ErrMsg('Item ':OrderItems<1,N>:' already has a Work Order') * Add code to place this Item No in the WO record *********************************** GOTO SkipWOAdd END NEXT N WONo = obj_WO_Log('Create',OrderNo:@RM:OrderItems:@RM:UQuote) IF Get_Status(errCode) THEN ErrMsg(errCode) END ELSE obj_Order_Det('AddWONo',OrderNo:@RM:OrderItems:@RM:WONo) IF Get_Status(errCode) THEN ErrMsg(errCode) END END NEXT I SkipWOAdd: obj_AppWindow('LoadFormKeys',@WINDOW:@RM:OrderNo) RETURN * * * * * * PrintOrder: * * * * * * OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') ConfirmFlag = Parm1 IF OrderNo = '' THEN RETURN Send_Event(@WINDOW,'WRITE') Print_Order(OrderNo,ConfirmFlag) obj_AppWindow('LoadFormKeys',@WINDOW:@RM:OrderNo) Set_Property('SYSTEM','FOCUS','VSPRINTER') RETURN * * * * * * * ChangeNoDC: * * * * * * * OrderNo = Get_Property(@WINDOW,'ID') CtrlEntID = @WINDOW:'.ORDER_CHANGE_NO' IF OrderNo = '' THEN RETURN CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> OCNo = Get_Property(CtrlEntID,'CELLPOS',1:@FM:CurrRow) IF OrderNo NE '' AND OCNo NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'ORDER_CHANGE' DetKeys = OCNo DefaultRec = '' RetKey = OrderNo RetPage = 4 RetCtrl = CtrlEntID RetPos = CurrPos oAParms = DetWindow:@RM:DetKeys:@RM:DefaultRec:@RM:RetKey:@RM:RetPage:@RM:RetCtrl:@RM:RetPos obj_AppWindow('ViewNewDetail',oAParms) IF Get_Status(errCode) THEN ErrMsg(errCode) END obj_AppWindow('LoadFormKeys',@WINDOW:@RM:OrderNo) END RETURN * * * * * * * NameNoLF: * * * * * * * Ctrls = @WINDOW:'.NAME_NO':@RM:@WINDOW:'.CUST_NO' Props = 'TEXT':@RM:'TEXT' Vals = Get_Property(Ctrls,Props) NameNo = Vals[1,@RM] CompNo = Vals[COL2()+1,@RM] IF NUM(NameNo) THEN RETURN FocusControl = @WINDOW:'.NAME_NO' FocusPos = '' IF CompNo NE '' AND NameNo NE ''THEN OPEN 'DICT.NAMES' TO DictVar THEN SearchString = 'LAST_FIRST':@VM:NameNo:']':@FM:'CO_ID':@VM:CompNo:@FM Btree.Extract(SearchString,'NAMES',DictVar,NameNos,'',Flag) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END IF NameNos = '' THEN ErrMsg('No names on file for Customer Number ':CompNo) RETURN END ELSE IF INDEX(NameNos,@VM,1) THEN TypeOver = '' TypeOver = NameNos TypeOver = 'Contact Names for ':XLATE('COMPANY',CompNo,4,'X') NameNo = Popup(@WINDOW,TypeOver,'COMP_NAME') END ELSE NameNo = NameNos END obj_AppWindow('LUValReturn',NameNo:@RM:FocusControl:@RM:FocusPos) Send_Event(@WINDOW:'.NAME','CALCULATE') END END ELSE ErrMsg('Unable to open DICT.NAMES in COMM_ORDER routine.') RETURN END END RETURN * * * * * * * OrdNoLF: * * * * * * * CtrlName = @WINDOW:'.ORD_NO' OrdNo = Get_Property(@WINDOW:'.ORD_NO','TEXT') IF OrdNo = '' THEN RETURN OrdNo = XLATE('VISION_ORDER',OrdNo,1,'X') IF OrdNo NE '' THEN obj_Appwindow('LUValReturn',OrdNo:@RM:CtrlName:@RM:'') END RETURN * * * * * * * ChangeVisionOrder: * * * * * * * RETURN VisionOrdNo = Get_Property(@WINDOW:'.VISION_ORDER_NO','TEXT') OrderNo = Get_Property(@WINDOW:'.ORDER_NO','TEXT') NewVisionOrdNo = Msg(@WINDOW,'','VISION_ORDER_CHANGE') IF NewVisionOrdNo = CHAR(27) THEN RETURN ;* Cancelled IF NewVisionOrdNo = VisionOrdNo THEN RETURN ;* You just never know... * Check for preexistance of the number BadOrderNo = XLATE('VISION_ORDER',NewVisionOrdNo,1,'X') IF Check NE '' THEN ErrMsg('Vision Order No ':QUOTE(NewVisionOrdNo):' is already used on Order No: ':QUOTE(Check):'.') RETURN END RETURN * * * * * * * * PONoLF: * * * * * * * * OrderNo = Get_Property(@WINDOW,'ID') PONo = Get_Property(@WINDOW:'.PO_NO','DEFPROP') OrgPONo = Get_Property(@WINDOW:'.PO_NO','ORIG_ROWVALUE') *OrgPONo = XLATE('ORDER',OrderNo,ORDER_PO_NO$,'X') IF OrgPONo NE '' THEN IF PONo NE OrgPONo THEN Mesg = 'The PO No on this Order will be changed from ':QUOTE(OrgPONo):CRLF$ Mesg := 'to ':QUOTE(PONo):'.':CRLF$:CRLF$ Mesg := 'This will require relabeling any released cassettes associated with this order.':CRLF$:CRLF$ Mesg := 'Do you wish to continue?' Def = '' Def = Mesg Def = '?' Def = 'BOC' Def = 'C' Def = 'Purchase Order Number Change' Def = 500 Def = 2 Resp = Msg(@WINDOW,Def,'') IF Resp = CHAR(27) THEN Set_Property(@WINDOW:'.PO_NO','DEFPROP',OrgPONo) Set_Property(@WINDOW:'.PO_NO','FOCUS',1) RETURN END Send_Event(@WINDOW,'WRITE') Def = '' Def = 'Posting New PO Number to RDS records...' Def = 'U' MsgUp = Msg(@WINDOW,Def) WONos = obj_Order('POChange',OrderNo:@RM:OrgPONo:@RM:PONo) IF Get_Status(errCode) THEN Msg(@WINDOW,'','PO_CHANGE_ERROR') ErrMsg(errCode) END ELSE Msg(@WINDOW,MsgUp) SWAP @VM WITH ', ' IN WONos Recipients = XLATE('NOTIFICATION','WO_ENTRY',NOTIFICATION_USER_ID$,'X') SentFrom = @USER4 Subject = 'WO Nos: ':WONos:' PO No. Changed' AttachWindow = 'ORDER2' AttachKey = OrderNo SendToGroup = '' Message = 'Order No. ':QUOTE(OrderNo):' has had the PO No changed from ':QUOTE(OrgPONo):' to ':QUOTE(PONo):'.':CRLF$ Message := 'RDS Labels need to be reprinted and placed on the cassettes.' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) END obj_AppWindow('LoadFormKeys',@WINDOW:@RM:OrderNo) END ;* End of check for changed PO No. END ;* End of check for null original PO No. RETURN * * * * * * * INCOTermsGF: * * * * * * * CurrTerms = Get_Property(@WINDOW:'.INCO_TERMS','DEFPROP') CustNo = Get_Property(@WINDOW:'.CUST_NO','DEFPROP') IF CustNo NE '' AND CurrTerms = '' THEN CustTerms = XLATE('COMPANY',CustNo,'INCO_DESC','X') IF CustTerms NE '' THEN Set_Property(@WINDOW:'.INCO_TERMS','DEFPROP',CustTerms) END END RETURN