COMPILE FUNCTION Comm_Customer_EPI(Instruction, Parm1,Parm2) /* Commuter module for Customer_Epi () window 07/08/2005 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Set_List_Box_Data, SetInitDirOptions DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow,ErrMsg DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note, RList DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup, Collect.Ixvals DECLARE FUNCTION Send_Message, Msg, Security_Check, RowExists, NextKey $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT QUOTE_SIGS_EQU $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT RLIST_EQUATES $INSERT COMPANY_EQU EQU CRLF$ TO \0D0A\ EQU COL$CUST_NO TO 1 ;* Equates for the SHIP_TO_CUST_NO edit table control EQU COL$SAP_NO TO 2 EQU COL$COMPANY TO 3 EQU COL$ABBREV TO 4 EQU COL$ADDRESS TO 5 EQU COL$CSZ TO 6 ErrTitle = 'Error in Comm_Customer_EPI' ErrorMsg = '' ErrCode = '' 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 = 'Page' ; GOSUB Page CASE Instruction = 'Delete' ; GOSUB Delete CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'New' ; GOSUB New CASE Instruction = 'LUDate' ; GOSUB LUDate CASE Instruction = 'LUCompNo' ; GOSUB LUCompNo CASE Instruction = 'CompChar' ; GOSUB CompChar CASE Instruction = 'CompNoLF' ; GOSUB CompNoLF CASE Instruction = 'ViewBillTo' ; GOSUB ViewBillTo CASE Instruction = 'ShipToDC' ; GOSUB ShipToDC CASE Instruction = 'Contacts' ; GOSUB Contacts CASE Instruction = 'AnnConts' ; GOSUB AnnConts CASE Instruction = 'Quotes' ; GOSUB Quotes CASE Instruction = 'ProdSpecs' ; GOSUB ProdSpecs CASE Instruction = 'OpenOrders' ; GOSUB OpenOrders CASE Instruction = 'LUIncoCode' ; GOSUB LUIncoCode CASE Instruction = 'LUShipDocDir' ; GOSUB LUShipDocDir CASE Instruction = 'LUShipDataDir' ; GOSUB LUShipDataDir CASE Instruction = 'LUExportName' ; GOSUB LUExportName CASE Instruction = 'EnableCheckBoxes' ; GOSUB EnableCheckBoxes CASE 1 ErrorMsg = 'Unknown Instruction ':QUOTE(Instruction):' passed to routine.' ErrMsg(ErrorMsg) END CASE RETURN Result * * * * * * * Create: * * * * * * * * Change the security tables to match the table names after conversion and take this note out obj_Appwindow('Create',@WINDOW) IF NOT(Security_Check('Company',READ$)) THEN Security_Err_Msg('Company',READ$) End_Window(@WINDOW) RETURN END 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 GOSUB Refresh RETURN * * * * * * * Clear: * * * * * * * Send_Event(@WINDOW,'PAGE',1) obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls * * * * * * * Refresh: * * * * * * * IF Security_Check('Company',EDIT$) THEN obj_AppWindow('ReadOnly',@WINDOW:@RM:1) ;* enable all database controls END ELSE obj_AppWindow('ReadOnly',@WINDOW) ;* disable all database controls END Ctrls = @WINDOW:'.ENTRY_ID':@RM ; Props = 'TEXT':@RM Ctrls := @WINDOW:'.ENTRY_DT' ; Props := 'TEXT' Vals = Get_Property(Ctrls,Props) EnterBy = Vals[1,@RM] EnterDTM = Vals[COL2()+1,@RM] IF EnterBy = '' THEN Vals = 1:@RM ELSE Vals = 0:@RM IF EnterDTM = '' THEN Vals := 1 ELSE Vals := 0 Props = 'ENABLED':@RM:'ENABLED' Set_Property(Ctrls,Props,Vals) CompNo = Get_Property(@WINDOW,'ID') IF CompNo = '' THEN Set_Property(@WINDOW:'.NEW_BUTTON','ENABLED',1) END ELSE Set_Property(@WINDOW:'.NEW_BUTTON','ENABLED',0) END * 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 '') IF N NE COL$SAP_NO THEN stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$) END NEXT N END NEXT Line NEXT I ShipList = Get_Property(@WINDOW:'.SHIP_TO_CUST_NO','LIST') FOR I = 1 TO COUNT(ShipList,@FM) + (ShipList NE '') IF ShipList NE '' THEN stat = Send_Message(@WINDOW:'.SHIP_TO_CUST_NO','COLOR_BY_POS',COL$SAP_NO,I,SAP_READ_ONLY$) END NEXT I GoSub EnableCheckBoxes RETURN * * * * * * * Page: * * * * * * * Page = Parm1 IF Page = '' THEN Page = Get_Property(@WINDOW:'.TAB_MAIN','VALUE') END ELSE Set_Property(@WINDOW:'.TAB_MAIN','VALUE',Page) END Set_Property(@WINDOW,'VPOSITION', Page) return * * * * * * * Read: * * * * * * * * * * This is called from the event handler as a PreRead event * * * CompNo = Get_Property(@WINDOW:'.CO_NO','TEXT') IF NOT(RowExists('COMPANY',CompNo)) THEN IF NOT(Security_Check('Company',WRITE$)) THEN Security_Err_Msg('Company',WRITE$) Send_Event(@WINDOW,'CLEAR') RETURN END END Forward_Event() ;* passed security, do the read EnterBy = Get_Property(@WINDOW:'.ENTRY_ID','TEXT') IF EnterBy = '' THEN CurrDate = OCONV(Date(),'D4/') Set_Property(@WINDOW:'.ENTRY_ID','TEXT',OCONV(@USER4,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')) Set_Property(@WINDOW:'.ENTRY_DATE','TEXT',CurrDate) Set_Property( @WINDOW:'.VISION_CUST_NO', 'FOCUS',1) END GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * CompType = Get_Property(@WINDOW:'.CO_TYPE','INVALUE') IF CompType = '' THEN Set_Property(@WINDOW:'.CO_TYPE','TEXT','C') Result = 1 RETURN * * * * * * * Delete: * * * * * * * *IF Security_Check('Company',Delete$) THEN * Result = 1 ;* Proceed with delete *END ELSE Security_Err_Msg('Company',Delete$) Result = 0 ;* Stop event chain *END RETURN * * * * * * * New: * * * * * * * CompanyNo = Get_Property(@WINDOW,'ID') IF CompanyNo = '' THEN NextCompanyNo = NextKey('COMPANY') obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NextCompanyNo) END 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: * * * * * * * obj_Notes('Inbox',@USER4) ;* Checks for any new messages RETURN * * * * * * * CompChar: * * * * * * * CtrlName = @WINDOW:'.CO_NO' IF Get_Property(@WINDOW, "QBFSTATUS") THEN RETURN ;* QBFStatus returns 1 if QBF is active 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 * * * * * * * LUCompNo: * * * * * * * 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 * * * * * * * CompNoLF: * * * * * * * CtrlName = @WINDOW:'.CO_NO' DataIn = Get_Property(CtrlName,'TEXT') IF LEN(DataIn) = 6 AND NUM(DataIn) AND DataIn[1,1] = 0 THEN * Must be a Vision Part No OPEN 'DICT.COMPANY' TO DictCompany ELSE ErrMsg('Unable to open "DICT.COMPANY" for lookup in COMM_CUSTOMER_EPI - CompNoLF Method.') RETURN END SearchString = 'VISION_CUST_NO':@VM:DataIn:@FM Option = '' Flag = '' Btree.Extract(SearchString,'COMPANY',DictCompany,CompNos,Option,Flag) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END IF CompNos = '' THEN ErrMsg('No customer with Vision Customer No ':QUOTE(DataIn):' on file.') RETURN END IF Index(CompNos,@VM,1) THEN DEBUG END ELSE obj_Appwindow('LUValReturn',CompNos:@RM:CtrlName:@RM:'') END 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_ANN_CONT 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 * * * * * * * ViewBillTo: * * * * * * * BillToCustNo = Get_Property(@WINDOW:'.BILL_TO_CUST_NO','TEXT') IF BillToCustNo NE '' THEN Send_Event(@WINDOW,'CLEAR') Set_Property(@WINDOW:'.CO_NO','TEXT',BillToCustNo) Send_Event(@WINDOW:'.CO_NO','LOSTFOCUS') END RETURN * * * * * * * ShipToDC: * * * * * * * CtrlEntId = @WINDOW:'.SHIP_TO_CUST_NO' CurrPos = Get_Property(CtrlEntId,'SELPOS') RowData = Get_Property(CtrlEntId,'ROWDATA') ColData = Get_Property(CtrlEntId,'ARRAY') CurrCol = CurrPos<1> CurrRow = CurrPos<2> IF RowData<1,1> = '' THEN RETURN ShipToCustNo = RowData<1,1> Send_Event(@WINDOW,'CLEAR') Set_Property(@WINDOW:'.CO_NO','TEXT',ShipToCustNo) Send_Event(@WINDOW:'.CO_NO','LOSTFOCUS') RETURN * * * * * * * Contacts: * * * * * * * CompNo = Get_Property(@WINDOW:'.CO_NO','TEXT') IF CompNo = '' THEN RETURN IF Security_Check('Names',Read$) THEN TypeOver = '' TypeOver = 'WITH CO_ID "':CompNo:'" BY LAST BY FIRST' NameNos = Popup(@WINDOW,TypeOver,'SHOW_NAMES') IF NameNos = CHAR(27) THEN RETURN ;* Canceled IF Get_Status(errCode) THEN Errmsg(errCode) RETURN END ParamToPass = NameNos:'*':CompNo Start_Window( 'NAMES', @WINDOW, ParamToPass, '', '' ) END ELSE Security_Err_Msg('Names',Read$) END RETURN * * * * * * * AnnConts: * * * * * * * CompNo = Get_Property(@WINDOW:'.CO_NO','TEXT') IF CompNo = '' THEN RETURN IF Security_Check('Annual Contracts',Read$) THEN OPEN 'DICT.ANNUAL_CONTRACTS' TO DictVar THEN SearchString = 'CUST_NO':@VM:CompNo:@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 ErrMsg(errCode) RETURN END CONVERT @RM TO @VM IN ACIDs ACIDs[-1,1] = '' ;* Strip trailing delimiter TypeOver = '' TypeOver = ACIDs TypeOver = 2 TypeOver = 'Annual Contracts for ':XLATE('COMPANY',CompNo,4,'X') ACIDs = Popup(@WINDOW,TypeOver,'COMP_ANN_CONT') IF Get_Status(errCode) THEN Errmsg(errCode) RETURN END END obj_AppWindow('ViewRelated','ANN_CONT':@RM:ACIDs) END END ELSE ErrMsg('Unable to open DICT.ANNUAL_CONTRACTS in COMM_PROD_ORD routine.') RETURN END END ELSE Security_Err_Msg('Annual Contracts',Read$) END RETURN * * * * * * * Quotes: * * * * * * * CompNo = Get_Property(@WINDOW:'.CO_NO','TEXT') IF CompNo = '' THEN RETURN IF Security_Check('Quote',Read$) THEN TypeOver = '' TypeOver = 'WITH CUST_NO "':CompNo:'" BY-DSND ENTRY_DATE' QuoteNos = Popup(@WINDOW,TypeOver,'SHOW_QUOTES') IF Get_Status(errCode) THEN Errmsg(errCode) RETURN END IF NameNos NE '' THEN obj_AppWindow('ViewRelated','QUOTE2':@RM:QuoteNos) END END ELSE Security_Err_Msg('Quote',Read$) END RETURN * * * * * * * ProdSpecs: * * * * * * * CompNo = Get_Property(@WINDOW:'.CO_NO','TEXT') IF CompNo = '' THEN RETURN IF Security_Check('Prod Spec',Read$) THEN TypeOver = '' TypeOver = 'WITH CUST_ID "':CompNo:'" BY-DSND REV_DATE' PSNos = Popup(@WINDOW,TypeOver,'SHOW_PROD_SPEC') IF Get_Status(errCode) THEN Errmsg(errCode) RETURN END IF PSNos NE '' THEN obj_AppWindow('ViewRelated','PROD_SPEC':@RM:PSNos) END END ELSE Security_Err_Msg('Prod Spec',Read$) END RETURN * * * * * * * OpenOrders: * * * * * * * CompNo = Get_Property(@WINDOW:'.CO_NO','TEXT') IF CompNo = '' THEN RETURN IF Security_Check('Order',Read$) THEN TypeOver = '' TypeOver = 'WITH CUST_NO "':CompNo:'" AND WITH CURR_STATUS NE "C" BY-DSND ENTRY_DATE' OrderNos = Popup(@WINDOW,TypeOver,'SHOW_ORDERS') IF Get_Status(errCode) THEN Errmsg(errCode) RETURN END IF NameNos NE '' THEN obj_AppWindow('ViewRelated','ORDER2':@RM:OrderNos) END END ELSE Security_Err_Msg('Order',Read$) END RETURN * * * * * * * LUIncoCode: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 Result = Popup(@WINDOW,'','INCO_CODES') obj_Appwindow('LUValReturn',Result:@RM:FocusControl:@RM:FocusPos) Send_Event(@WINDOW:'.INCO_DESC','CALCULATE') RETURN * * * * * * * LUShipDocDir: * * * * * * * Directory = "R:\Ship_eMail\" ;* Hard Coded Directory SetInitDirOptions("D") InitDir Directory:'*.*' SubDirList = '' List = DirList() LOOP Line = List[1,@FM] List[1,Col2()] = "" UNTIL Line = '' IF Line NE '.' AND Line NE '..' THEN SubDirList<1,-1> = Line END REPEAT TypeOver = '' TypeOver = SubDirList TypeOver = Directory SubDir = Popup(@WINDOW,TypeOver,'SINGLE_COLUMN') IF SubDir ='' OR SubDir = CHAR(27) THEN RETURN Set_Property(@WINDOW:'.SHIP_DOC_DIR','DEFPROP',Directory:SubDir) RETURN * * * * * * * LUShipDataDir: * * * * * * * Directory = "R:\Ship_Data\" ;* Hard Coded Directory SetInitDirOptions("D") InitDir Directory:'*.*' SubDirList = '' List = DirList() LOOP Line = List[1,@FM] List[1,Col2()] = "" UNTIL Line = '' IF Line NE '.' AND Line NE '..' THEN SubDirList<1,-1> = Line END REPEAT TypeOver = '' TypeOver = SubDirList TypeOver = Directory SubDir = Popup(@WINDOW,TypeOver,'SINGLE_COLUMN') IF SubDir ='' OR SubDir = CHAR(27) THEN RETURN Set_Property(@WINDOW:'.SHIP_DATA_DIR','DEFPROP',Directory:SubDir) RETURN * * * * * * * LUExportName: * * * * * * * IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1 IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2 RList('SELECT EXPORTS BY NAME WITH NAME [] "_SYSTEM_"', TARGET_ACTIVELIST$, '', '', '' ) Result = PopUp(@WINDOW,'','SHOW_EXPORTS') IF Result NE '' THEN obj_Appwindow('LUValReturn',Result:@RM:FocusControl:@RM:FocusPos) END RETURN * * * * * * * * * EnableCheckBoxes: * * * * * * * * * Set_Property(@Window:'.SHIP_DATA_FLAG', 'ENABLED', True$) Set_Property(@Window:'.SHIP_DOC_FLAG', 'ENABLED', True$) ShipDocFlag = Get_Property(@Window:'.SHIP_DOC_FLAG', 'DEFPROP') If ShipDocFlag EQ True$ then Set_Property(@Window:'.COB_AUTO_TX_DOC_FLAG', 'ENABLED', True$) end else Set_Property(@Window:'.COB_AUTO_TX_DOC_FLAG', 'ENABLED', False$) end ShipDataFlag = Get_Property(@Window:'.SHIP_DATA_FLAG', 'DEFPROP') If ShipDataFlag EQ True$ then Set_Property(@Window:'.STANDARD_COA', 'ENABLED', True$) Set_Property(@Window:'.COB_AUTO_FTP_FLAG', 'ENABLED', True$) end else Set_Property(@Window:'.STANDARD_COA', 'ENABLED', False$) Set_Property(@Window:'.COB_AUTO_FTP_FLAG', 'ENABLED', False$) end StandardCOAFlag = Get_Property(@Window:'.STANDARD_COA', 'DEFPROP') If ShipDataFlag EQ True$ AND StandardCOAFlag = True$ then Set_Property(@Window:'.CMB_FTP_SERVER', 'ENABLED', True$) Set_Property(@Window:'.FTP_DIRECTORY', 'ENABLED', True$) end else Set_Property(@Window:'.CMB_FTP_SERVER', 'ENABLED', False$) Set_Property(@Window:'.FTP_DIRECTORY', 'ENABLED', False$) end return