open-insight/LSL2/STPROC/COMM_COMP_LOOKUP.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

143 lines
3.5 KiB
Plaintext

COMPILE SUBROUTINE COMM_COMP_LOOKUP( Instruction, Parm1,Parm2 )
/*
Commuter module for COMP_LOOKUP window
07/12/2004 - JCH - J.C. Henry, Inc.
*/
DECLARE SUBROUTINE ErrMsg, obj_Appwindow, Set_Property, Btree.Extract, End_Window
DECLARE FUNCTION Get_Property
EQU TRUE$ TO 1
EQU FALSE TO 0
* Sub Clients Table Equates
EQU COL$CLIENT_NO TO 1
EQU COL$CLIENT_TYPE TO 2
EQU COL$CLIENT_NAME TO 3
EQU COL$CLIENT_COMPANY TO 4
EQU COL$CLIENT_DESC TO 5
ReturnVal = ''
* Dispather
BEGIN CASE
CASE Instruction = 'Create' ; GOSUB Create
CASE Instruction = 'OK' ; GOSUB OK
CASE Instruction = 'NameChar' ; GOSUB NameChar
CASE Instruction = 'TableDC' ; GOSUB TableDC
CASE 1
ErrMsg('Invalid Instruction ':QUOTE(Instruction):' passed to COMM_COMP_LOOKUP routine')
END CASE
RETURN ReturnVal
* * * * * *
Create:
* * * * * *
CharacterIn = Parm1<1,1>
CompType = Parm1<1,2>
ReturnToCtrl = Parm1<2>
ReturnToPos = FIELD(Parm1,@FM,3,2) ;* Fields 3 and 4
obj_AppWindow('Create',@WINDOW)
Set_Property(@WINDOW:".NAME","TEXT",CharacterIn)
Set_Property(@WINDOW:'.NAME','SELECTION',LEN(CharacterIn)+1:@FM:65534 )
Set_Property(@WINDOW,'@COMP_TYPE',CompType)
Set_Property(@WINDOW,'@RETURN_TO_CTRL',ReturnToCtrl)
Set_Property(@WINDOW,'@RETURN_TO_POS',ReturnToPos)
* * * * * * *
NameChar:
* * * * * * *
IF Instruction = 'NameChar' THEN
CharacterIn = Get_Property(@WINDOW:'.NAME','TEXT')
END
IF LEN(CharacterIn) < 3 OR CharacterIn[-1,1] = ' ' THEN RETURN
CONVERT ' ' TO @VM IN CharacterIn
SearchCriteria = ''
IF INDEX(CharacterIn,@VM,1) THEN
LastWord = CharacterIn[-1,'B':@VM] ;* Multiple words in name
WordCnt = COUNT(CharacterIn,@VM) + (CharacterIn NE '')
FOR I = 1 TO WordCnt
SearchCriteria := 'CO_NAME_XREF':@VM:CharacterIn<1,I>:']':@FM
NEXT I
END ELSE
SearchCriteria = 'CO_NAME_XREF':@VM:CharacterIn:']':@FM
END
CompType = Get_Property(@WINDOW,'@COMP_TYPE') ;* Can be V(endor), C(ustomer) or O(ther)
OPEN "DICT.COMPANY" To DictVar THEN
IF CompType NE '' THEN
SearchCriteria := 'CO_TYPE':@VM:CompType:@FM
END
KeyList = ''
Option = ''
Flag = ''
Btree.Extract(SearchCriteria, 'COMPANY',DictVar,KeyList,Option,Flag)
KeyCnt = COUNT(KeyList,@VM) + (KeyList NE '')
IF KeyList NE '' THEN
NameArray = ''
ClientTypes = XLATE('COMPANY',KeyList,'CO_TYPE','X')
ClientNames = XLATE('COMPANY',KeyList,'CO_NAME','X')
ClientDivisions = XLATE('COMPANY',KeyList,'DIVISION','X')
ClientCities = XLATE('COMPANY',KeyList,'CITY','X')
NameArray = KeyList:@FM:ClientTypes:@FM:ClientNames:@FM:ClientDivisions:@FM:ClientCities
END
Set_Property(@WINDOW:'.LOOKUP_TABLE','DEFPROP',NameArray)
IF KeyCnt = 1 THEN
Set_Property(@WINDOW:'.LOOKUP_TABLE','SELPOS',1:@FM:1)
Set_Property(@WINDOW:'.OK_BUTTON','FOCUS',1)
END
END ELSE
ErrMsg('Unable to open DICT.CLIENT for index lookup')
END
RETURN
* * * * * * *
TableDC:
* * * * * * *
* * * * * * *
OK:
* * * * * * *
CurrPos = Get_Property(@WINDOW:'.LOOKUP_TABLE','SELPOS')
CurrCol = CurrPos<1>
CurrRow = CurrPos<2>
LookupList = Get_Property(@WINDOW:'.LOOKUP_TABLE','LIST')
CustNo = LookupList<CurrRow,COL$CLIENT_NO>
ReturnToCtrl = Get_Property(@WINDOW,'@RETURN_TO_CTRL')
ReturnToPos = Get_Property(@WINDOW,'@RETURN_TO_POS')
End_Window(@WINDOW)
obj_AppWindow('LUValReturn',CustNo:@RM:ReturnToCtrl:@RM:ReturnToPos:@RM:1) ;* Last Param (SkipCalculate) required when called from collector
RETURN