added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
421
LSL2/STPROC/COMM_PRS_QUERY.txt
Normal file
421
LSL2/STPROC/COMM_PRS_QUERY.txt
Normal file
@ -0,0 +1,421 @@
|
||||
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
|
||||
Reference in New Issue
Block a user