open-insight/LSL2/STPROC/COMM_ANN_CONT.txt
2024-03-25 14:46:21 -07:00

796 lines
19 KiB
Plaintext

COMPILE FUNCTION Comm_Ann_Cont(Instruction, Parm1,Parm2)
/*
Commuter module for ANN_CONT (Annual Contract) window
07/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,ErrMsg
DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals
DECLARE FUNCTION Send_Message, Msg, Security_Check, RowExists, obj_Prod_Ord, obj_Annual_Contracts, NextKey
$INSERT POPUP_EQUATES
$INSERT LOGICAL
$INSERT MSG_EQUATES
$INSERT APPCOLORS
$INSERT QUOTE_SIGS_EQU
$INSERT LSL_USERS_EQU
$INSERT SECURITY_RIGHTS_EQU
$INSERT ANNUAL_CONTRACTS_EQU
$INSERT PROD_SPEC_EQU
$INSERT QUOTE_EQU
$INSERT NOTIFICATION_EQU
EQU CRLF$ TO \0D0A\
EQU COL$QUOTE_NO TO 1 ;* Equates for Quote Table on 1st page
EQU COL$QSTATUS TO 2
EQU COL$PART_NO TO 3
EQU COL$QUOTE_PSN TO 4
EQU COL$QUOTE_DESC TO 5
EQU COL$PRO_NO TO 1
EQU COL$ORD_DT TO 2
EQU COL$CUST_PO_NO TO 3
EQU COL$CUST_PO_LINE TO 4
EQU COL$CUST_PO_REL TO 5
EQU COL$SETUP_CHG TO 6
EQU COL$WAFER_CNT TO 7
EQU COL$WAFER_AMT TO 8
EQU COL$REL_NO TO 1
EQU COL$PO_REL TO 2
EQU COL$DATE TO 3
EQU COL$WO_LOG TO 4
EQU COL$SETUP TO 5
EQU COL$QTY TO 6
EQU COL$PRICE TO 7
EQU COL$AMOUNT TO 8
ErrTitle = 'Error in Comm_Ann_Cont'
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 = '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 = 'LUACNo' ; GOSUB LUACNo
CASE Instruction = 'QuoteDC' ; GOSUB QuoteDC
CASE Instruction = 'QuotePC' ; GOSUB QuotePC
CASE Instruction = 'CustChar' ; GOSUB CustChar
CASE Instruction = 'LUCustNo' ; GOSUB LUCustNo
CASE Instruction = 'ViewCust' ; GOSUB ViewCust
CASE Instruction = 'LUNameNo' ; GOSUB LUNameNo
CASE Instruction = 'ViewName' ; GOSUB ViewName
CASE Instruction = 'ProdOrdDC' ; GOSUB ProdOrdDC
CASE Instruction = 'SendMessage' ; GOSUB SendMessage
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
IF NOT(Security_Check('Annual Contracts',READ$)) THEN
Security_Err_Msg('Annual Contracts',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
GOSUB Refresh
RETURN
* * * * * * *
Clear:
* * * * * * *
Send_Event(@WINDOW,'PAGE',1)
obj_AppWindow('ReadOnly',@RM:1) ;* Reenables data bound controls
* * * * * * *
Refresh:
* * * * * * *
IF Security_Check('Annual Contracts',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':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.CLOSE_DATE' ; Props := 'TEXT'
Vals = Get_Property(Ctrls,Props)
EnterBy = Vals[1,@RM]
EnterDTM = Vals[COL2()+1,@RM]
CloseDt = Vals[COL2()+1,@RM]
IF EnterBy = '' THEN Vals = 1:@RM ELSE Vals = 0:@RM
IF EnterDTM = '' 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)
ACNo = Get_Property(@WINDOW,'ID')
IF ACNo = '' THEN
Set_Property(@WINDOW:'.NEW_BUTTON','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.NEW_BUTTON','ENABLED',0)
END
CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT')
IF CustNo = '' THEN
Set_Property(@WINDOW:'.QUOTE_GROUP','ENABLED',0)
END ELSE
Set_Property(@WINDOW:'.QUOTE_GROUP','ENABLED',1)
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<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 I
NEXT I
QCtrl = @WINDOW:'.QUOTE_TABLE'
QuoteList = Get_Property(QCtrl,'LIST')
FOR I = 1 TO COUNT(QuoteList,@FM) + (QuoteList NE '')
QStatFirst = QuoteList<I,COL$QSTATUS>[1,1]
IF QStatFirst NE 'O' AND QStatFirst NE '' THEN
stat = Send_Message(QCtrl,'COLOR_BY_POS',COL$QSTATUS,I,YELLOW$)
END
NEXT I
TotalList = Get_Property(@WINDOW:'.TOTALS_TABLE','LIST') ;* One line edit table 3 columns wide
Balance = TotalList<1,3>
IF Balance NE '' THEN
IF Balance <= 0 THEN
stat = Send_Message(@WINDOW:'.TOTALS_TABLE','COLOR_BY_POS',3,1,RED$)
END ELSE
stat = Send_Message(@WINDOW:'.TOTALS_TABLE','COLOR_BY_POS',3,1,GREEN$)
END
END
RETURN
* * * * * * *
Page:
* * * * * * *
obj_Appwindow('Page')
GOSUB Refresh
RETURN
* * * * * * *
Read:
* * * * * * *
* * * This is called from the event handler as a PreRead event * * *
ProdOrdNo = Get_Property(@WINDOW:'AC_NO','TEXT')
IF NOT(RowExists('ANNUAL_CONTRACTS',ProdOrdNo)) THEN
IF NOT(Security_Check('Annual Contracts',WRITE$)) THEN
Security_Err_Msg('Annual Contracts',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:'.CUST_NO', "FOCUS",1)
END
GOSUB Refresh
RETURN
* * * * * * *
Write:
* * * * * * *
Ctrls = @WINDOW:'.TOTALS_TABLE':@RM ; Props = 'LIST':@RM
Ctrls := @WINDOW:'.MIN_BALANCE':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.STATUS':@RM ; Props := 'VALUE':@RM
Ctrls := @WINDOW:@RM ; Props := 'ID':@RM
Ctrls := @WINDOW:@RM ; Props := 'SAVEWARN':@RM
Ctrls := @WINDOW:'.CUST_NAME' ; Props := 'TEXT'
Vals = Get_Property(Ctrls,Props)
Totals = Vals[1,@RM]
MinBalance = Vals[COL2()+1,@RM]
Status = Vals[COL2()+1,@RM]
ACId = Vals[COL2()+1,@RM]
SaveWarn = Vals[COL2()+1,@RM]
CustName = Vals[COL2()+1,@RM]
Totals = OCONV(ICONV(Totals,'MD2'),'MD2') ;* Remove any commas
MinBalance = OCONV(ICONV(MinBalance,'MD2'),'MD2')
OrderTotal = Totals<1,1> ; * This is from a single row edit table -> three columns
RelTotal = Totals<1,2>
Balance = Totals<1,3>
IF MinBalance = '' THEN MinBalance = '1001.00' ;* default = $1001.00
IF Balance <= MinBalance THEN
Balance = OCONV(ICONV(Balance,'MD2'),'MD2,$')
Mesg = 'The Current Balance on Annual Contract No ':ACID
Mesg := ' for ':CustName:' is below minimum at ':Balance
Recipient = XLATE('NOTIFICATION','ANN_CONT',NOTIFICATION_USER_ID$,'X')
Create_Note(Recipient,'System','Annual Contract Balance',Mesg,'ANNUAL_CONTRACTS',ACId)
END
IF Status = 'C' AND SaveWarn THEN
MsgInfo = ''
MsgInfo<MTYPE$> = 'BNY'
MsgInfo<MTEXT$> = 'This contract is closed!':CRLF$:'Are you sure you wish to save changes?'
MsgInfo<MICON$> = '!'
SaveIt = Msg(@WINDOW,MsgInfo,'')
IF SaveIt THEN
Result = 1
END ELSE
Result = 0
END
END
Result = 1 ;* Perform the write event
RETURN
* * * * * * *
Delete:
* * * * * * *
IF Security_Check('Annual Contracts',Delete$) THEN
Result = 1 ;* Proceed with delete
END ELSE
Security_Err_Msg('Annual Contracts',Delete$)
Result = 0 ;* Stop event chain
END
RETURN
* * * * * * *
New:
* * * * * * *
ACNo = Get_Property(@WINDOW,'ID')
IF ACNo = '' THEN
NextACNo = NextKey('ANNUAL_CONTRACTS')
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NextACNo)
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
* * * * * * *
LUACNo:
* * * * * * *
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
Set_Status(0)
ACKeys = obj_Annual_Contracts('Find')
IF ACKeys = '' THEN RETURN
CONVERT @FM TO @VM IN ACKeys
TypeOver = ''
TypeOver<PDISPLAY$> = AcKeys
TypeOver<PTITLE$> = 'Annual Contracts'
TypeOver<PSELECT$> = 2 ;* multiple select
Set_Status(0)
ACKeys = Popup(@WINDOW,TypeOver,'COMP_ANN_CONT')
IF Get_Status(errCode) THEN ErrMsg(errCode)
IF INDEX(ACKeys,@VM,1) THEN
Send_Event(@WINDOW,'QBFINIT')
Set_Property(@WINDOW,'QBFLIST',ACKeys)
GOSUB Refresh
Send_Event(@WINDOW,'QBFIRST')
END ELSE
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ACKeys)
END
RETURN
* * * * * * *
Close:
* * * * * * *
obj_Notes('Inbox',@USER4) ;* Checks for any new messages
RETURN
* * * * * * *
QuoteDC:
* * * * * * *
* DoubleClick event handler for the Quotes Table
CtrlEntId = @WINDOW:'.QUOTE_TABLE'
CurrPos = Get_Property(CtrlEntId,'SELPOS')
RowData = Get_Property(CtrlEntId,'ROWDATA')
ColData = Get_Property(CtrlEntId,'ARRAY')
CurrCol = CurrPos<1>
CurrRow = CurrPos<2>
CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT')
IF CurrCol = COL$QUOTE_NO THEN
IF RowData<1,CurrCol> = '' THEN
OPEN 'DICT.QUOTE' TO DictVar THEN
SearchString = 'CUST_NO':@VM:CustNo:@VM:@FM
SearchString := 'STATUS':@VM:'=O':@FM
Btree.Extract(SearchString, 'QUOTE', DictVar, QuoteKeys, '', Flag)
IF Get_Status(errCode) THEN
Msg(@window, MsgUp)
ErrMsg(errCode)
RETURN
END
IF QuoteKeys = '' THEN
ErrMsg('No Quotes on file for customer ':CustNo)
RETURN
END
IF INDEX(QuoteKeys,@VM,1) THEN
QuoteKeys := @VM
CONVERT @VM TO @RM IN QuoteKeys
CALL V119('S','','D','R',QuoteKeys,'')
IF Get_Status(errCode) THEN DEBUG
CONVERT @RM TO @VM IN QuoteKeys
QuoteKeys[-1,1] = '' ;* Strip trailing delimiter
TypeOver = ''
TypeOver<PDISPLAY$> = QuoteKeys
TypeOver<PSELECT$> = 1 ;* Single value select
TypeOver<PTITLE$> = 'Open Quotes for ':OCONV(CustNo,'[XLATE_CONV,COMPANY*CO_NAME]')
QuoteKey = Popup(@WINDOW,TypeOver,'QUOTE')
END ELSE
QuoteKey = QuoteKeys
END
IF QuoteKey NE '' THEN
obj_Appwindow('LUValReturn',QuoteKey:@RM:CtrlEntId:@RM:CurrPos)
END
END ELSE
ErrMsg('Unable to open DICT.QUOTE in COMM_ANN_CONT.')
RETURN
END
END ELSE
QuoteNo = RowData<CurrCol>
IF QuoteNo NE '' THEN
obj_AppWindow('ViewRelated','QUOTE2':@RM:QuoteNo)
END
END ;* End of check for null value in column
END ;* End of check for Quote No column
IF CurrCol = COL$QUOTE_PSN THEN
PSNNos = RowData<CurrCol>
SWAP ', ' WITH @VM IN PSNNos
IF PSNNos NE '' THEN
obj_AppWindow('ViewRelated','PROD_SPEC':@RM:PSNNos)
END
END
CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT')
IF CurrCol = COL$PART_NO AND RowData<CurrCol> = '' THEN
PSNos = RowData<COL$QUOTE_PSN>
SWAP ', ' WITH @VM IN PSNos ;* Changed 11/18/2004 JCH
PartNos = XLATE('PROD_SPEC',PSNos,PROD_SPEC_CUST_PART_NO$,'X')
PartsInTable = ColData<COL$PART_NO>
TableLineCnt = COUNT(PartsInTable,@VM) + (PartsInTable NE '')
LOOP
Test = PartsInTable[-1,1]
UNTIL Test NE @VM
PartsInTable[-1,1] = ''
REPEAT
ExistPartCnt = COUNT(PartsInTable,@VM) + (PartsInTable NE '')
FOR I = 1 TO ExistPartCnt
PartInTable = PartsInTable<1,I>
LOCATE PartInTable IN PartNos USING @VM Setting Pos THEN
PartNos = DELETE(PartNos,1,Pos,0)
END
NEXT I
IF PartNos = '' THEN
ErrMsg('No parts available on associated PSN or all parts already added.')
END
IF INDEX(PartNos,@VM,1) THEN
TypeOver = ''
TypeOver<PTITLE$> = 'Part Numbers on Product Specification ':PSNos
TypeOver<PDISPLAY$> = PartNos
PartNos = Popup(@WINDOW,TypeOver,'PART_NO')
IF PartNos = '' THEN RETURN
END
NewPartCnt = COUNT(PartNos,@VM) + (PartNos NE '')
LinesAvailable = TableLineCnt - (ExistPartCnt + NewPartCnt)
IF LinesAvailable <= 0 THEN
NewLines = ((LinesAvailable*-1) + 1)
FOR I = 1 TO NewLines
stat = Send_Message(CtrlEntID, "INSERT", -1, STR(@VM,6))
NEXT I
END
IF INDEX(PartNos,@VM,1) THEN
QuoteNo = RowData<COL$QUOTE_NO>
FOR I = 1 TO COUNT(PartNos,@VM) + (PartNos NE '')
PartNo = PartNos<1,I>
TRow = (CurrRow + I - 1)
obj_Appwindow('LUValReturn',QuoteNo:@RM:CtrlEntID:@RM:COL$QUOTE_NO:@FM:(CurrRow + I -1))
*Send_Event(CtrlEntID,'CALCULATE',COL$PSTATUS)
obj_Appwindow('LUValReturn',PartNo:@RM:CtrlEntID:@RM:COL$PART_NO:@FM:(CurrRow + I -1))
NEXT I
END ELSE
obj_Appwindow('LUValReturn',PartNos:@RM:CtrlEntID:@RM:CurrPos)
END
END
GOSUB Refresh
RETURN
* * * * * * *
QuotePC:
* * * * * * *
CtrlEntId = @WINDOW:'.QUOTE_TABLE'
Ctrls = CtrlEntId:@RM ; Props = 'SELPOS':@RM
Ctrls := CtrlEntId:@RM ; Props := 'LIST':@RM
Ctrls := CtrlEntId:@RM ; Props := 'ARRAY':@RM
Ctrls := CtrlEntId ; Props := 'PREVSELPOS'
Vals = Get_Property(Ctrls,Props)
CurrPos = Vals[1,@RM]
ListData = Vals[COL2()+1,@RM]
ColData = Vals[COL2()+1,@RM]
PrevPos = Vals[COL2()+1,@RM]
CurrCol = CurrPos<1>
CurrRow = CurrPos<2>
PrevCol = PrevPos<1>
PrevRow = PrevPos<2>
QStatus = ListData<CurrRow,COL$QSTATUS>
PSNNo = ListData<CurrRow,COL$QUOTE_PSN>
QuoteNo = ListData<PrevRow,COL$QUOTE_NO>
PSNNos = ListData<PrevRow,COL$QUOTE_PSN>
PartNo = ListData<PrevRow,COL$PART_NO>
SWAP ', ' WITH @VM IN PSNNos
IF PrevCol = COL$QUOTE_NO AND QuoteNo NE '' THEN
CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT')
QuoteRec = XLATE('QUOTE',QuoteNo,'','X')
IF QuoteRec<QUOTE_CUST_NO$> NE CustNO THEN
ErrMsg('Quote is for a different customer!')
Set_Property(CtrlEntID,'INVALUE','',PrevPos)
Send_Event(CtrlEntID,'CALCULATE',COL$QSTATUS)
Set_Property(CtrlEntID,'SELPOS',PrevPos)
END
END
IF PrevCol = COL$PART_NO AND PartNo NE '' THEN
PSNParts = XLATE('PROD_SPEC',PSNNos,PROD_SPEC_CUST_PART_NO$,'X')
LOCATE PartNo IN PSNParts USING @VM SETTING Dummy ELSE
ErrMsg('Part No is not listed on the associated PSN!')
Set_Property(CtrlEntID,'INVALUE','',PrevPos)
Set_Property(CtrlEntID,'SELPOS',PrevPos)
END
END
GOSUB Refresh
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
* * * * * * *
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<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_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
* * * * * * *
ProdOrdDC:
* * * * * * *
ACNo = Get_Property(@WINDOW,'ID')
CtrlEntID = @WINDOW:'.PROD_ORDER'
CurrPos = Get_Property(CtrlEntID,'SELPOS')
CurrCol = CurrPos<1>
CurrRow = CurrPos<2>
OrdNo = Get_Property(CtrlEntID,'CELLPOS',COL$PRO_NO:@FM:CurrRow)
IF OrdNo NE '' THEN
obj_Appwindow('ViewRelated','ORDER2':@RM:OrdNo)
END
RETURN
* * * * * * *
SendMessage:
* * * * * * *
ACNo = Get_Property(@WINDOW,'ID')
IF ACNo = '' THEN RETURN
QBFList = Get_Property(@WINDOW,'QBFLIST')
IF QBFList = '' THEN
Send_Event(@WINDOW,'WRITE')
END
Dummy = Dialog_Box('NOTES_ATTACH',@WINDOW,'ANN_CONT*':ACNo:'*':QBFList)
IF QBFList = '' THEN
obj_Appwindow('LoadFormKeys', @WINDOW:@RM:ACNo)
END
RETURN