added LSL2 stored procedures
This commit is contained in:
269
LSL2/STPROC/OBJ_EPI_PART.txt
Normal file
269
LSL2/STPROC/OBJ_EPI_PART.txt
Normal file
@ -0,0 +1,269 @@
|
||||
COMPILE FUNCTION obj_Epi_Part(Method,Parms)
|
||||
|
||||
/*
|
||||
Methods for Epi_Part table
|
||||
|
||||
3/16/2011 JCH - Initial Coding
|
||||
|
||||
Properties:
|
||||
|
||||
Methods:
|
||||
|
||||
* ThickMin() ;* Returns Property
|
||||
* ThickMax() ;*
|
||||
* ResMin() ;*
|
||||
* ResMax() ;*
|
||||
|
||||
*/
|
||||
|
||||
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, Send_Dyn, ErrMsg, obj_Appwindow
|
||||
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey, obj_Prod_Spec
|
||||
|
||||
|
||||
$INSERT EPI_PART_EQUATES
|
||||
$INSERT PROD_VER_EQUATES
|
||||
|
||||
$INSERT PRS_LAYER_EQU
|
||||
$INSERT PROD_SPEC_EQUATES
|
||||
$INSERT QUOTE_SPEC_EQU
|
||||
|
||||
|
||||
ErrTitle = 'Error in Stored Procedure "obj_Epi_Part"'
|
||||
ErrorMsg = ''
|
||||
|
||||
IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine'
|
||||
IF NOT(ASSIGNED(Parms)) THEN Parms = ''
|
||||
|
||||
IF ErrorMsg NE '' THEN
|
||||
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
||||
RETURN ''
|
||||
END
|
||||
|
||||
Result = ''
|
||||
|
||||
BEGIN CASE
|
||||
|
||||
CASE Method = 'ThickTargAll' ; GOSUB ThickTargAll
|
||||
CASE Method = 'ResTargAll' ; GOSUB ResTargAll
|
||||
CASE Method = 'LoadLayers' ; GOSUB LoadLayers
|
||||
CASE Method = 'SetSubstrate' ; GOSUB SetSubstrate
|
||||
CASE Method = 'AllPSNos' ; GOSUB AllPSNos
|
||||
|
||||
CASE 1
|
||||
ErrorMsg = 'Unknown Method ':Method:' passed to object routine.'
|
||||
|
||||
END CASE
|
||||
|
||||
IF ErrorMsg NE '' THEN
|
||||
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
||||
END
|
||||
|
||||
RETURN Result
|
||||
|
||||
|
||||
|
||||
* * * * * * *
|
||||
ThickTargAll:
|
||||
* * * * * * *
|
||||
|
||||
EpiPN = Parms[1,@RM]
|
||||
EpiPartRec = Parms[COL2()+1,@RM]
|
||||
|
||||
IF EpiPN = '' THEN RETURN
|
||||
|
||||
IF EpiPartRec = '' THEN
|
||||
EpiPartRec = XLATE('EPI_PART',EpiPN,'','X')
|
||||
END
|
||||
|
||||
IF EpiPartRec = '' THEN RETURN
|
||||
|
||||
ActiveProdVerNos = EpiPartRec<EPI_PART_PROD_VER_NO$>
|
||||
|
||||
|
||||
ProdVerRec = XLATE('PROD_VER',ActiveProdVerNos<1,1>,'','X')
|
||||
|
||||
ProcStepPSNs = ProdVerRec<PROD_VER_PROC_STEP_PSN$>
|
||||
|
||||
StepCnt = COUNT(ProcStepPSNs,@VM) + (ProcStepPSNs NE '')
|
||||
|
||||
FOR I = 1 To StepCnt
|
||||
PSNo = ProcStepPSNs<1,I>
|
||||
|
||||
ThickTargAll = XLATE('PROD_SPEC',PSNo,'THICK_TARGET_ALL','X')
|
||||
Result<1,-1> = ThickTargAll
|
||||
|
||||
NEXT I
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
ResTargAll:
|
||||
* * * * * * *
|
||||
|
||||
EpiPN = Parms[1,@RM]
|
||||
EpiPartRec = Parms[COL2()+1,@RM]
|
||||
|
||||
IF EpiPN = '' THEN RETURN
|
||||
|
||||
IF EpiPartRec = '' THEN
|
||||
EpiPartRec = XLATE('EPI_PART',EpiPN,'','X')
|
||||
END
|
||||
|
||||
IF EpiPartRec = '' THEN RETURN
|
||||
|
||||
ActiveProdVerNos = EpiPartRec<EPI_PART_PROD_VER_NO$>
|
||||
|
||||
|
||||
ProdVerRec = XLATE('PROD_VER',ActiveProdVerNos<1,1>,'','X')
|
||||
|
||||
ProcStepPSNs = ProdVerRec<PROD_VER_PROC_STEP_PSN$>
|
||||
|
||||
StepCnt = COUNT(ProcStepPSNs,@VM) + (ProcStepPSNs NE '')
|
||||
|
||||
FOR I = 1 To StepCnt
|
||||
PSNo = ProcStepPSNs<1,I>
|
||||
|
||||
ResTargAll = XLATE('PROD_SPEC',PSNo,'RES_TARGET_ALL','X')
|
||||
Result<1,-1> = ResTargAll
|
||||
|
||||
NEXT I
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
LoadLayers:
|
||||
* * * * * * *
|
||||
|
||||
EpiPN = Parms[1,@RM]
|
||||
|
||||
IF EpiPN = '' THEN RETURN
|
||||
|
||||
IF @USERNAME NE 'BRYCE_BARB' THEN
|
||||
ErrMsg('This button is officially dead. Plan "B" has been placed in action...')
|
||||
RETURN
|
||||
END
|
||||
|
||||
|
||||
|
||||
TableVar = ''
|
||||
OtParms = 'EPI_PART':@RM:EpiPN:@RM:TableVar
|
||||
EpiPartRec = obj_Tables('ReadRec',OtParms) ;* Locks and reads record for update
|
||||
|
||||
IF EpiPartRec = '' THEN RETURN
|
||||
|
||||
ActiveProdVerNos = EpiPartRec<EPI_PART_PROD_VER_NO$>
|
||||
|
||||
ProdVerRec = XLATE('PROD_VER',ActiveProdVerNos<1,1>,'','X')
|
||||
|
||||
EpiLayers = ''
|
||||
EpiSteps = ''
|
||||
EpiStepLSIDs = ''
|
||||
EpiDopants = ''
|
||||
EpiThickMins = ''
|
||||
EpiThickMaxs = ''
|
||||
EpiResMins = ''
|
||||
EpiResMaxs = ''
|
||||
|
||||
ProcStepNos = ProdVerRec<PROD_VER_PROC_STEP_NO$>
|
||||
StepCnt = COUNT(ProcStepNos,@VM) + (ProcStepNos NE '')
|
||||
|
||||
EpiLayerNo = 0 ;* Counter used to build generate layer numbers
|
||||
EpiLayers = '' ;* MV'd list of real (numeric) and intermediate (spec only)layers (CMB)
|
||||
LineCnt = 1 ;* Line counter for result lines
|
||||
|
||||
FOR I = 1 TO StepCnt
|
||||
StepNo = ProcStepNos<1,I>
|
||||
StepPSN = ProdVerRec<PROD_VER_PROC_STEP_PSN$,I>
|
||||
StepLayerData = obj_Prod_Spec('GetLayerProp',StepPSN:@RM:@RM:1)
|
||||
|
||||
LayerCnt = COUNT(StepLayerData,@RM) + (StepLayerData NE '')
|
||||
|
||||
FOR N = 1 TO LayerCnt
|
||||
Step_LSID = FIELD(StepLayerData,@RM,N)<1>
|
||||
IF Step_LSID = '1' OR Step_LSID[1,1] = 'L' THEN
|
||||
EpiLayerNo += 1
|
||||
END
|
||||
IF NUM(Step_LSID) THEN
|
||||
EpiLayers<1,LineCnt> = 'CMB'
|
||||
END ELSE
|
||||
EpiLayers<1,LineCnt> = EpiLayerNo
|
||||
END
|
||||
|
||||
EpiSteps<1,LineCnt> = ProcStepNos<1,I>
|
||||
EpiStepLSIDs<1,LineCnt> = FIELD(StepLayerData,@RM,N)<1>
|
||||
EpiDopants<1,LineCnt> = FIELD(StepLayerData,@RM,N)<PRS_LAYER_DOPANT$+1>
|
||||
EpiThickMins<1,LineCnt> = FIELD(StepLayerData,@RM,N)<PRS_LAYER_THICK_MIN$+1>
|
||||
EpiThickMaxs<1,LineCnt> = FIELD(StepLayerData,@RM,N)<PRS_LAYER_THICK_MAX$+1>
|
||||
EpiResMins<1,LineCnt> = FIELD(StepLayerData,@RM,N)<PRS_LAYER_RES_MIN$+1>
|
||||
EpiResMaxs<1,LineCnt> = FIELD(StepLayerData,@RM,N)<PRS_LAYER_RES_MAX$+1>
|
||||
|
||||
LineCnt += 1 ;* Total number of all specification lines
|
||||
NEXT N
|
||||
NEXT I
|
||||
|
||||
EpiThickMins = ICONV(OCONV(EpiThickMins,'MD2'),'MD3')
|
||||
EpiThickMaxs = ICONV(OCONV(EpiThickMaxs,'MD2'),'MD3')
|
||||
|
||||
|
||||
EpiPartRec<EPI_PART_EPI_LAYER$> = EpiLayers
|
||||
EpiPartRec<EPI_PART_EPI_STEP$> = EpiSteps
|
||||
EpiPartRec<EPI_PART_EPI_STEP_LSID$> = EpiStepLSIDs
|
||||
EpiPartRec<EPI_PART_EPI_DOPANT$> = EpiDopants
|
||||
EpiPartRec<EPI_PART_EPI_THICK_MIN$> = EpiThickMins
|
||||
EpiPartRec<EPI_PART_EPI_THICK_MAX$> = EpiThickMaxs
|
||||
EpiPartRec<EPI_PART_EPI_RES_MIN$> = EpiResMins
|
||||
EpiPartRec<EPI_PART_EPI_RES_MAX$> = EpiResMaxs
|
||||
|
||||
otParms = FieldStore(OtParms,@RM,4,0,EpiPartRec) ;* Put record in 4th field of OtParms
|
||||
obj_Tables('WriteRec',otParms)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
* * * * * * *
|
||||
SetSubstrate:
|
||||
* * * * * * *
|
||||
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
AllPSNos:
|
||||
* * * * * * *
|
||||
|
||||
EpiPN = Parms[1,@RM]
|
||||
EpiPNRec = Parms[COL2()+1,@RM]
|
||||
|
||||
IF EpiPN = '' THEN RETURN
|
||||
IF EpiPNRec = '' THEN
|
||||
EpiPNRec = XLATE('EPI_PART',EpiPN,'','X')
|
||||
END
|
||||
|
||||
IF EpiPNRec = '' THEN RETURN
|
||||
|
||||
ActiveProdVerNos = EpiPNRec<EPI_PART_PROD_VER_NO$>
|
||||
InActiveProdVerNos = EpiPNRec<EPI_PART_INACTIVE_PROD_VER_NO$>
|
||||
|
||||
AllPSNs = ''
|
||||
ActiveCnt = COUNT(ActiveProdVerNos,@VM) + (ActiveProdVerNos NE '')
|
||||
|
||||
FOR I = 1 TO ActiveCnt
|
||||
ProdVerNo = ActiveProdVerNos<1,I>
|
||||
PSNos = XLATE('PROD_VER',ProdVerNo,PROD_VER_PROC_STEP_PSN$,'X')
|
||||
|
||||
StepCnt = COUNT(PSNos,@VM) + (PSNos NE '')
|
||||
FOR N = 1 TO StepCnt
|
||||
LOCATE PSNos<1,N> IN AllPSNs USING @VM SETTING Pos ELSE
|
||||
AllPSNs = INSERT(AllPSNs,1,Pos,0,PSNos<1,N>)
|
||||
END
|
||||
NEXT N
|
||||
|
||||
NEXT I
|
||||
|
||||
Result = AllPSNs
|
||||
|
||||
RETURN
|
Reference in New Issue
Block a user