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 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