COMPILE FUNCTION Comm_Dialog_Epi_Pro_Met(Method, Parm1, Parm2) /* Commuter module for Dialog_Epi_Pro_Met window. 05/17/2006 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, End_Dialog, Set_Status, ErrMsg, Send_Event, obj_RDS_Test DECLARE SUBROUTINE obj_Appwindow, Start_Window, Msg, End_Dialog, Send_Message, ErrMsg DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Popup, Send_Message, obj_Test_Point_Map, obj_RDS_Test Declare function Error_Services, MemberOf, Get_EventStatus EQU CRLF$ TO \0D0A\ $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT RDS_EQU $INSERT RDS_TEST_EQUATES $INSERT RDS_LAYER_EQUATES $INSERT REACT_RUN_EQUATES $INSERT REACTOR_EQUATES $INSERT RDS_EPILOAD $INSERT NCR_EQU $INSERT APPCOLORS EQU ORP$THICK_READS TO 1 EQU ORP$SHEET_RHO_READS TO 2 EQU ORP$HGCV1_READS TO 3 EQU EPI_READS$READ_NO TO 1 EQU EPI_READS$THICKNESS TO 2 EQU EPI_READS$SHEET_RHO TO 3 EQU EPI_READS$HGCV1 TO 4 EQU EPI_READS$HGCV2 TO 5 ErrTitle = 'Error in Comm_Dialog_Epi_Pro_Met' ErrorMsg = '' Result = '' BEGIN CASE CASE Method = 'Create' ; GOSUB Create CASE Method = 'Done' ; GOSUB Done CASE Method = 'Refresh' ; GOSUB Refresh CASE Method = 'ReadingsDel' ; GOSUB ReadingsDel CASE 1 ErrMsg(ErrTitle:@SVM:'Unknown method ':QUOTE(Method):' passed to routine.') END CASE RETURN Result * * * * * * * Create: * * * * * * * obj_AppWindow('Create') MetNo = FIELD(Parm1,@FM,1) IF MetNo = '' THEN ErrMsg('Null MetNo passed to Dialog Box...') End_Dialog(@WINDOW,'') END MetRec = XLATE('RDS_TEST',MetNo,'','X') RDSNo = MetRec LSId = MetRec Zone = MetRec TestPointMap = MetRec IF Zone = '' THEN MetKeys = XLATE('REACT_RUN',RDSNo,'MET_KEYS','X') IF Zone = 1 THEN MetKeys = XLATE('REACT_RUN',RDSNo,'MET_KEYS_Z1','X') IF Zone = 2 THEN MetKeys = XLATE('REACT_RUN',RDSNo,'MET_KEYS_Z2','X') RdsLSKeys = XLATE('RDS',RDSNo,RDS_RDS_LAYER_KEYS$,'X') ReactorNo = XLATE('REACT_RUN',RDSNo,REACT_RUN_REACTOR$,'X') ReactType = XLATE('REACTOR',ReactorNo,REACTOR_REACT_TYPE$,'X') IF INDEX(RdsLSKeys,@VM,1) THEN * Multiple layers DepTimeTargets = '' LSCnt = COUNT(RdsLSKeys,@VM) + (RdsLSKeys NE '') DepTimeTargets = XLATE('RDS_LAYER',RdsLSKeys,RDS_LAYER_EPI_TIME$,'X') DepTimeTargets = OCONV(DepTimeTargets,'MD1') LS1DepTime = '' LS2DepTime = '' FOR I = 1 TO LSCnt RdsLSKey = RdsLSKeys<1,I> IF INDEX(RdsLSKey,'L1',1) THEN LS1DepTime = DepTimeTargets<1,I> IF INDEX(RdsLSKey,'L2',1) THEN LS2DepTime = DepTimeTargets<1,I> NEXT I ErrorMsg = '' IF LS1DepTime = '' THEN ErrorMsg = 'Deposit Time for LS1 has not been enterered yet.' IF LS2DepTime = '' THEN ErrorMsg = 'Deposit Time for LS2 has not been enterered yet.' IF ErrorMsg NE '' THEN ErrMsg(ErrorMsg) End_Dialog(@WINDOW,'') Set_Property('RDS_TEST.MET_NO','DEFPROP',MeTNo) Send_Event('RDS_TEST','READ') END ELSE TotDepTime = LS1DepTime + LS2DepTime LS1Ratio = LS1DepTime/TotDepTime END MetReadings = '' FOR I = 1 TO COUNT(MetKeys,@VM) + (MetKeys NE '') MetKey = MetKeys<1,I> LMetReadings = obj_RDS_Test('GetReadSet',MetKey) IF I = 1 THEN MetReadings<1> = LMetReadings<1> ;* Line Numbers MetReadings<3> = LMetReadings<3> ;* SheetRho MetReadings<4> = LMetReadings<4> ;* Hgcv END IF I = 2 THEN MetReadings<5> = LMetReadings<4> ;* Hgcv END IF I = 3 THEN MetReadings<2> = LMetReadings<2> ;* Thickness readings END NEXT I END ELSE LS1Ratio = 1 MetReadings = obj_RDS_Test('GetReadSet',MetNo) END Ctrls = @WINDOW:'.MET_NO':@RM ; Props = 'TEXT':@RM ; Vals = MetNo:@RM Ctrls := @WINDOW:'.RDS_NO':@RM ; Props := 'TEXT':@RM ; Vals := RDSNo:@RM Ctrls := @WINDOW:'.LS_ID':@RM ; Props := 'TEXT':@RM ; Vals := LSId:@RM Ctrls := @WINDOW:'.ZONE':@RM ; Props := 'TEXT':@RM ; Vals := Zone:@RM Ctrls := @WINDOW:'.TEST_POINT_MAP':@RM ; Props := 'TEXT':@RM ; Vals := TestPointMap:@RM Ctrls := @WINDOW:'.L1_RATIO' ; Props := 'TEXT' ; Vals := LS1Ratio IF MetReadings<1> NE '' THEN CONVERT @FM TO @RM IN MetReadings oTPM_Parms = TestPointMap:@RM:MetReadings Results = obj_Test_Point_Map('PointToResult',oTPM_Parms) ThicknessArray = FIELD(Results,@FM,2,4) Ctrls := @RM:@WINDOW:'.THICKNESS' ; Props := @RM:'DEFPROP' ; Vals := @RM:ThicknessArray<1> Ctrls := @RM:@WINDOW:'.SHEETRHO' ; Props := @RM:'DEFPROP' ; Vals := @RM:ThickNessArray<2> Ctrls := @RM:@WINDOW:'.HGCV1' ; Props := @RM:'DEFPROP' ; Vals := @RM:ThicknessArray<3> Ctrls := @RM:@WINDOW:'.HGCV2' ; Props := @RM:'DEFPROP' ; Vals := @RM:ThickNessArray<4> END Set_Property(Ctrls,Props,Vals) BEGIN CASE CASE LSId = 'L1' Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',RCV_BLUE$) CASE LSId = 'L2' Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',PRE_BLUE$) CASE LSId = '2' Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',INP_BLUE$) CASE 1 Set_Property(@WINDOW:'.LS_ID','BACKCOLOR',GREEN$) END CASE RETURN * * * * * * * Done: * * * * * * * Ctrls = @WINDOW:'.TEST_POINT_MAP':@RM ; Props = 'DEFPROP':@RM Ctrls := @WINDOW:'.MET_NO':@RM ; Props := 'DEFPROP':@RM Ctrls := @WINDOW:'.THICKNESS':@RM ; Props := 'ARRAY':@RM Ctrls := @WINDOW:'.SHEETRHO':@RM ; Props := 'ARRAY':@RM Ctrls := @WINDOW:'.HGCV1':@RM ; Props := 'ARRAY':@RM Ctrls := @WINDOW:'.HGCV2':@RM ; Props := 'ARRAY':@RM Ctrls := @WINDOW:'.L1_RATIO' ; Props := 'DEFPROP' Vals = Get_Property(Ctrls,Props) TestPointMap = Vals[1,@RM] MetNo = Vals[COL2()+1,@RM] ThickReads = Vals[COL2()+1,@RM] SheetRhoReads = Vals[COL2()+1,@RM] HgCV1ResReads = Vals[COL2()+1,@RM] HgCV2ResReads = Vals[COL2()+1,@RM] L1Ratio = Vals[COL2()+1,@RM] ReadingNos = '' FOR I = 1 TO 9 ReadingNos<1,I> = I NEXT I oTPM_Parms = TestPointMap:@RM:ReadingNos:@RM:ThickReads:@RM:SheetRhoReads:@RM:HgCV1ResReads:@RM:HgCV2ResReads EpiReads = obj_Test_Point_Map('ResultToPoint',oTPM_Parms) MetRec = XLATE('RDS_TEST',MetNo,'','X') Zone = MetRec RDSNo = MetRec BEGIN CASE CASE Zone = '1' ; MetKeys = XLATE('REACT_RUN',RDSNo,'MET_KEYS_Z1','X') CASE Zone = '2' ; MetKeys = XLATE('REACT_RUN',RDSNo,'MET_KEYS_Z2','X') CASE 1 ; MetKeys = XLATE('REACT_RUN',RDSNo,'MET_KEYS','X') END CASE UpdatesAllowed = True$ ; // Flag to determine if cassette has not been signed for FQA. Assumed not signed yet. Override = False$ ; // Assume no override for now. IF INDEX(MetKeys,@VM,1) THEN LOCATE MetNo IN MetKeys USING @VM SETTING Pos THEN MetKeys = DELETE(MetKeys,1,Pos,0) END oRTParms_L1 = '' oRTParms_L2 = '' FOR J = 1 TO COUNT(EpiReads<1>,@VM) + (EpiReads<1> NE '') oRTParms_L1 = OCONV(ICONV(EpiReads * L1Ratio, 'MD2'),'MD2') oRTParms_L2 = EpiReads - oRTParms_L1 IF EpiReads NE '' THEN oRTParms_L1 = EpiReads oRTParms_L2 = '' EpiReads = '' END ELSE oRTParms_L1 = '' oRTParms_L2 = '' END IF EpiReads NE '' THEN oRTParms_L1 = EpiReads END IF EpiReads NE '' THEN oRTParms_L2 = EpiReads END NEXT J CONVERT @FM TO @RM IN oRTParms_L1 CONVERT @FM TO @RM IN oRTParms_L2 obj_RDS_Test('SetReadSet',MetKeys<1,1>:@RM:oRTParms_L1,Override) If Error_Services('HasError') then * IF Get_Status(errCode) THEN FileError = @File.Error ErrorNumber = FileError<1> ErrorMessage = FileError<2> * Message = Error_Services('GetMessage') * ErrorNumber = Message[1, ':'] * ErrorMessage = Message[Col2() + 1, ':'] If ErrorNumber EQ '104' then MsgStruct = '' MsgStruct = -1 MsgStruct = -1 // Users belonging to the SPEC_CHANGE security group will be allowed to override the block. However, these // users must confirm that this is what they want. If MemberOf(@User4, 'SPEC_CHANGE') then Override = Msg(@Window, MsgStruct, 'YESNO', '', 'RDS Test' : @FM : ErrorMessage : @TM : @TM : 'Please confirm that you want to override.') If Override EQ True$ then obj_RDS_Test('SetReadSet',MetKeys<1,1>:@RM:oRTParms_L1,Override) end else UpdatesAllowed = False$ end end else UpdatesAllowed = False$ Msg(@Window, MsgStruct, 'OK', '', 'RDS Test' : @FM : ErrorMessage) end end else ErrMsg(errCode) end end If UpdatesAllowed EQ True$ then obj_RDS_Test('SetReadSet',MetKeys<1,2>:@RM:oRTParms_L2,Override) IF Get_Status(errCode) THEN ErrMsg(errCode) END end END If UpdatesAllowed EQ True$ then oRTParms = '' oRTParms = EpiReads oRTParms = EpiReads oRTParms = EpiReads CONVERT @FM TO @RM IN oRTParms obj_RDS_Test('SetReadSet',MetNo:@RM:oRTParms,Override) IF Get_Status(errCode) THEN Message = Error_Services('GetMessage') ErrorNumber = Message[1, ':'] ErrorMessage = Message[Col2() + 1, ':'] If ErrorNumber EQ 'FS104' then MsgStruct = '' MsgStruct = -1 MsgStruct = -1 // Users belonging to the SPEC_CHANGE security group will be allowed to override the block. However, these // users must confirm that this is what they want. If MemberOf(@User4, 'SPEC_CHANGE') then Override = Msg(@Window, MsgStruct, 'YESNO', '', 'RDS Test' : @FM : ErrorMessage : @TM : @TM : 'Please confirm that you want to override.') If Override EQ True$ then obj_RDS_Test('SetReadSet',MetKeys<1,1>:@RM:oRTParms,Override) end else UpdatesAllowed = False$ end end else UpdatesAllowed = False$ Msg(@Window, MsgStruct, 'OK', '', 'RDS Test' : @FM : ErrorMessage) end end else ErrMsg(errCode) end end end End_Dialog(@WINDOW,'') Set_Property('RDS_TEST.MET_NO','DEFPROP',MetNo) Send_Event('RDS_TEST','READ') RETURN * * * * * * * Refresh: * * * * * * * RETURN * * * * * * * ReadingsDel: * * * * * * * DeletedRowIndex = Parm1 DeletedRowText = Parm2 CurrCtrl = Get_Property(@WINDOW,'FOCUS') Dummy = Send_Message(CurrCtrl, "INSERT",DeletedRowIndex, DeletedRowText) ErrMsg('Rows may not be inserted or deleted.') RETURN