COMPILE FUNCTION Comm_Quote(Instruction, Parm1,Parm2) /* Commuter module for Quote (Quote) window 11/14/2004 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, Check_Notes, End_Window, Start_Window DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, Make.List, Security_Err_Msg DECLARE SUBROUTINE Set_List_Box_Data, Create_Note, obj_Tables, PrintQuote DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals DECLARE FUNCTION Send_Message, obj_PR_Spec ,Msg, Security_Check, obj_Company, NextKey, Dialog_Box $INSERT POPUP_EQUATES $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT QUOTE_SIGS_EQU $INSERT LSL_USERS_EQU $INSERT QUOTE_EQU $INSERT COMPANY_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT PROD_SPEC_EQU EQU CRLF$ TO \0D0A\ EQU ED_LOG$CHANGE_DT TO 1 EQU ED_LOG$CURR_EXP_DT TO 2 EQU ED_LOG$NEW_EXP_DT TO 3 EQU ED_LOG$CHANGED_BY TO 4 EQU ED_LOG$COMMENTS TO 5 EQU COL$STEP TO 1 EQU COL$PSN TO 2 EQU COL$PSN_STATUS TO 3 EQU COL$DOPANTS TO 4 EQU COL$STEP_DESC TO 5 EQU COL$CUST_PART_NO TO 6 EQU COL$PART_NO_DESC TO 7 ErrTitle = 'Error in Comm_Quote' 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 = 'Delete' ; GOSUB Delete CASE Instruction = 'Clear' ; GOSUB Clear CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'Page' ; GOSUB Page CASE Instruction = 'LUQuote' ; GOSUB LUQuote CASE Instruction = 'NewQuote' ; GOSUB NewQuote CASE Instruction = 'LUPSNo' ; GOSUB LUPSNo CASE Instruction = 'ChangeExpDt' ; GOSUB ChangeExpDt CASE Instruction = 'ViewExpDtLog' ; GOSUB ViewExpDtLog CASE Instruction = 'ExpDtLF' ; GOSUB ExpDtLF CASE Instruction = 'CustNoLF' ; GOSUB CustNoLF CASE Instruction = 'CustChar' ; GOSUB CustChar CASE Instruction = 'LUCustNo' ; GOSUB LUCustNo CASE Instruction = 'ViewCust' ; GOSUB ViewCust CASE Instruction = 'LUContNo' ; GOSUB LUContNo CASE Instruction = 'ViewContact' ; GOSUB ViewContact CASE Instruction = 'SignClick' ; GOSUB SignClick CASE Instruction = 'LUFax' ; GOSUB LUFax CASE Instruction = 'LUIFax' ; GOSUB LUIFax CASE Instruction = 'Print' ; GOSUB Print CASE Instruction = 'Duplicate' ; GOSUB Duplicate CASE Instruction = 'CloseQuote' ; GOSUB CloseQuote CASE Instruction = 'SendMessage' ; GOSUB SendMessage CASE Instruction = 'StepGF' ; GOSUB StepGF CASE Instruction = 'StepPC' ; GOSUB StepPC CASE Instruction = 'StepDC' ; GOSUB StepDC CASE 1 ErrorMsg = 'Unknown Instruction passed to routine.' ErrMsg(ErrorMsg) END CASE RETURN Result * * * * * * * Create: * * * * * * * IF NOT(Security_Check('Quote',READ$)) THEN Security_Err_Msg('Schedule',READ$) End_Window(@WINDOW) RETURN END IF NOT(Security_Check('Quote',EDIT$)) THEN Security_Err_Msg('Schedule',EDIT$) 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 GOSUB Refresh RETURN * * * * * * * Clear: * * * * * * * Send_Event(@WINDOW,'PAGE',1) obj_Appwindow('ReadOnly',@WINDOW:@RM:1) ;* Clear Read Only * * * * * * * Refresh: * * * * * * * NoOfSignaturesRequired = XLATE( 'CONFIG', 'QUOTE_SIGS', 3, 'X' )+0 Signatures = Get_Property(@WINDOW:'.SIGNATURES','LIST') FOR I = 1 TO NoOfSignaturesRequired IF Signatures = '' THEN LineColor = RED$ END ELSE LineColor = GREEN$ END stat = Send_Message(@WINDOW:'.SIGNATURES','COLOR_BY_POS',0,I,LineColor) IF Get_Status(errCode) THEN ErrMsg(ErrCode) NEXT I * 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 Line NEXT I StatusArray = Get_Property(@WINDOW:'.PROC_STEP','ARRAY') LOOP StatusVal = StatusArray[-1,1] UNTIL StatusVal NE @VM OR StatusArray = '' StatusArray[-1,1] = '' REPEAT StatCnt = COUNT(StatusArray,@VM) + (StatusArray NE '') FOR I = 1 TO StatCnt StatusVal = StatusArray<1,I> IF StatusVal[1,1] = 'I' THEN stat = Send_Message(@WINDOW:'.PROC_STEP','COLOR_BY_POS',COL$PSN_STATUS,I,RED$) END NEXT I RETURN * * * * * * * Page: * * * * * * * obj_Appwindow('Page') GOSUB Refresh RETURN * * * * * * * Read: * * * * * * * QuoteNo = Get_Property(@WINDOW,'ID') IF RowExists('QUOTE',QuoteNo) THEN IF NOT(Security_Check('Quote',WRITE$)) THEN Security_Err_Msg('Quote',WRITE$) Send_Event(@WINDOW,'CLEAR') RETURN END END ELSE IF NOT(Security_Check('Quote',EDIT$)) THEN Security_Err_Msg('Quote',EDIT$) obj_Appwindow('ReadOnly',@WINDOW) END Set_Property(@WINDOW:'.ENTRY_BY','TEXT',OCONV(@USER4,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')) Set_Property(@WINDOW:'.ENTRY_DATE','TEXT',OCONV(Date(),'D4/')) END GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * RETURN * * * * * * * Delete: * * * * * * * IF NOT(Security_Check('Delete')) THEN Security_Err_Msg('Quote',DELETE$) Result = 0 ;* Stops Delete Event END ELSE Result = 1 ;* Proceed with Event END RETURN * * * * * * * Close: * * * * * * * Check_Notes() obj_Appwindow('DetailReturn') RETURN * * * * * * * LUQuote: * * * * * * * RawQuoteKeys = dialog_box( 'QUOTE_QUERY', @window, '' ) IF RawQuoteKeys = '' THEN RETURN Make.List( 0, RawQuoteKeys, '', '' ) QuoteKeys = Popup(@WINDOW,'','QUOTES_QUERY') IF QuoteKeys = '' THEN RETURN IF INDEX(QuoteKeys,@VM,1) THEN CONVERT @VM TO @FM IN QuoteKeys Set_Property(@WINDOW,'QBFLIST',QuoteKeys) END ELSE obj_AppWindow('LUValReturn',QuoteKeys:@RM:@WINDOW:'.QUOTE_NO') END RETURN * * * * * * * NewQuote: * * * * * * * QuoteNo = Get_Property(@WINDOW,'ID') IF NOT(Security_Check('Quote',WRITE$)) THEN Security_Err_Msg('Quote',WRITE$) RETURN END IF QuoteNo = '' THEN NextQuoteNo = NextKey('QUOTE') obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NextQuoteNo) END RETURN * * * * * * * LUPSNo: * * * * * * * RETURN ReturnTo = Parm1 PS_Nos = obj_PR_Spec('Find') IF PS_Nos = '' THEN RETURN IF PS_Nos NE '' THEN Make.List(0,PS_Nos, '', '') PS_Nos = Popup(@WINDOW,'','PROD_SPEC_QUERY') END IF INDEX(PS_Nos,@FM,1) THEN Send_Event(@WINDOW,'CLEAR') Set_Property(@WINDOW,'QBFLIST',PS_Nos) Send_Event(@WINDOW,'QBFFIRST') GOSUB Refresh END ELSE obj_AppWindow('LUValReturn',PS_Nos:@RM:ReturnTo) END RETURN * * * * * * * LayerSetDC: * * * * * * * PSNo = Get_Property(@WINDOW,'ID') CtrlEntID = @WINDOW:'.LAYER_SET' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> LayerSet = Get_Property(CtrlEntID,'CELLPOS',COL$LAYER_SET:@FM:CurrRow) IF PSNo NE '' AND LayerSet NE '' THEN IF Get_Property(@WINDOW,'QBFLIST') = '' THEN Send_Event(@WINDOW,'WRITE') END DetWindow = 'PRS_LAYER' DetKeys = PSNo:'*':LayerSet DefaultRec = '' RetKey = PSNo 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 END RETURN * * * * * * * ChangeExpDt: * * * * * * * CurrExpDt = Get_Property(@WINDOW:'.EXP_DATE','TEXT') ChangeLogEntry = Dialog_Box('QUOTE_EXP_DT',@WINDOW,CurrExpDt) IF ChangeLogEntry = 'Cancel' THEN RETURN ;* Bailed on change NewExpDate = ChangeLogEntry<1,3> Dummy = Send_Message(@WINDOW:'.EXP_DT_CHANGE_LOG', 'INSERT', 1, ChangeLogEntry) Set_Property(@WINDOW:'.EXP_DT_CHANGE_LOG','SELPOS',1:@FM:1) Set_Property(@WINDOW:'.EXP_DATE','TEXT',NewExpDate) Set_Property(@WINDOW,'SAVEWARN',1) RETURN * * * * * * * ViewExpDtLog: * * * * * * * Send_Event(@WINDOW,'PAGE',4) RETURN * * * * * * * ExpDtLF: * * * * * * * CurrStatus = Get_Property(@WINDOW:'.STATUS','VALUE') ExpDate = Get_Property(@WINDOW:'.EXP_DATE','INVALUE') IF CurrStatus = 'C' THEN RETURN IF ExpDate < Date() THEN Set_Property(@WINDOW:'.STATUS','VALUE','E') ;* Set quote to expired END ELSE NumSigsRequired = xlate( 'CONFIG', 'QUOTE_SIGS', 3, 'X' )+0 Signatures = Get_Property(@WINDOW:'.SIGNATURES','ARRAY')<1> DisplaySigCnt = COUNT( Signatures, @VM ) + (Signatures NE '') SigCnt = 0 FOR I = 1 TO Scnt IF Signatures<1,I> <> '' THEN SigCnt += 1 END NEXT I IF SigCnt >= NumSigsRequired THEN Set_Property(@WINDOW:'.STATUS','VALUE','O') Set_Property(@WINDOW:'.INQUIRY_STATUS','C') END ELSE Set_Property(@WINDOW:'.STATUS','VALUE','U') END END RETURN * * * * * * * CustNoLF: * * * * * * * CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF CustNo NE '' THEN Terms = XLATE('COMPANY',CustNo,COMPANY_TERMS$,'X') IF Terms NE '' THEN Set_Property(@WINDOW:'.TERMS','TEXT',Terms) END END 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','COMPANY':@RM:CustNo) END RETURN * * * * * * * LUContNo: * * * * * * * 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 * * * * * * * ViewContact: * * * * * * * NameNo = Get_Property(@WINDOW:'.NAME_NO','TEXT') IF NameNo NE '' THEN obj_Appwindow('ViewRelated','NAMES':@RM:NameNo) END RETURN * * * * * * * SignClick: * * * * * * * CurStat = Get_Property(@WINDOW:'.STATUS','VALUE') IF CurStat = 'C' THEN ErrMsg('This Quote is Closed.') RETURN END IF CurStat = 'O' THEN ErrMsg('This Quote is Already Signed.') RETURN END QuoteNo = Get_Property(@WINDOW,'ID') CurrentSignatures = Get_Property(@WINDOW:'.SIGNATURES','ARRAY')<1> LOCATE @USER4 IN CurrentSignatures USING @VM SETTING FPos THEN ErrMsg('You have already signed off on this Quote.' ) END /* StepPSNs = Get_Property(@WINDOW:'.PROC_STEP','DEFPROP')<2> CONVERT @VM TO '' IN StepPSNs IF StepPSNs = '' THEN ErrMsg("No detail with PSN's has been entered yet!") RETURN END */ SignatureInfo = XLATE( 'CONFIG', 'QUOTE_SIGS', '', 'X' ) Users = SignatureInfo<1> Passwords = SignatureInfo<2> NumSigsRequired = SignatureInfo<3>+0 QuoteFaxer = SignatureInfo<5> LOCATE @USER4 IN Users USING @VM SETTING FPos THEN Password = Passwords<1,Fpos> Valid = Dialog_Box( 'QUOTE_SIG_PWD_ENTRY', @WINDOW, @USER4:@vm:Password ) IF Valid THEN NextLine = '' FOR I = 1 TO COUNT(CurrentSignatures,@VM) + (CurrentSignatures NE '') IF CurrentSignatures<1,I> = '' THEN NextLine = I UNTIL NextLine NE '' NEXT I obj_AppWindow('LUValReturn',@USER4:@RM:@WINDOW:'.SIGNATURES':@RM:1:@FM:NextLine) ExpDate = Get_Property(@WINDOW:'.EXP_DATE','INVALUE') IF ExpDate = '' OR ExpDate < Date() THEN * don't change it is expired IF I >= NumSigsRequired THEN IF QuoteFaxer THEN Message = 'This quote is fully signed and ready to be faxed but it is currently expired. You will need to push the expiration date out.' Create_Note( QuoteFaxer, 'System', 'Quote ready to fax', Message, 'QUOTE', QuoteNo ) END END END ELSE IF I >= NumSigsRequired THEN Set_Property(@WINDOW:'.STATUS','VALUE','O') Set_Property(@WINDOW:'.INQUIRY_STATUS','VALUE','C') IF QuoteFaxer THEN Message = 'This quote is fully signed and ready to be faxed' Create_Note( QuoteFaxer, 'System', 'Quote ready to fax', Message, 'QUOTE', QuoteNo ) END END END Set_Property(@WINDOW,'SAVEWARN',1) END END ELSE ErrMsg('You are not authorized to sign off on Quotes...') END RETURN * * * * * * * LUFax: * * * * * * * CompNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') ContNo = Get_Property(@WINDOW:'.CUST_CONT_NO','TEXT') ReturnCtrl = Parm1 IF CompNo NE '' AND ContNo NE '' THEN FaxNo = obj_Company('FaxNo',CompNo:@RM:ContNo) IF FaxNo = '' THEN ErrMsg('No FAX number found for Customer or Contact') END ELSE obj_Appwindow('LUValReturn',FaxNo:@RM:ReturnCtrl) END END RETURN * * * * * * * LUIFax: * * * * * * * CompNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') ContNo = Get_Property(@WINDOW:'.CUST_CONT_NO','TEXT') ReturnCtrl = Parm1 IF CompNo NE '' AND ContNo NE '' THEN FaxNo = obj_Company('IFaxNo',CompNo:@RM:ContNo) IF FaxNo = '' THEN ErrMsg('No FAX number found for Customer or Contact') END ELSE obj_Appwindow('LUValReturn',FaxNo:@RM:ReturnCtrl) END END RETURN * * * * * * * Print: * * * * * * * IF NOT(Security_Check('Quote',PRINT$)) THEN Security_Err_Msg('Quote',PRINT$) RETURN END QuoteNo = Get_Property(@WINDOW,'ID') ConfirmFlag = Parm1 ReadFlag = 0 IF Get_Property(@WINDOW,'SAVEWARN') THEN Send_Event(@WINDOW,'WRITE') ReadFlag = 1 END PrintQuote(QuoteNo,ConfirmFlag) ;* New version is PrintQuote, old one was Print_Quote IF ReadFlag THEN obj_Appwindow('LoadFormKeys',@WINDOW:@RM:QuoteNo) RETURN * * * * * * * Duplicate: * * * * * * * QuoteNo = Get_Property(@WINDOW,'ID') Send_Event(@WINDOW,'WRITE') NewQuoteNo = NextKey('QUOTE') NewRec = XLATE('QUOTE',QuoteNo,'','X') NewRec = '' NewRec = Date() NewRec = @USER4 NewRec = 'U' NewRec = 'O' TableVar = '' obj_Tables('WriteRec','QUOTE':@RM:NewQuoteNo:@RM:TableVar:@RM:NewRec) obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NewQuoteNo) RETURN * * * * * * * CloseQuote: * * * * * * * CurrStatus = Get_Property(@WINDOW:'.STATUS','VALUE') IF CurrStatus = 'C' THEN RETURN ;* Already returned MsgInfo = '' MsgInfo = 'Are you sure you wish to close this Quote?' MsgInfo = '?' MsgInfo = 'BNY' Reply = Msg(@WINDOW,MsgInfo) IF Reply = 1 THEN Set_Property(@WINDOW:'.STATUS','VALUE',1) Set_Property(@WINDOW,'SAVEWARN',1) END RETURN * * * * * * * SendMessage: * * * * * * * QuoteNo = Get_Property(@WINDOW,'ID') IF QuoteNo = '' THEN RETURN QBFList = Get_Property(@WINDOW,'QBFLIST') IF QBFList = '' THEN Send_Event(@WINDOW,'WRITE') END Dummy = Dialog_Box('NOTES_ATTACH',@WINDOW,'QUOTE2*':QuoteNo:'*':QBFList) IF QBFList = '' THEN obj_Appwindow('LoadFormKeys', @WINDOW:@RM:QuoteNo) END RETURN * * * * * * * StepGF: * * * * * * * * * * * * * * StepPC: * * * * * * * CtrlEntID = @WINDOW:'.PROC_STEP' PrevSelPos = Get_Property(CtrlEntId,"PREVSELPOS") PrevCol = PrevSelPos<1> PrevRow = PrevSelPos<2> CurrPos = Get_Property(CtrlEntId,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> ListData = Get_Property(CtrlEntId,'LIST') RowData = ListData Step = RowData<1,COL$STEP> PSNo = RowData<1,COL$PSN> Dopants = RowData<1,COL$DOPANTS> StepDesc = RowData<1,COL$STEP_DESC> IF CurrRow NE PrevRow AND CurrRow > PrevRow THEN * Check row for required fields and return focus to first missing field in previous line BadRow = 1 BadCol = '' BEGIN CASE CASE Step = '' BadCol = COL$STEP Mesg = 'Please fill in Step column.' CASE PSNo = '' BadCol = COL$PSN Mesg = 'Please fill in PSN column.' CASE 1 BadRow = 0 END CASE IF BadRow THEN ErrMsg(Mesg) Set_Property(CtrlEntId,"SELPOS",BadCol:@FM:PrevRow) RETURN END * Previous Row is OK - Check new row for blank and back up to first blank line CurrRowData = ListData CONVERT @VM TO '' IN CurrRowData IF CurrRowData = '' THEN CurrLine = CurrRow LOOP Step = ListData UNTIL Step NE '' CurrLine -=1 REPEAT Set_Property(CtrlEntId,"SELPOS",1:@FM:CurrLine) END END ELSE IF CurrRow = PrevRow THEN * Check current line for fields BadCol = '' BEGIN CASE CASE CurrCol > COL$STEP AND Step = '' BadCol = COL$STEP Mesg = 'Please fill in Step column.' CASE CurrCol > COL$PSN AND PSNo = '' BadCol = COL$PSN Mesg = 'Please fill in PSN column.' END CASE IF BadCol THEN IF Mesg NE '' THEN ErrMsg(Mesg) Set_Property(CtrlEntId,"SELPOS",BadCol:@FM:CurrRow) RETURN END * Post Prompt checks on columns * BEGIN CASE CASE PrevCol = COL$STEP AND Step NE '' ; * Verify Step Number (should equal line number) IF Step NE CurrRow THEN ErrMsg("Step Number doesn't match Line Number.") Set_Property(CtrlEntID,'INVALUE','',PrevSelPos) Set_Property(CtrlEntID,'SELPOS',PrevSelPos) END CASE PrevCol = COL$PSN AND PSNo NE '' ;* * * Verify Product Specification Number is Valid * * * IF PSNo NE '' THEN PSNRec = XLATE('PROD_SPEC',PSNo,'','X') IF PSNRec = '' THEN Message = 'PSNo ':PSNo:' is not a valid PSNo.':CRLF Message<1,2> = "To lookup a PSNo double click in the PSN column." ErrMsg(Message) Set_Property(CtrlEntID,'CELLPOS','',PrevSelPos) Set_Property(CtrlEntId,'SELPOS',PrevSelPos) END ELSE QuoteNo = Get_Property(@WINDOW:'.QUOTE_NO','TEXT') CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF PSNRec NE CustNo THEN Message = 'PSNo ':PSNo:' is for a different customer!':CRLF$ Message<1,2> = "To lookup a PSNo double click in the PSN column." ErrMsg(Message) Set_Property(CtrlEntID,'INVALUE','',PrevSelPos) Send_Event(CtrlEntID,'CALCULATE',COL$DOPANTS) Set_Property(CtrlEntID,'SELPOS',PrevSelPos) END END END END CASE END ELSE ;* End of check for PrevRow = CurrRow * Moved UP into existing data CurrRowData = ListData *NextCode = CurrRowData<1,COL$CODE> *debug END END GOSUB Refresh RETURN * * * * * * * StepDC: * * * * * * * CtrlEntID = @WINDOW:'.PROC_STEP' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> RowData = Get_Property(CtrlEntId,'ROWDATA') Step = RowData PSNo = RowData CompNo = Get_Property(@WINDOW:'.CUST_NO','TEXT') IF PSNo = '' AND CompNo NE '' THEN SearchString = 'CUST_ID':@VM:CompNo:@FM Option = '' Flag = '' OPEN 'DICT.PROD_SPEC' TO DictVar ELSE RETURN Btree.Extract(SearchString, 'PROD_SPEC', DictVar, PSNos, Option, Flag) IF Get_Status(errCode) THEN ErrMsg(errCode) IF PSNos = '' THEN ErrMsg('No PSNs on file for company ':QUOTE(CompNo)) RETURN END PSNo = '' IF INDEX(PSNos,@VM,1) THEN TypeOver = '' TypeOver = PSNos PSNo = Popup(@WINDOW,TypeOver,'PROD_SPEC') IF Get_Status(errCode) THEN ErrMsg(errCode) END ELSE PSNo = PSNos END IF PSNo NE '' THEN obj_AppWindow('LUValReturn',PSNo:@RM:CtrlEntID:@RM:CurrPos) END END ELSE * Display the Prod Spec Window obj_AppWindow('ViewRelated','PROD_SPEC':@RM:PSNo) IF Get_Status(errCode) THEN ErrMsg(errCode) END END RETURN