open-insight/LSL2/STPROC/COMM_QUOTE.txt
Infineon\Mitchem 741a8450e3 Removed referenced to QUOTE_SIG_PWD_ENTRY and
replaced with NDW_VERIFY_USER. Added barcode
scan function to NDW_VERIFY_USER.

fixed two instances of ohms square unit characters being garbled by git

minor modification to NDW_VERIFY_USER_EVENTS lost focus events

minor change to gotfocus event logic
2025-04-09 12:49:28 -07:00

1008 lines
22 KiB
Plaintext

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<I,1> = '' 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<Line,1> 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')<COL$PSN_STATUS>
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<PSELECT$> = 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<PDISPLAY$> = NameNos
TypeOver<PTITLE$> = '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('NDW_VERIFY_USER', @Window, @User4)
Valid = Valid<1>
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<QUOTE_SIGNATURES$> = ''
NewRec<QUOTE_ENTRY_DATE$> = Date()
NewRec<QUOTE_ENTRY_ID$> = @USER4
NewRec<QUOTE_STATUS$> = 'U'
NewRec<QUOTE_INQUIRY_STATUS$> = '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<MTEXT$> = 'Are you sure you wish to close this Quote?'
MsgInfo<MICON$> = '?'
MsgInfo<MTYPE$> = '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<PrevRow>
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<CurrRow>
CONVERT @VM TO '' IN CurrRowData
IF CurrRowData = '' THEN
CurrLine = CurrRow
LOOP
Step = ListData<CurrLine-1,1>
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<PROD_SPEC_CUST_ID$> 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<CurrRow>
*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<COL$STEP>
PSNo = RowData<COL$PSN>
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<PDISPLAY$> = 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