422 lines
9.0 KiB
Plaintext
422 lines
9.0 KiB
Plaintext
COMPILE FUNCTION Comm_PRS_QUERY(Instruction, Parm1,Parm2)
|
|
|
|
/*
|
|
Commuter module for PRS_QUERY (Product Specification Query) window
|
|
|
|
06/07/2004 - John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status,
|
|
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow
|
|
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup
|
|
DECLARE FUNCTION Send_Message, obj_PR_Spec, Collect.IXVals
|
|
|
|
$INSERT POPUP_EQUATES
|
|
$INSERT COMPANY_EQU
|
|
$INSERT APPCOLORS
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
|
|
EQU COL$CUST_NO TO 1
|
|
EQU COL$CUST_NAME TO 2
|
|
|
|
EQU COL$ACT_CODE TO 1
|
|
EQU COL$ACT_DESC TO 2
|
|
|
|
ErrTitle = 'Error in Comm_PRS_Query'
|
|
ErrorMsg = ''
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Instruction = 'Create' ; GOSUB Create
|
|
CASE Instruction = 'CustInfoPC' ; GOSUB CustInfoPC
|
|
CASE Instruction = 'CustInfoLF' ; GOSUB CustInfoLF
|
|
CASE Instruction = 'ActivationPC' ; GOSUB ActivationPC
|
|
CASE Instruction = 'ActivationLF' ; GOSUB ActivationLF
|
|
CASE Instruction = 'LUCustNo' ; GOSUB LUCustNo
|
|
CASE Instruction = 'LUPartNo' ; GOSUB LUPartNo
|
|
CASE Instruction = 'LUActStatus' ; GOSUB LUActStatus
|
|
CASE Instruction = 'LUSpecPhase' ; GOSUB LUSpecPhase
|
|
CASE Instruction = 'LURecipeType' ; GOSUB LURecipeType
|
|
CASE Instruction = 'PQuery' ; GOSUB PQuery
|
|
CASE Instruction = 'Cancel' ; GOSUB Cancel
|
|
CASE 1
|
|
ErrorMsg = 'Unknown Instruction passed to routine.'
|
|
ErrMsg(ErrorMsg)
|
|
END CASE
|
|
|
|
RETURN Result
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
obj_Appwindow('Create',@WINDOW)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
CustInfoPC:
|
|
* * * * * * *
|
|
|
|
CurrPos = Get_Property(@WINDOW:'.CUSTOMER_INFO','SELPOS')
|
|
CurrCol = CurrPos<1>
|
|
CurrRow = CurrPos<2>
|
|
|
|
CurrRowData = Get_Property(@WINDOW:'.CUSTOMER_INFO','ROWDATA')
|
|
|
|
CustNo = CurrRowData<1,COL$CUST_NO>
|
|
|
|
IF NOT(NUM(CustNo)) THEN
|
|
CONVERT @LOWER_CASE TO @UPPER_CASE IN CustNo
|
|
OPEN 'DICT.COMPANY' TO DictVar THEN
|
|
|
|
SearchString = 'CO_NAME':@VM:CustNo:']':@FM
|
|
Option = ''
|
|
Flag = ''
|
|
CompanyKeys = ''
|
|
Btree.Extract(SearchString, 'COMPANY', DictVar, CompanyKeys, Option, Flag)
|
|
IF Get_Status(errCode) THEN ErrMsg(errCode)
|
|
|
|
PTypeOver = ''
|
|
PTypeOver<PDISPLAY$> = CompanyKeys
|
|
PTypeOver<PSELECT$> = 1
|
|
CustNo = Popup(@WINDOW,PTypeOver,'PRS_COMPANIES') ;* Table is both customer and vendors %$&%^@!$%#
|
|
|
|
Set_Property(@WINDOW:'.CUSTOMER_INFO','DEFPROP',CustNo,COL$CUST_NO:@FM:CurrRow)
|
|
|
|
END
|
|
END
|
|
|
|
CustName = XLATE('COMPANY',CustNo,4,'X' )
|
|
Set_Property(@WINDOW:'.CUSTOMER_INFO','DEFPROP',CustName,COL$CUST_NAME:@FM:CurrRow)
|
|
|
|
IF CurrCol = COL$CUST_NAME THEN
|
|
CurrRow += 1
|
|
CurrCol = COL$CUST_NO
|
|
Set_Property(@WINDOW:'.CUSTOMER_INFO','SELPOS',CurrCol:@FM:CurrRow)
|
|
END
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
CustInfoLF:
|
|
* * * * * * *
|
|
|
|
Set_Property(@WINDOW:'.CUSTOMER_INFO','SELPOS',1:@FM:1)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ActivationPC:
|
|
* * * * * * *
|
|
|
|
CurrPos = Get_Property(@WINDOW:'.ACTIVATION','SELPOS')
|
|
CurrCol = CurrPos<1>
|
|
CurrRow = CurrPos<2>
|
|
|
|
CurrRowData = Get_Property(@WINDOW:'.ACTIVATION','ROWDATA')
|
|
|
|
ActCd = CurrRowData<1,COL$ACT_CODE>
|
|
IF ActCd NE '' THEN
|
|
CONVERT @LOWER_CASE TO @UPPER_CASE IN ActCd
|
|
BEGIN CASE
|
|
CASE ActCd[1,1] _EQC 'P' ; ActDesc = 'PreActivation'
|
|
CASE ActCd[1,1] _EQC 'A' ; ActDesc = 'Active'
|
|
CASE ActCd[1,1] _EQC 'I' ; ActDesc = 'Inactive'
|
|
CASE 1
|
|
ErrMsg('Invalid Activation Code')
|
|
Set_Property(@WINDOW:'.ACTIVATION','DEFPROP','',COL$ACT_CODE:@FM:CurrRow)
|
|
Set_Property(@WINDOW:'.ACTIVATION','DEFPROP','',COL$ACT_DESC:@FM:CurrRow)
|
|
Set_Property(@WINDOW:'.ACTIVATION','SELPOS',COL$ACT_CODE:@FM:CurrRow)
|
|
RETURN
|
|
|
|
END CASE
|
|
|
|
Set_Property(@WINDOW:'.ACTIVATION','DEFPROP',ActCd,COL$ACT_CODE:@FM:CurrRow)
|
|
Set_Property(@WINDOW:'.ACTIVATION','DEFPROP',ActDesc,COL$ACT_DESC:@FM:CurrRow)
|
|
END
|
|
|
|
IF CurrCol = COL$ACT_DESC THEN
|
|
CurrRow += 1
|
|
CurrCol = COL$ACT_CODE
|
|
Set_Property(@WINDOW:'.ACTIVATION','SELPOS',CurrCol:@FM:CurrRow)
|
|
END
|
|
|
|
GOSUB Refresh
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ActivationLF:
|
|
* * * * * * *
|
|
|
|
Set_Property(@WINDOW:'.ACTIVATION','SELPOS',1:@FM:1)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUCustNo:
|
|
* * * * * * *
|
|
|
|
CompNos = Collect.IXVals('PR_SPEC','CUST_NO')
|
|
|
|
CONVERT @FM TO @VM IN CompNos
|
|
|
|
IF CompNos[1,1] = @VM THEN CompNos[1,1] = ''
|
|
|
|
PTypeOver = ''
|
|
PTypeOver<PDISPLAY$> = CompNos
|
|
|
|
CompNos = Popup(@WINDOW,PTypeOver,'PRS_COMPANIES')
|
|
|
|
IF Get_Status(errCode) THEN ErrMsg(errCode)
|
|
|
|
IF CompNos NE '' THEN
|
|
CompArray = ''
|
|
CompNames = XLATE('COMPANY',CompNos,COMPANY_CO_NAME$,'X')
|
|
|
|
CompArray<1> = CompNos
|
|
CompArray<2> = CompNames
|
|
|
|
CompArray<1,-1> = '' ;* Add blank line at bottom
|
|
CompArray<2,-1> = ''
|
|
|
|
Set_Property(@WINDOW:'.CUSTOMER_INFO','DEFPROP',CompArray)
|
|
|
|
GOSUB Refresh
|
|
|
|
END
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUPartNo:
|
|
* * * * * * *
|
|
|
|
CustPartNos = Collect.IXVals('PR_SPEC','CUST_PART_NO_XREF')
|
|
|
|
CONVERT @FM TO @VM IN CustPartNos
|
|
|
|
IF CustPartNos[1,1] = @VM THEN CustPartNos[1,1] = '' ;* Null first values cause popups to NOT work!
|
|
|
|
PTypeOver = ''
|
|
PTypeOver<PDISPLAY$> = CustPartNos
|
|
|
|
|
|
CustPartNos = Popup(@WINDOW,PTypeOver,'PART_NO')
|
|
IF Get_Status(errCode) THEN ErrMsg(errCode)
|
|
|
|
IF CustPartNos NE '' THEN
|
|
|
|
CustPartNos<1,-1> = '' ;* Add blank line at the bottom
|
|
Set_Property(@WINDOW:'.PART_NO','DEFPROP',CustPartNos)
|
|
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUActStatus:
|
|
* * * * * * *
|
|
|
|
TypeOver = ''
|
|
TypeOver<PFIELD$> = ''
|
|
TypeOver<PTYPE$> = 'E'
|
|
|
|
Codes = Popup(@WINDOW,TypeOver,'PRS_ACT_STATUS')
|
|
|
|
IF Codes NE '' THEN
|
|
Codes<-1> = '' ;* Add blank line at the bottom
|
|
Set_Property(@WINDOW:'.ACTIVATION','LIST',Codes)
|
|
END
|
|
|
|
GOSUB REFRESH
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LUSpecPhase:
|
|
* * * * * * *
|
|
|
|
Codes = Popup(@WINDOW,'','PRS_PHASE')
|
|
|
|
IF Codes NE '' THEN
|
|
Codes<1,-1> = '' ;* Add blank line at the bottom
|
|
Set_Property(@WINDOW:'.PHASE','DEFPROP',Codes)
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LURecipeType:
|
|
* * * * * * *
|
|
|
|
Recipes = Collect.IXVals('PR_SPEC','GENERIC_RECIPE')
|
|
|
|
CONVERT @FM TO @VM IN Recipes
|
|
|
|
IF Recipes[1,1] = @VM THEN Recipes[1,1] = ''
|
|
|
|
PTypeOver = ''
|
|
PTypeOver<PDISPLAY$> = Recipes
|
|
|
|
Codes = Popup(@WINDOW,PTypeOver,'REACTOR_RECIPE_TYPE')
|
|
IF Get_Status(errCode) THEN ErrMsg(errCode)
|
|
|
|
IF Codes NE '' THEN
|
|
Codes<1,-1> = '' ;* Add blank line at the bottom
|
|
Set_Property(@WINDOW:'.RECIPE_TYPE','DEFPROP',Codes)
|
|
END
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
PQuery:
|
|
* * * * * * *
|
|
|
|
Ctrls = @WINDOW:'.CUSTOMER_INFO':@RM ; Props = 'ARRAY':@RM
|
|
Ctrls := @WINDOW:'.PART_NO':@RM ; Props := 'ARRAY':@RM
|
|
Ctrls := @WINDOW:'.ACTIVATION':@RM ; Props := 'ARRAY':@RM
|
|
Ctrls := @WINDOW:'.PHASE':@RM ; Props := 'ARRAY':@RM
|
|
Ctrls := @WINDOW:'.RECIPE_TYPE' ; Props := 'ARRAY'
|
|
|
|
Vals = Get_Property(Ctrls,Props)
|
|
|
|
CustNos = Vals[1,@RM]<1> ;* These are all arrays with data of interest in the 1st column
|
|
CustPartNos = Vals[COL2()+1,@RM]<1>
|
|
ActStatuses = Vals[COL2()+1,@RM]<1>
|
|
Phases = Vals[COL2()+1,@RM]<1>
|
|
Recipes = Vals[COL2()+1,@RM]<1>
|
|
|
|
|
|
LOOP
|
|
UNTIL CustNos[-1,1] NE @VM
|
|
CustNos[-1,1] = ''
|
|
REPEAT
|
|
|
|
LOOP
|
|
UNTIL CustPartNos[-1,1] NE @VM
|
|
CustPartNos[-1,1] = ''
|
|
REPEAT
|
|
|
|
LOOP
|
|
UNTIL ActStatuses[-1,1] NE @VM
|
|
ActStatuses[-1,1] = ''
|
|
REPEAT
|
|
|
|
LOOP
|
|
UNTIL Phases[-1,1] NE @VM
|
|
Phases[-1,1] = ''
|
|
REPEAT
|
|
|
|
LOOP
|
|
UNTIL Recipes[-1,1] NE @VM
|
|
Recipes[-1,1] = ''
|
|
REPEAT
|
|
|
|
|
|
SearchStr = ''
|
|
|
|
IF CustNos NE '' THEN
|
|
SearchStr<-1> = 'CUST_NO':@VM:CustNos
|
|
END
|
|
|
|
IF CustPartNos NE '' THEN
|
|
SearchStr<-1> = 'CUST_PART_NO_XREF':@VM:CustPartNos
|
|
END
|
|
|
|
IF ActStatuses NE '' THEN
|
|
SearchStr<-1> = 'ACT_STATUS':@VM:ActStatuses
|
|
END
|
|
|
|
IF Phases NE '' THEN
|
|
SearchStr<-1> = 'SPEC_PHASE':@VM:Phases
|
|
END
|
|
|
|
IF Recipes NE '' THEN
|
|
SearchStr<-1> = 'GENERIC_RECIPE':@VM:Recipes
|
|
END
|
|
|
|
IF SearchStr THEN
|
|
|
|
OPEN 'DICT.PR_SPEC' to DictPrSpec ELSE
|
|
ErrMsg('Unable to open DICT.PROD_SPEC...' )
|
|
GOTO Cancel
|
|
END
|
|
|
|
SearchStr := @FM
|
|
Void = utility( 'CURSOR', 'H' )
|
|
|
|
Btree.Extract( SearchStr, 'PR_SPEC', DictPrSpec, PRSpecKeys, '', Flag )
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
GOTO Cancel
|
|
END
|
|
|
|
IF PRSpecKeys = '' THEN
|
|
ErrMsg('No records found matching selection criteria...')
|
|
END ELSE
|
|
PRSpecKeys := @VM
|
|
CONVERT @VM TO @RM IN PRSpecKeys
|
|
CALL V119('S','','D','R',PRSpecKeys,'')
|
|
IF Get_Status(errCode) THEN DEBUG
|
|
CONVERT @RM TO @VM IN PRSpecKeys
|
|
PRSpecKeys[-1,1] = '' ;* Strip trailing delimiter
|
|
CONVERT @VM TO @FM IN PRSpecKeys
|
|
End_Dialog(@WINDOW,PRSpecKeys)
|
|
END
|
|
END
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Refresh:
|
|
* * * * * * *
|
|
|
|
CompArray = Get_Property(@WINDOW:'.CUSTOMER_INFO','ARRAY')
|
|
|
|
FOR I = 1 TO COUNT(CompArray<1>,@VM) + (CompArray<1> NE '')
|
|
Send_Message(@WINDOW:'.CUSTOMER_INFO','COLOR_BY_POS',COL$CUST_NAME,I,GREEN$) ;* Name column -> green background
|
|
NEXT I
|
|
|
|
|
|
ActArray = Get_Property(@WINDOW:'.ACTIVATION','ARRAY')
|
|
|
|
FOR I = 1 TO COUNT(ActArray<1>,@VM) + (ActArray<1> NE '')
|
|
Send_Message(@WINDOW:'.ACTIVATION','COLOR_BY_POS',COL$ACT_DESC,I,GREEN$) ;* Name column -> green background
|
|
NEXT I
|
|
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Cancel:
|
|
* * * * * * *
|
|
|
|
End_Dialog(@WINDOW, '')
|
|
|
|
|
|
RETURN
|