COMPILE FUNCTION Comm_WO_Mat_Wfr(Instruction, Parm1,Parm2) #pragma precomp SRP_PreCompiler /* Commuter module for WO_MAT_WFR (Work Order Material Wafer) window 01/25/2008 - John C. Henry, J.C. Henry & Co., Inc. 11/12/2018 - djs - Updated VerifyFullBoxReject subroutine to set the SAP Batch No. as a rejected cassette. Previously this was being done prematurely in OBJ_WO_MAT('SignNCR'). 01/04/2019 - djs - Fixed an issue within the "Refresh" subroutine, which was preventing the "SLOT_NO" edit table from being colored correctly. The coloring code was moved to be executed after the section of code responsible for coloring edit tables with symbolic fields. 02/27/2025 - DJM - Added prompt to remove hold when creating NCR in 'RejMat' */ DECLARE SUBROUTINE Set_Property, Set_Status, ErrMsg, Set_Property, obj_AppWindow, Send_Message, Logging_Services DECLARE SUBROUTINE Btree.Extract, Send_Event, Security_Err_Msg, Forward_Event, End_Window, Start_Window DECLARE SUBROUTINE EditCell, obj_NCR, obj_Notes, Post_Event, obj_WO_Mat, obj_WO_Mat_Log, obj_WO_Wfr, obj_Tables DECLARE SUBROUTINE SRP_Stopwatch, Update_Index, Database_Services, obj_RDS, Create_Dialog, Dialog_Box DECLARE SUBROUTINE Sleepery DECLARE FUNCTION Get_Property, Get_Status, Popup, Send_Message, Msg, Security_Check, Dialog_Box, RowExists DECLARE FUNCTION Dialog_Box, obj_WO_Log, obj_NCR, Check_Notes, obj_MUWafers, obj_WO_Mat, Signature_Services DECLARE FUNCTION MemberOf, obj_Tables, obj_RDS, Environment_Services, Logging_Services, Material_Services DECLARE FUNCTION Database_Services, RetStack, Datetime, Error_Services $INSERT POPUP_EQUATES $INSERT LOGICAL $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT WM_IN_EQUATES $INSERT WO_LOG_EQU $INSERT WO_STEP_EQU $INSERT WO_MAT_EQUATES $INSERT ORDER_EQU $INSERT RDS_EQUATES $INSERT PROD_SPEC_EQU $INSERT NOTIFICATION_EQU $INSERT LSL_USERS_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT WM_OUT_EQUATES EQU CRLF$ TO \0D0A\ EQU COL$SLOT TO 1 EQU COL$WAFER_ID TO 2 EQU COL$SLOT_NCR TO 3 EQU COL$MET_NO$ TO 4 EQU COL$MOVED_TO_SLOT TO 5 EQU COL$MU_WAFER_ID TO 6 EQU COL$MOVED_FROM_SLOT TO 7 EQU COL$REPLACED_BY TO 8 EQU COL$MU_ADD_DATE TO 9 EQU COL$MU_REM_DATE TO 10 EQU COL$NCR_NO TO 1 EQU COL$NCR_STATUS TO 2 EQU COL$NCR_REJ_QTY TO 3 EQU COL$NCR_RESP TO 4 EQU COL$NCR_STAGE TO 5 EQU COL$NCR_LOSS_DESC TO 6 EQU COL$NCR_LOSS_COMM TO 7 EQU COL$NCR_FIN_SIG TO 8 EQU COL$NCR_FIN_SIG_DTM TO 9 EQU COL$LOG_FILE TO 1 EQU COL$LOG_DTM TO 2 EQU COL$ACTION TO 3 EQU COL$WH_CD TO 4 EQU COL$LOC_CD TO 5 EQU COL$WO_NOS TO 6 EQU COL$CASS_NOS TO 7 EQU COL$USER_ID TO 8 EQU COL$TAGS TO 9 EQU COL$TOOL_ID TO 10 LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\WO_Mat' LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' RDS Erase Attempt.csv' Headers = 'Logging DTM' : @FM : 'User' : @FM : 'WOMatKeyID' : @FM : 'Record' : @FM : 'Stack' objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$) LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM ErrTitle = 'Error in Comm_WO_MAT_WFR' ErrorMsg = '' ErrCode = '' Result = '' BEGIN CASE CASE Instruction = 'Create' ; GOSUB Create CASE Instruction = 'Refresh' ; GOSUB Refresh CASE Instruction = 'Read' ; GOSUB Read CASE Instruction = 'Write' ; GOSUB Write CASE Instruction = 'Clear' ; GOSUB Clear CASE Instruction = 'Delete' ; GOSUB Delete CASE Instruction = 'Close' ; GOSUB Close CASE Instruction = 'RejMat' ; GOSUB RejMat CASE Instruction = 'RecallMat' ; GOSUB RecallMat CASE Instruction = 'NCRKeysDC' ; GOSUB NCRKeysDC CASE Instruction = 'AddMakeup' ; GOSUB AddMakeup CASE Instruction = 'RemMakeup' ; GOSUB RemMakeup CASE Instruction = 'MakeUpLot' ; GOSUB MakeUpLot CASE Instruction = 'WOStepRdsDC' ; GOSUB WOStepRdsDC CASE 1 ErrorMsg = 'Unknown Instruction passed to routine' END CASE RETURN Result * * * * * * * Create: * * * * * * * Start_Window('WO_MAT_WFR', '') IOOptions = Get_Property(@WINDOW, "IOOPTIONS") IOOptions<2> = 2 ; // Do not lock IOOptions<6> = 1 ; // Do not clear on write Set_Property(@WINDOW, "IOOPTIONS", IOOptions) * Provides compatibility with the existing messaging attachment system IF Parm1 NE '' THEN PassedKeys = FIELD(Parm1,'*',1) obj_Appwindow('ViewRelated','WO_MAT_WFR':@RM:PassedKeys) END IF (MemberOf(@USER4,'OI_ADMIN')) THEN Set_Property(@WINDOW:'.WO_STEP_RDS_NO','VISIBLE',1) END GOSUB Refresh RETURN * * * * * * * Read: * * * * * * * WONo = Get_Property(@WINDOW:'.WO_NO','DEFPROP') CassNo = Get_Property(@WINDOW:'.CASS_NO','DEFPROP') IF RowExists('WO_MAT',WONo:'*':CassNo) THEN IF NOT(Security_Check('RDS',READ$)) THEN Send_Event(@WINDOW,'CLEAR') Security_Err_Msg('Work Order Mat',READ$) RETURN END IF NOT(Security_Check('RDS',EDIT$)) THEN obj_Appwindow('ReadOnly',@WINDOW) ;*Set to Read Only END END ELSE ErrMsg('Work Order Mat entries are only created by the program.') Send_Event(@WINDOW,'CLEAR') RETURN END IF Get_Property(@WINDOW,'PARENT') = 'RDS_UNLOAD' THEN Set_Property(@WINDOW:'.RDS_NO','DEFPROP',Get_Property(@WINDOW,'@RDS_NO')) Set_Property(@WINDOW:'.REACTOR','DEFPROP',Get_Property(@WINDOW,'@REACTOR')) Set_Property(@WINDOW:'.WO_STEP_NO','DEFPROP',Get_Property(@WINDOW,'@WO_STEP_NO')) END GOSUB Refresh RETURN * * * * * * * Write: * * * * * * * RETURN * * * * * * * Clear: * * * * * * * IF Get_Property(@WINDOW,'PARENT') = 'RDS_UNLOAD' THEN Set_Property(@WINDOW:'.RDS_NO','DEFPROP','') Set_Property(@WINDOW:'.REACTOR','DEFPROP','') Set_Property(@WINDOW:'.WO_STEP_NO','DEFPROP','') END GOTO Refresh RETURN * * * * * * * Delete: * * * * * * * ErrMsg('Records may not be modified or deleted.') Result = 0 ;* No Deletes RETURN * * * * * * * Close: * * * * * * * obj_Appwindow('DetailReturn') RETURN * * * * * * * Refresh: * * * * * * * Ctrls = @WINDOW:@RM ; Props = '@RDS_NO':@RM Ctrls := @WINDOW:@RM ; Props := '@REACTOR':@RM Ctrls := @WINDOW ; Props := '@WO_STEP_NO' Vals = Get_Property(Ctrls,Props) Ctrls = @WINDOW:'.RDS_NO':@RM ; Props = 'DEFPROP':@RM Ctrls := @WINDOW:'.REACTOR':@RM ; Props := 'DEFPROP':@RM Ctrls := @WINDOW:'.WO_STEP_NO' ; Props := 'DEFPROP' Set_Property(Ctrls,Props,Vals) Ctrls = @WINDOW:'.MAKEUP_BOX':@RM:@WINDOW:'.HOLD':@RM:@WINDOW:'.HOTLOT':@RM:@WINDOW:'.MU_WAFER_FLAG' Props = 'CHECK':@RM:'CHECK':@RM:'CHECK':@RM:'CHECK' Vals = Get_Property(Ctrls,Props) MakeupBox = Vals[1,@RM] Hold = Vals[COL2()+1,@RM] HotLot = Vals[COL2()+1,@RM] UseMUWafers = Vals[COL2()+1,@RM] IF NOT(MakeupBox) AND UseMUWafers THEN Set_Property(@WINDOW:'.MU_BOX_LABEL','VISIBLE',0) END ELSE IF MakeupBox = 1 THEN Set_Property(@WINDOW:'.MU_BOX_LABEL','VISIBLE',1) END ELSE Set_Property(@WINDOW:'.MU_BOX_LABEL','VISIBLE',0) END END IF HotLot THEN Set_Property(@WINDOW:'.HOT_LOT_LABEL','VISIBLE',1) END ELSE Set_Property(@WINDOW:'.HOT_LOT_LABEL','VISIBLE',0) END Ctrls = 'WO_MAT_WFR.QBF_FIRST_FIX':@RM ; Props = 'ENABLED':@RM Ctrls := 'WO_MAT_WFR.QBF_PREV_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := 'WO_MAT_WFR.QBF_ABS_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := 'WO_MAT_WFR.QBF_NEXT_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := 'WO_MAT_WFR.QBF_LAST_FIX':@RM ; Props := 'ENABLED':@RM Ctrls := 'WO_MAT_WFR.QBF_STOP_FIX' ; Props := 'ENABLED' IF Get_Property('WO_MAT_WFR','QBFLIST') = '' THEN Vals = 0:@RM:0:@RM:0:@RM:0:@RM:0:@RM:0 END ELSE Vals = 1:@RM:1:@RM:1:@RM:1:@RM:1:@RM:1 END Set_Property(Ctrls,Props,Vals) * Turn edit table symbolic column backgrounds to green ETSymbolics = Get_Property('WO_MAT_WFR','@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow ETCtrls = ETSymbolics<1> ETCols = ETSymbolics<2> FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '') ETCtrl = ETCtrls<1,I> IF ETCtrl NE 'WO_MAT_WFR.SLOT_NO' THEN ETList = Get_Property(ETCtrl,'LIST') FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '') IF ETList NE '' THEN FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '') stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$) NEXT N END NEXT Line END NEXT I CtrlName = 'WO_MAT_WFR.NCR_KEYS' NCRList = Get_Property(CtrlName,'LIST') ColCount = COUNT(NCRList<1>,@VM) + (NCRList<1> NE '') FOR Line = 1 TO COUNT(NCRList,@FM) + (NCRList NE '') Status = NCRList BEGIN CASE CASE Status = '' ; Color = WHITE$ CASE Status = 'Closed' ; Color = GREEN$ CASE Status = 'Open' ; Color = RED$ CASE Status = 'Verified' ; Color = YELLOW$ CASE 1 ; Color = WHITE$ END CASE FOR Col = 1 TO ColCount stat = Send_Message(CtrlName,'COLOR_BY_POS',Col,Line,Color) NEXT Col NEXT Line // Fill MU Rem Date and MU Add Date columns of the SLOT_NO edit table WONo = Get_Property(@Window : '.WO_NO', 'TEXT') CassNo = Get_Property(@Window : '.CASS_NO', 'TEXT') WOMatKey = WONo : '*' : CassNo WOMatRec = Database_Services('ReadDataRow', 'WO_MAT', WOMatKey) MUAddDTMS = WOMatRec MURemDTMS = WOMatRec List = Get_Property(@Window : '.SLOT_NO', 'LIST') NumRows = DCount(List, @FM) For fPos = 1 to NumRows Row = List Row<1, COL$MU_REM_DATE> = OConv(MURemDTMS<1, fPos, 1>, 'DT2/^H') ; // Grab only the most recent datetime to display Row<1, COL$MU_ADD_DATE> = OConv(MUAddDTMS<1, fPos, 1>, 'DT2/^H') List = Row Next fPos Set_Property(@Window : '.SLOT_NO', 'LIST', List) CtrlEntID = @WINDOW:'.SLOT_NO' SlotList = Get_Property(CtrlEntID,'LIST') SlotListCnt = COUNT(SlotList,@FM) + (SlotList NE '') FailedWfrs = WOMatRec FOR Line = 1 TO SlotListCnt WaferID = SlotList * RepBy = SlotList NCRNo = SlotList WfrFailed = FailedWfrs<0, Line> BEGIN CASE CASE SlotList = '' LineColor = GREY$ CASE WaferID EQ '' AND (NOT(UseMUWafers) OR (MakeupBox)) LineColor = LTGREY$ CASE WaferID EQ '' AND NOT(MakeupBox) AND UseMUWafers LineColor = YELLOW$ Case WaferID NE '' AND WfrFailed AND NCRNo EQ '' LineColor = RED$ CASE WaferID NE '' AND NCRNo NE '' LineColor = GREEN$ CASE WaferID NE '' AND NCRNo EQ '' LineColor = WHITE$ CASE Otherwise$ LineColor = WHITE$ END CASE FOR Col = 1 TO 10 stat = Send_Message(CtrlEntID,'COLOR_BY_POS',Col,Line,LineColor) NEXT COL NEXT Line RETURN * * * * * * * RejMat: * * * * * * * // Ensure cassette is not on hold WONo = Get_Property(@Window:'.WO_NO', 'TEXT') CassNo = Get_Property(@Window:'.CASS_NO', 'TEXT') WOMatKey = WONo:'*':CassNo OnHold = Xlate('WO_MAT', WOMatKey, 'HOLD', 'X') Result = '' SlotList = Get_Property('WO_MAT_WFR.SLOT_NO','LIST') SlotSelection = Get_Property('WO_MAT_WFR.SLOT_NO','SELPOS') SelectedRows = SlotSelection<2> CONVERT @VM TO @FM in SelectedRows SelCnt = DCount(SelectedRows, @FM) IF SelCnt = 0 THEN ErrMsg('You must select at least one row in order to create an NCR.') RETURN END GoSub FQAVerify If Not(Authorized) then Return 0 If OnHold EQ True$ then Result = Dialog_Box('NDW_HOLD_REMOVAL_PROMPT',@WINDOW,'WO_MAT':@VM:WOMatKey:@VM:WOMatKey) If Result NE True$ then Return 0 end else Send_Event(@Window, 'READ') end end If (OnHold NE True$) OR (Result = True$) then OffHoldDTMs = Xlate('WO_MAT', WOMatKey, 'HOLD_STOP_DTM', 'X') SAPBatchNo = Xlate('WO_MAT', WOMatKey, WO_MAT_SAP_BATCH_NO$, 'X') If OffHoldDTMs NE '' then // Ensure at least a minute has elapsed since the cassette was last taken off hold. LastDTM = OffHoldDTMs[-1, 'B':@VM] TimeElapsed = Datetime() - LastDTM // .000694 is the equivalent to 60 seconds in datetime format If (TimeElapsed LT '.000694') AND (SAPBatchNo NE '') then Def = "" Def = "Please wait for SAP to process off hold transaction..." Def = "U" MsgUp = Msg(@window, Def) ;* display the processing message WaitTime = '.000694' - TimeElapsed WaitSeconds = WaitTime * 86400 ;* 86400 = 60 seconds * 60 minutes * 24 hours WaitMilliSec = WaitSeconds * 1000 Sleepery(WaitMilliSec) Msg(@window, MsgUp) ;* take down the processing message end end IneligibleSlots = '' AllSlotsPermitted = True$ ; // Assume that all slots are permitted to be NCR'd for now. For I = 1 TO SelCnt SlotNo = SlotList, COL$SLOT> MetNo = SlotList, COL$MET_NO$> WfrID = SlotList, COL$WAFER_ID> PrevNCR = SlotList, COL$SLOT_NCR> MUWfrID = SlotList, COL$MU_WAFER_ID> If ( (MetNo NE '') or (WfrID EQ '') or (PrevNCR NE '' and MUWfrID EQ '') ) then AllSlotsPermitted = False$ IneligibleSlots<0, -1> = SlotNo end Next I If AllSlotsPermitted EQ False$ then Swap @VM with ',' in IneligibleSlots ErrMsg('Selected slot(s) ' : IneligibleSlots : ' are not eligible for NCR.') return end Ctrls = 'WO_MAT_WFR.WO_NO':@RM ; Props = 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.CASS_NO':@RM ; Props := 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.RDS_NO':@RM ; Props := 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.WO_STEP_NO':@RM ; Props := 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.REACTOR':@RM ; Props := 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.NCR_KEYS':@RM ; Props := 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.SAP_BATCH_NO' ; Props := 'DEFPROP' Vals = Get_Property(Ctrls,Props) WONo = Vals[1,@RM] CassNo = Vals[COL2()+1,@RM] RDSNo = Vals[COL2()+1,@RM] WOStepNo = Vals[COL2()+1,@RM] Reactor = Vals[COL2()+1,@RM] NCRArray = Vals[COL2()+1,@RM] WOMatKey = WONo:'*':CassNo RejWaferIDs = '' PrevNCRNos = '' SlotNos = '' GoodLines = 0 FOR I = 1 TO SelCnt IF SlotList,COL$WAFER_ID> NE '' Then GoodLines += 1 RejWaferIDs<1,GoodLines> = SlotList,COL$WAFER_ID> PrevNCRNos<1,GoodLines> = SlotList,COL$SLOT_NCR> SlotNos<1,GoodLines> = SlotList,COL$SLOT> END NEXT I ncrParms = WONo:@RM ncrParms := WOStepNo:@RM ncrParms := CassNo:@RM ;* Place holder for WO_MAT_CASS_NO ncrParms := RDSNo:@RM ;* Single RDS field ncrParms := Reactor:@RM ;* Reactor No ncrParms := '':@RM ;* Stage ncrParms := '':@RM ;* InCassNos ncrParms := SlotNos:@RM ;* InSlotNos ncrParms := '':@RM ;* PockeNots ncrParms := '':@RM ;* Zones ncrParms := '':@RM ;* OutCassNos ncrParms := '':@RM ;* OutSlotNos ncrParms := '':@RM ;* Multiple RDSNos (EpiPro) ncrParms := RejWaferIDs:@RM ;* Rejected Wafer ID's ncrParms := PrevNCRNos ;* Previous NCR No's BarcodeVerified = Dialog_Box('NDW_VERIFY_BARCODE', @Window, RDSNo, @User4) If BarcodeVerified EQ TRUE$ then Set_Status(0) NCRNo = obj_NCR('Create',ncrParms) ;* Create new NCR for this wafer/group of wafers SAPBatchNo = Get_Property(@WINDOW:'.SAP_BATCH_NO','DEFPROP') MUFlag = XLATE('WO_MAT', WOMatKey, 'MakeupBox', 'X') IF Get_Status(errCode) THEN ErrMsg(errCode) END ELSE IF SAPBatchNo NE '' THEN IF SAPBatchNo[-1,1] NE 'R' THEN MUFlag = Xlate('NCR', NCRNo, 'MAKEUP_BOX', 'X') MUFlag = OCONV(MUFlag ,'BYes,') PartNoID = Xlate('NCR', NCRNo, 'WO_MAT_PART_NO', 'X') RejCnt = Xlate('NCR', NCRNo, 'REJ_CNT', 'X') Recipients = XLATE('NOTIFICATION', 'NCR_AFTER_GR', NOTIFICATION_USER_ID$, 'X') SentFrom = @USER4 Subject = 'SAP Post - GR Scrap Qty - NCR Reported' ;* Modified subject line - dkk 7/17/14 Message = "NCR: ":NCRNo:CRLF$:"Batch_No: ":SAPBatchNo:CRLF$:"MU Box: ":MUFlag:CRLF$:"Epi PN: ":PartNoID:CRLF$:"Qty: ":RejCnt ;* Added Epi PN on the end - dkk 7/17/14 AttachWindow = 'NCR' AttachKey = NCRNo SendToGroup = '' Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup obj_Notes('Create',Parms) END END RejDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS') RejWfrIDs = '' CurrSlotIDs = '' sCnt = COUNT(SlotNos,@VM) + (SlotNos NE '') FOR N = 1 TO sCnt * * * * Added 3/23/2016 JCH - wafer history * * * * RejWfrID = RejWaferIDs<1,N> CurrSlotID = WONo:'*':CassNo:'*':SlotNos<1,N> Convert '.' To '*' In RejWfrID RejWfrIDs<1,-1> = RejWfrID CurrSlotIDs<1,-1> = CurrSlotID Parms = RejWfrID:@RM ;* WfrID Parms := RejDTM:@RM ;* EventDtm Parms := @USER4:@RM ;* EventBy Parms := 'NCR':@RM ;* Event Parms := '':@RM ;* NewSlotID Parms := '':@RM ;* RunLoc Parms := NCRNo:@RM ;* NCRNo Parms := '':@RM ;* TWUse Parms := CurrSlotID:@RM ;* CurrSlotID Parms := '':@RM ;* NewToolID Parms := '':@RM ;* CurrToolID Parms := '':@RM ;* NewInvLoc Parms := '':@RM ;* CurrInvLoc Parms := 'O' ;* Wfr Side obj_WO_Wfr('AddEvent',Parms) * * * * * * * * * LineNo = SlotNos<1,N> NEXT N END Set_Property(@WINDOW:'.SLOT','SELPOS',SlotSelection) ;* Toggle WM_IN select off Set_Property(@WINDOW, 'SAVEWARN', False$) rv = Dialog_Box('NCR', @WINDOW, NCRNo) Send_Event(@WINDOW, 'READ') end end RETURN * * * * * * RecallMat: * * * * * * Ctrls = 'WO_MAT_WFR.SLOT_NO':@RM:'WO_MAT_WFR.NCR_KEYS':@RM:'WO_MAT_WFR.WO_NO':@RM:'WO_MAT.CASS_NO' Props = 'LIST':@RM:'ARRAY':@RM:'DEFPROP':@RM:'DEFPROP' Vals = Get_Property(Ctrls,Props) SlotList = Vals[1,@RM] NCRArray = Vals[COL2()+1,@RM] WONo = Vals[COL2()+1,@RM] CassNo = Vals[COL2()+1,@RM] NCRKeys = NCRArray<1> NCRStatuses = NCRArray<2> SlotSelection = Get_Property('WO_MAT_WFR.SLOT_NO','SELPOS') SelectedRows = SlotSelection<2> CONVERT @VM TO @FM in SelectedRows SelCnt = COUNT(SelectedRows,@FM) + (SelectedRows NE '') IF SelCnt = 0 THEN RETURN Ctrls = 'WO_MAT_WFR.WO_NO':@RM ; Props = 'DEFPROP':@RM Ctrls := 'WO_MAT_WFR.CASS_NO' ; Props := 'DEFPROP' Vals = Get_Property(Ctrls,Props) WONo = Vals[1,@RM] CassNo = Vals[COL2()+1,@RM] WOMatKey = WONo:'*':CassNo RecallNCRNos = '' RecallSlotNos = '' ;******************************************************************************* RecallNCRCnt = 0 FOR I = 1 TO SelCnt IF SlotList,COL$WAFER_ID> = '' AND SlotList,COL$SLOT_NCR> NE '' THEN SlotNCRNo = SlotList,COL$SLOT_NCR> LOCATE SlotNCRNo IN NCRKeys USING @VM SETTING Pos THEN NCRStatus = NCRStatuses<1,Pos> * Rem'd for testing P U T T H I S B A C K ! ! ! ! ! ! LOCATE SLotNCRNo IN RecallNCRNos USING @FM SETTING RPos THEN RecallSlotNos = SlotList,COL$SLOT> END ELSE RecallNCRCnt += 1 RecallNCRNos = INSERT(RecallNCRNos,RPos,0,0,SlotList,COL$SLOT_NCR>) RecallSlotNos = INSERT(RecallSlotNos,RPos,1,0,SlotList,COL$SLOT>) END END END NEXT I FOR I = 1 TO RecallNCRCnt RecallNCRNo = RecallNCRNos RecallSlot = RecallSlotNos SlotInfo = '' ; // Initializing variable here to prevent compilation warning. This code looks unfinished... SlotCnt = COUNT(SlotInfo<1>, @VM) + (SlotInfo<1> NE '') FOR N = 1 TO SlotCnt SlotNo = SlotInfo<1,N> PrevWaferID = SlotInfo<2,N> PrevNCR = SlotInfo<3,N> IF FIELD(PrevWaferID,'*',1,2) = WONo:'.':CassNo THEN * MakeupWafer END ELSE * Original Wafer END NEXT N NEXT I RETURN * * * * * * * NCRKeysDC: * * * * * * * WMId = Get_Property('WO_MAT_WFR','ID') CtrlEntID = 'WO_MAT_WFR.NCR_KEYS' CurrPos = Get_Property(CtrlEntID,'SELPOS') CurrCol = CurrPos<1> CurrRow = CurrPos<2> NCRKey = Get_Property(CtrlEntID,'CELLPOS',1:@FM:CurrRow) Send_Event('WO_MAT_WFR','WRITE') Dialog_Box('NCR', @WINDOW, NCRKey) Send_Event(@WINDOW, 'READ') RETURN * * * * * * * AddMakeup: * * * * * * * // Ensure cassette is not on hold WONo = Get_Property(@Window:'.WO_NO', 'TEXT') CassNo = Get_Property(@Window:'.CASS_NO', 'TEXT') WOMatKey = WONo:'*':CassNo OnHold = Xlate('WO_MAT', WOMatKey, 'HOLD', 'X') If OnHold NE True$ then GoSub FQAVerify If Not(Authorized) then Return 0 * Build popup of available makeup wafers based on following priority: Ctrls = @WINDOW:'.WO_NO':@RM:@WINDOW:'.CASS_NO':@RM:@WINDOW:'.SLOT_NO' Props = 'DEFPROP':@RM:'DEFPROP':@RM:'LIST' Vals = Get_Property(Ctrls,Props) WONo = Vals[1,@RM] CassNo = Vals[COL2()+1,@RM] SlotList = Vals[COL2()+1,@RM] WOMatKey = WONo:'*':CassNo SlotSelection = Get_Property(@WINDOW:'.SLOT_NO','SELPOS') SelectedRows = SlotSelection<2> * This section added 11/5/2009 JCH CassShipQty = Get_Property(@WINDOW:'.CASS_SHIP_QTY','DEFPROP') IF CassShipQty NE '' AND CassShipQty > 0 THEN SlotSelection = Get_Property(@WINDOW:'.SLOT_NO','SELPOS') SelectedRows = SlotSelection<2> BadRows = '' SelCnt = COUNT(SelectedRows,@VM) + (SelectedRows NE '') FOR I = 1 TO SelCnt IF SelectedRows<1,I> > CassShipQty THEN BadRows<1,-1> = SelectedRows<1,I> END NEXT I IF BadRows NE '' THEN ClearSelection = '' ClearSelection<1> = SlotSelection<1> ClearSelection<2> = BadRows Set_Property(@WINDOW:'.SLOT_NO','SELPOS',ClearSelection) ErrMsg('Only slots included in the shipping cassette may be selected for Makeup Wafers.') RETURN END END CONVERT @VM TO @FM in SelectedRows SelCnt = COUNT(SelectedRows,@FM) + (SelectedRows NE '') IF SelCnt = 0 THEN RETURN EmptySlots = SelectedRows CONVERT @FM TO @VM IN EmptySlots IF EmptySlots = '' THEN ErrMsg('No slots selected for makeup!') RETURN END FOR I = 1 TO COUNT(EmptySlots,@VM) + (EmptySlots NE '') EmptySlot = EmptySlots<1,I> IF SlotList NE '' THEN ErrMsg('Slot ':EmptySlot:" isn't empty.") RETURN END NEXT I Parms = WONo:@RM ;* Parms := @RM ;* WOLogRec Parms := 1:@RM ;* ReturnKeys Flag Parms := 1 ;* Use Reactor Run Table Flag Response = Dialog_Box('NDW_MAKEUP_WAFERS', @Window, WOMatKey) Begin Case Case Response EQ True$ // User requested to convert the current cassette into a makeup box. WOMatRec = Database_Services("ReadDataRow", 'WO_MAT', WOMatKey) If Error_Services('NoError') then SAPBatchNo = WOMatRec SAPTXDtm = WOMatRec AwaitingBatchNo = ( (SAPTXDtm NE '') and (SAPBatchNo EQ '') ) HasBatchNo = (SAPBatchNo NE '') FullBoxReject = (SAPBatchNo[-1, 1] = 'R') Begin Case Case AwaitingBatchNo InvalidRequest = True$ ErrMsg('WARNING: Cassette ineligible to be converted as it is awaiting a batch number from SAP.') Return Case FullBoxReject InvalidRequest = True$ ErrMsg('WARNING: Cassette ineligible to be converted as it is a full box reject.') Return Case HasBatchNo // Operation limited to LEAD and SUPERVISOR groups OverrideMsg = "Cassette has a batch number. SUPERVISOR or LEAD must override." Response = Msg(@Window, '', 'OVERRIDE', '', OverrideMsg) Begin Case Case Response EQ 1 Response = True$ ; // User Clicked Override Case Response EQ 2 Response = False$ ; // User Clicked Cancel Case Response EQ char(27) Response = False$ ; // User Pressed Escape Key End Case If Response EQ True$ then Response = Dialog_Box('NDW_VERIFY_USER', @WINDOW, @USER4:@FM:'LEAD':@VM:'SUPERVISOR') Authorized = Response<1> end else Authorized = False$ end If Not(Authorized) then Return Case Otherwise$ Null End Case AvailMU_WOMatKeys = '' UserResp = Response MakeupBox = '' // User requested to convert the current cassette into a makeup box. // Verify the quantity before proceeding. RDSNo = Get_Property(@Window:'.RDS_NO', 'TEXT') If RDSNo NE '' then Parms = '' Parms<1> = RDSNo ; // Cassette to verify wafer count of. Parms<2> = 0 ; // Wafer count adjustment - 0 because converting box. Parms<3> = 'MU' ; // Wafer counter tool location Proceed = Dialog_Box('NDW_WAFER_COUNTER', @Window, Parms) If Proceed NE True$ then return end else ErrMsg('Error starting wafer counter check. RDS No is missing.') end RDSNo = Get_Property(@Window : '.RDS_NO', 'TEXT') ; // Get the RDS No now before the WRITE in case it is needed to toggle the index. Send_Event(@WINDOW,'WRITE') FieldNo = WO_MAT_MAKEUP_BOX$ CheckValue = 1 obj_WO_Mat('ChangeFlag',WOMatKey:@RM:FieldNo:@RM:CheckValue) SlotWaferIDs = Xlate('WO_MAT', WOMatKey, 'SLOT_WAFER_ID', 'X') Convert @VM to '' in SlotWaferIDs // Flush/update pending index transactions. Update_Index('WO_MAT', 'MU_PART_NO', False$, True$) Update_Index('WO_MAT', 'CURR_STATUS', False$, True$) IF Get_Status(errCode) THEN ErrMsg(errCode) end CurrStatus = obj_WO_Mat('CurrStatus',WOMatKey) CurrDTM = OCONV(Date(),'D2/'):' ':OCONV(Time(),'MTS') IF CurrStatus = 'RTU' THEN EventParms = '' EventParms = 'WO_MAT' EventParms = CurrDTM EventParms = 'RTU' EventParms = 'CR' EventParms = 'MU' EventParms = WONo EventParms = CassNo EventParms = @USER4 EventParms = '' EventParms = '' CONVERT @FM TO @RM IN EventParms obj_WO_Mat_Log('Create',EventParms) ;* * * * * INV EVENT LOG * * * * * IF Get_Status(errCode) THEN CALL ErrMsg(ErrCode) END END obj_AppWindow('LoadFormKeys',@WINDOW:@RM:WOMatKey) Post_Event(@Window, 'READ') RETURN end else ErrMsg('WARNING: Error reading WO_MAT record.') Return end Case Response EQ '' // User has cancelled this process. Return Case Otherwise$ // User has selected a makeup box to use and backfill. AvailMU_WOMatKeys = Response MakeupBox = Response MuWfrsNeeded = SelCnt If AvailMU_WOMatKeys NE '' then // Wafer counter check - Account for the possibility of selecting more than one makeup box. For each MuWoMatKey in AvailMU_WOMatKeys using @FM MuRdsNo = Xlate('WO_MAT', MuWoMatKey, 'RDS_NO', 'X') QtyAdj = MuWfrsNeeded CurrMuWfrCnt = obj_WO_Mat('CurrWaferCnt', MuWoMatKey) If MuWfrsNeeded GT CurrMuWfrCnt then QtyAdj = CurrMuWfrCnt MuWfrsNeeded -= CurrMuWfrCnt end Parms = '' Parms<1> = MuRdsNo ; // Cassette to verify wafer count of. Parms<2> = QtyAdj ; // Wafer count adjustment - Number of makeup wafers being used. Parms<3> = 'MU' ; // Wafer counter tool location Proceed = Dialog_Box('NDW_WAFER_COUNTER', @Window, Parms) If Proceed NE True$ then return Next MuWoMatKey end IF NOT(MemberOf(@USER4,'OI_ADMIN')) THEN IF MakeupBox NE AvailMU_WOMatKeys<1,1> THEN ErrMsg('Only the first available cassette can be used for makeup.') MakeupBox = '' return END END Valid = Dialog_Box('NDW_VERIFY_USER', @Window, @User4) IF NOT(Valid) THEN RETURN ;* User is not worthy or can't type Send_Event(@WINDOW,'WRITE') obj_WO_Mat('AddMakeupWafers',WOMatKey:@RM:EmptySlots:@RM:MakeupBox) Send_Event(@WINDOW,'READ') End Case end else // Cassette is on hold so makeup wafers cannot be added. ErrorMessage = 'Add makeup wafer(s) denied!. The cassette must be taken off hold before adding makeup wafer(s).' Msg(@Window, '', 'OK', '', 'Error':@FM:ErrorMessage) end RETURN * * * * * * * RemMakeup: * * * * * * * // Ensure cassette is not on hold WONo = Get_Property(@Window:'.WO_NO', 'TEXT') CassNo = Get_Property(@Window:'.CASS_NO', 'TEXT') WOMatKey = WONo:'*':CassNo OnHold = Xlate('WO_MAT', WOMatKey, 'HOLD', 'X') If OnHold NE True$ then GoSub FQAVerify If Not(Authorized) then Return 0 Ctrls = @WINDOW:'.WO_NO':@RM:@WINDOW:'.CASS_NO':@RM:@WINDOW:'.SLOT_NO' Props = 'DEFPROP':@RM:'DEFPROP':@RM:'LIST' Vals = Get_Property(Ctrls,Props) WONo = Vals[1,@RM] CassNo = Vals[COL2()+1,@RM] SlotList = Vals[COL2()+1,@RM] WOMatKey = WONo:'*':CassNo SlotSelection = Get_Property(@WINDOW:'.SLOT_NO','SELPOS') SelectedRows = SlotSelection<2> CONVERT @VM TO @FM in SelectedRows SelCnt = COUNT(SelectedRows,@FM) + (SelectedRows NE '') IF SelCnt = 0 THEN RETURN MadeupSlots = SelectedRows CONVERT @FM TO @VM IN MadeupSlots IF MadeupSlots = '' THEN ErrMsg('No madeup slots selected for removing makeup wafers!') RETURN END FOR I = 1 TO COUNT(MadeupSlots,@VM) + (MadeupSlots NE '') MadeupSlot = MadeupSlots<1,I> IF SlotList = '' THEN ErrMsg('Slot ':MadeupSlot:" does not contain a makeup wafer.") RETURN END NEXT I Send_Event(@WINDOW,'WRITE') MUWaferData = obj_WO_Mat('SubMakeupWafers',WOMatKey:@RM:MadeupSlots) ;* This needs to return the waferIDs (4/7/2008 JCH) IF Get_Status(errCode) THEN ErrMsg(errCode) END IF MUWaferData NE '' THEN obj_WO_Mat('RepMakeupWafers',WOMatKey:@RM:MUWaferData) IF Get_Status(errCode) THEN ErrMsg(errCode) END END obj_Appwindow('LoadFormKeys',@WINDOW:@RM:WOMatKey) end else // Cassette is on hold so makeup wafer(s) cannot be removed. ErrorMessage = 'Remove makeup wafer(s) denied!. The cassette must be taken off hold removing makeup wafer(s).' Msg(@Window, '', 'OK', '', 'Error':@FM:ErrorMessage) end RETURN ********** MakeUpLot: ********** Ctrls = @WINDOW:'.WO_NO':@RM:@WINDOW:'.CASS_NO':@RM:@WINDOW:'.SLOT_NO' Props = 'DEFPROP':@RM:'DEFPROP':@RM:'LIST' Vals = Get_Property(Ctrls,Props) WONo = Vals[1,@RM] CassNo = Vals[COL2()+1,@RM] SlotList = Vals[COL2()+1,@RM] CtrlEnt = Get_Property(@WINDOW,'FOCUS') FieldNo = Get_Property(CtrlEnt,'POS') Send_Event(CtrlEnt,'GOTFOCUS') CheckValue = Get_Property(CtrlEnt,'DEFPROP') InvalidRequest = False$ IF ((WONo NE '') AND (CassNo NE '')) THEN WOMatKey = WONo:'*':CassNo OnHold = Xlate('WO_MAT', WOMatKey, 'HOLD', 'X') If OnHold NE True$ then IF (MemberOf(@USER4,'MASTER_SCHED')) | OR (MemberOf(@USER4,'SUPERVISOR')) | OR (MemberOf(@USER4,'ENGINEERING')) | OR (MemberOf(@USER4,'LEAD')) | OR (MemberOf(@USER4,'OI_ADMIN')) THEN WOMatRec = Database_Services("ReadDataRow", 'WO_MAT', WOMatKey) If Error_Services('NoError') then SAPBatchNo = WOMatRec SAPTXDtm = WOMatRec AwaitingBatchNo = ( (SAPTXDtm NE '') and (SAPBatchNo EQ '') ) FullBoxReject = (SAPBatchNo[-1, 1] = 'R') Begin Case Case AwaitingBatchNo InvalidRequest = True$ ErrMsg('WARNING: Cassette ineligible to be converted as it is awaiting a batch number from SAP.') Case FullBoxReject InvalidRequest = True$ ErrMsg('WARNING: Cassette ineligible to be converted as it is a full box reject.') Case Otherwise$ Null End Case If Not(InvalidRequest) then RDSNo = Get_Property(@Window:'.RDS_NO', 'TEXT') If RDSNo NE '' then Parms = '' Parms<1> = RDSNo ; // Cassette to verify wafer count of. Parms<2> = 0 ; // Wafer count adjustment - 0 because converting box. Parms<3> = 'MU' ; // Wafer counter tool location Proceed = Dialog_Box('NDW_WAFER_COUNTER', @Window, Parms) If Proceed EQ True$ then Set_Property(@WINDOW,'SAVEWARN', False$) Send_Event(@WINDOW,'CLEAR') obj_WO_Mat('ChangeFlag',WOMatKey:@RM:FieldNo:@RM:CheckValue) IF Get_Status(errCode) THEN ErrMsg(errCode) END end else InvalidRequest = True$ end end else InvalidRequest = True$ ErrMsg('WARNING: Error starting wafer counter check. RDS No is missing.') end end end else InvalidRequest = True$ ErrMsg('ERROR: Error reading WO_MAT record.') end END ELSE InvalidRequest = True$ ErrMsg('INFO: This function is limited to members of MASTER_SCHED, SUPERVISOR, ENGINEERING, or LEAD security groups.') END end else InvalidRequest = True$ ErrMsg('WARNING: Cannot modify lot while it is on hold.') end END ELSE InvalidRequest = True$ ErrMsg('WARNING: Work Order/Cassette information is missing.') END IF (InvalidRequest EQ True$) then /* Toggle back the checkbox flag */ If (CheckValue EQ False$) then Set_Property(CtrlEnt, 'DEFPROP', True$) end else Set_Property(CtrlEnt, 'DEFPROP', False$) end end obj_AppWindow('LoadFormKeys',@WINDOW:@RM:WOMatKey) RETURN * * * * * * * WOStepRdsDC: * * * * * * * ****************** This is a temporary hook to the old RDS_MAKEUP window for conversion JCH 4/8/2008 CtrlEntId = @WINDOW:'.WO_STEP_RDS_NO' CurrPos = Get_Property(CtrlEntId,'SELPOS') RowData = Get_Property(CtrlEntId,'ROWDATA') ColData = Get_Property(CtrlEntId,'ARRAY') CurrCol = CurrPos<1> CurrRow = CurrPos<2> IF CurrCol = 1 AND RowData NE '' THEN RDSNo = RowData END ELSE RDSNo = '' END IF RDSNo = '' THEN RETURN IF Get_Property(@WINDOW,'SAVEWARN') THEN Send_Event(@WINDOW,'WRITE') END obj_AppWindow('ViewRelated','RDS_MAKEUP':@RM:RDSNo) RETURN * * * * * * FQAVerify: * * * * * * // Check if FQA'd. If so, prompt for override. Authorized = False$ WorkOrdNo = Get_Property(@Window : '.WO_NO', 'TEXT') CassNo = Get_Property(@Window : '.CASS_NO', 'TEXT') WoMatKey = WorkOrdNo:'*':CassNo WoMatRec = Database_Services('ReadDataRow', 'WO_MAT', WoMatKey) FQASig = '' FQADate = '' ReactorType = XLATE('WO_LOG', WorkOrdNo, 'REACT_TYPE', 'X') SigArray = Signature_Services('GetSigProfile', WOMatKey) SigProfile = SigArray<1> Signatures = SigArray<2> SigDTMS = SigArray<3> IF (ReactorType = 'EPP') OR (ReactorType = 'EpiPro') THEN StatusStage = 'MO_QA' END ELSE StatusStage = 'QA' END LOCATE StatusStage IN SigProfile USING @VM SETTING Pos THEN FQASig = Signatures<1, Pos> FQADate = SigDTMS<1, Pos> end If (FQASig NE '') and (FQADate NE '') then // Cassette FQA'd OverrideMsg = "Cassette already FQA'd. SUPERVISOR, LEAD OR ENG. TECH must override." Response = Msg(@Window, '', 'OVERRIDE', '', OverrideMsg) Begin Case Case Response EQ 1 Response = True$ ; // User Clicked Override Case Response EQ 2 Response = False$ ; // User Clicked Cancel Case Response EQ char(27) Response = False$ ; // User Pressed Escape Key End Case If Response EQ True$ then Response = Dialog_Box('NDW_VERIFY_USER', @WINDOW, @USER4:@FM:'LEAD':@VM:'SUPERVISOR':@VM:'ENG_TECH') Authorized = Response<1> end else Authorized = False$ end end else Authorized = True$ end return LogRecord: WOMatRecCopy = WOMatRec Swap @FM with CRLF$ in WOMatRecCopy LogData = '' LogData<1> = LoggingDTM LogData<2> = @USER4 LogData<3> = WOMatKey LogData<4> = WOMatRecCopy LogData<5> = RetStack() Logging_Services('AppendLog', ObjLog, LogData, @RM, @FM, False$) return