1191 lines
42 KiB
Plaintext
1191 lines
42 KiB
Plaintext
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.
|
||
*/
|
||
|
||
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
|
||
|
||
$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)
|
||
|
||
* get the current style
|
||
|
||
EQU MULTILINE_STYLE$ TO 512 ;* MultiLine Select
|
||
|
||
Style = Get_Property('WO_MAT_WFR.SLOT_NO', 'STYLE')
|
||
|
||
IF Style [1,2] _EQC "0x" THEN
|
||
CONVERT @LOWER.CASE TO @UPPER.CASE IN STYLE
|
||
Style = ICONV(Style [3,99], "MX")
|
||
END
|
||
|
||
Style = BitOr(Style, MULTILINE_STYLE$)
|
||
Set_Property('WO_MAT_WFR.SLOT_NO', "STYLE", Style)
|
||
|
||
* 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 MemberOf(@USER4,'OI_ADMIN') THEN
|
||
Set_Property(@WINDOW:'.REM_MAKEUP_BUTTON','VISIBLE',1)
|
||
END
|
||
|
||
IF NOT(MakeupBox) AND UseMUWafers THEN
|
||
Set_Property(@WINDOW:'.ADD_MAKEUP_BUTTON','VISIBLE',1)
|
||
Set_Property(@WINDOW:'.REM_MAKEUP_BUTTON','VISIBLE',1)
|
||
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
|
||
Set_Property(@WINDOW:'.ADD_MAKEUP_BUTTON','VISIBLE',0)
|
||
Set_Property(@WINDOW:'.REM_MAKEUP_BUTTON','VISIBLE',0)
|
||
END
|
||
|
||
IF MemberOf(@USER4,'OI_ADMIN') THEN
|
||
Set_Property(@WINDOW:'.REM_MAKEUP_BUTTON','VISIBLE',1)
|
||
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<Line,1> 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<Line,2>
|
||
|
||
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<WO_MAT_MU_WAFER_ADDED_DTM$>
|
||
MURemDTMS = WOMatRec<WO_MAT_MU_WAFER_REMOVED_DTM$>
|
||
List = Get_Property(@Window : '.SLOT_NO', 'LIST')
|
||
NumRows = DCount(List, @FM)
|
||
For fPos = 1 to NumRows
|
||
Row = List<fPos>
|
||
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<fPos> = 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<WO_MAT_FAILED_WAFERS$>
|
||
|
||
FOR Line = 1 TO SlotListCnt
|
||
WaferID = SlotList<Line,COL$WAFER_ID>
|
||
* RepBy = SlotList<Line,COL$REPLACED_BY>
|
||
NCRNo = SlotList<Line,COL$SLOT_NCR>
|
||
WfrFailed = FailedWfrs<0, Line>
|
||
BEGIN CASE
|
||
CASE SlotList<Line,COL$SLOT> = ''
|
||
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
|
||
|
||
*******************Check for SAP Batch No OR SAP TX DTM from WO_MAT Record**********************
|
||
SAPBatchNo = Xlate('WO_MAT', WOMatKey, WO_MAT_SAP_BATCH_NO$, 'X')
|
||
SAPTXDtm = XLATE('WO_MAT', WOMatKey, WO_MAT_SAP_TX_DTM$, 'X')
|
||
IF SAPBatchNo NE '' OR SAPTXDtm NE '' then
|
||
Set_Property(@Window: '.MAKEUP_CHECKBOX', 'ENABLED', 0)
|
||
end
|
||
// Check if WO_MAT record is locked. If so, disable form buttons.
|
||
* RecordLocked = False$
|
||
* If WOMatKey NE '' then RecordLocked = Database_Services('IsKeyIDLocked', 'WO_MAT', WOMatKey, False$)
|
||
* If RecordLocked then
|
||
* LockOwner = Xlate('WO_MAT', WOMatKey, 'LOCKED_BY', 'X')
|
||
* If LockOwner NE '' then
|
||
* DisplayName = Oconv(LockOwner,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
|
||
* end else
|
||
* DisplayName = 'an unknown user'
|
||
* end
|
||
* MsgParms = ''
|
||
* MsgParms<1> = 'Record Locked'
|
||
* MsgParms<2> = 'The WO_MAT record for this RDS is locked by ':DisplayName:'. Only one user session at a time can edit an RDS.'
|
||
* Msg(@Window, '', 'OK', '', MsgParms)
|
||
* Set_Property(@Window:'.REJECT_MATERIAL', 'ENABLED', -1)
|
||
* Set_Property(@Window:'.ADD_MAKEUP_BUTTON', 'ENABLED', -1)
|
||
* Set_Property(@Window:'.REM_MAKEUP_BUTTON', 'ENABLED', -1)
|
||
* Set_Property(@Window:'.MAKEUP_CHECKBOX', 'ENABLED', -1)
|
||
* Set_Property(@Window:'.NCR_KEYS', 'ENABLED', -1)
|
||
* end
|
||
|
||
|
||
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')
|
||
If OnHold NE True$ then
|
||
|
||
OffHoldDTMs = Xlate('WO_MAT', WOMatKey, 'HOLD_STOP_DTM', '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' then
|
||
Def = ""
|
||
Def<MTEXT$> = "Please wait for SAP to process off hold transaction..."
|
||
Def<MTYPE$> = "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
|
||
|
||
GoSub FQAVerify
|
||
If Not(Authorized) then Return 0
|
||
|
||
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
|
||
|
||
IneligibleSlots = ''
|
||
AllSlotsPermitted = True$ ; // Assume that all slots are permitted to be NCR'd for now.
|
||
For I = 1 TO SelCnt
|
||
SlotNo = SlotList<SelectedRows<I>, COL$SLOT>
|
||
MetNo = SlotList<SelectedRows<I>, COL$MET_NO$>
|
||
WfrID = SlotList<SelectedRows<I>, COL$WAFER_ID>
|
||
PrevNCR = SlotList<SelectedRows<I>, COL$SLOT_NCR>
|
||
MUWfrID = SlotList<SelectedRows<I>, 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<SelectedRows<I>,COL$WAFER_ID> NE '' Then
|
||
GoodLines += 1
|
||
RejWaferIDs<1,GoodLines> = SlotList<SelectedRows<I>,COL$WAFER_ID>
|
||
PrevNCRNos<1,GoodLines> = SlotList<SelectedRows<I>,COL$SLOT_NCR>
|
||
SlotNos<1,GoodLines> = SlotList<SelectedRows<I>,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
|
||
|
||
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 else
|
||
// Cassette is on hold so material cannot be rejected.
|
||
ErrorMessage = 'Create NCR denied!. The cassette must be taken off hold before rejecting material.'
|
||
Msg(@Window, '', 'OK', '', 'Error':@FM:ErrorMessage)
|
||
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<SelectedRows<I>,COL$WAFER_ID> = '' AND SlotList<SelectedRows<I>,COL$SLOT_NCR> NE '' THEN
|
||
SlotNCRNo = SlotList<SelectedRows<I>,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<RPos,-1> = SlotList<SelectedRows<I>,COL$SLOT>
|
||
END ELSE
|
||
RecallNCRCnt += 1
|
||
RecallNCRNos = INSERT(RecallNCRNos,RPos,0,0,SlotList<SelectedRows<I>,COL$SLOT_NCR>)
|
||
RecallSlotNos = INSERT(RecallSlotNos,RPos,1,0,SlotList<SelectedRows<I>,COL$SLOT>)
|
||
END
|
||
END
|
||
END
|
||
NEXT I
|
||
|
||
|
||
|
||
FOR I = 1 TO RecallNCRCnt
|
||
RecallNCRNo = RecallNCRNos<I>
|
||
RecallSlot = RecallSlotNos<I>
|
||
|
||
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<EmptySlot,COL$WAFER_ID> 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
|
||
|
||
If 1 then
|
||
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.
|
||
SAPBatchNo = Xlate('WO_MAT', WOMatKey, 'SAP_BATCH_NO', 'X')
|
||
IF SAPBatchNo then
|
||
Msg(@Window , 'Lot has an SAP Batch No. and cannot be turned into a MU lot.')
|
||
Return
|
||
end
|
||
AvailMU_WOMatKeys = ''
|
||
UserResp = Response
|
||
MakeupBox = ''
|
||
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
|
||
End Case
|
||
If Response EQ True$ then
|
||
// User requested to convert the current cassette into a makeup box.
|
||
end
|
||
|
||
end else
|
||
AvailMU_WOMatKeys = obj_MUWafers('AvailWafers',WONo:@RM:@RM:1:@RM:1)
|
||
end
|
||
|
||
LOCATE WOMatKey IN AvailMU_WOMatKeys USING @VM SETTING Pos THEN
|
||
AvailMU_WOMatKeys = DELETE(AvailMU_WOMatKeys,1,Pos,0) ;* Remove current cassette from list
|
||
END
|
||
|
||
IF AvailMU_WOMatKeys = '' THEN
|
||
|
||
RDSNo = Get_Property(@Window : '.RDS_NO', 'TEXT') ; // Get the RDS No now before the WRITE in case it is needed to toggle the index.
|
||
If 0 then
|
||
UserResp = Msg(@WINDOW,'','MAKEUP_WAFERS') ;* This box is being made into m/u wafers message
|
||
end
|
||
|
||
IF UserResp = CHAR(27) THEN RETURN
|
||
|
||
Send_Event(@WINDOW,'WRITE')
|
||
|
||
FieldNo = WO_MAT_MAKEUP_BOX$
|
||
CheckValue = 1
|
||
|
||
obj_WO_Mat('ChangeFlag',WOMatKey:@RM:FieldNo:@RM:CheckValue)
|
||
WOMatRow = Database_Services('ReadDataRow', 'WO_MAT', WOMatKey)
|
||
WOMatRow<12> = '' ; // Clear the RDS No so the index will be forced to recalculate.
|
||
WOMatRow<23> = False$ ; // Clear the MakeUp box flag so the index will be forced to recalculate.
|
||
Database_Services('WriteDataRow', 'WO_MAT', WOMatKey, WOMatRow, True$, False$, True$)
|
||
WOMatRow<12> = RDSNo ; // Restore the RDS No so the index on RDS_FINAL_SIG will be forced to recalculate with the most recent value.
|
||
WOMatRow<23> = True$ ; // Restore the MakeUp box flag so the index will be forced to recalculate.
|
||
WOMatRec = WOMatRow
|
||
GoSub LogRecord
|
||
Database_Services('WriteDataRow', 'WO_MAT', WOMatKey, WOMatRow, True$, False$, True$)
|
||
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$)
|
||
Update_Index('WO_MAT', 'CURR_STATUS', False$)
|
||
|
||
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<COL$LOG_FILE> = 'WO_MAT'
|
||
EventParms<COL$LOG_DTM> = CurrDTM
|
||
EventParms<COL$ACTION> = 'RTU'
|
||
EventParms<COL$WH_CD> = 'CR'
|
||
EventParms<COL$LOC_CD> = 'MU'
|
||
EventParms<COL$WO_NOS> = WONo
|
||
EventParms<COL$CASS_NOS> = CassNo
|
||
EventParms<COL$USER_ID> = @USER4
|
||
EventParms<COL$TAGS> = ''
|
||
EventParms<COL$TOOL_ID> = ''
|
||
|
||
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)
|
||
|
||
END
|
||
|
||
TypeOver = ''
|
||
TypeOver<PDISPLAY$> = AvailMU_WOMatKeys
|
||
|
||
If 0 then
|
||
MakeupBox = Popup(@WINDOW,TypeOver,'WO_MAT_MAKEUP')
|
||
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 = ''
|
||
END
|
||
END
|
||
IF MakeupBox = '' THEN RETURN
|
||
|
||
Valid = Dialog_Box( 'QUOTE_SIG_PWD_ENTRY', @WINDOW, @USER4:@VM:XLATE( 'LSL_USERS', @USER4, LSL_USERS_PASSWORD$, 'X' ) )
|
||
|
||
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 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<MadeupSlot,COL$MU_WAFER_ID> = '' 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 = 0
|
||
|
||
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
|
||
|
||
Set_Property(@WINDOW,'SAVEWARN','0')
|
||
Send_Event(@WINDOW,'CLEAR')
|
||
|
||
obj_WO_Mat('ChangeFlag',WOMatKey:@RM:FieldNo:@RM:CheckValue)
|
||
|
||
IF Get_Status(errCode) THEN
|
||
ErrMsg(errCode)
|
||
END
|
||
|
||
END ELSE
|
||
InvalidRequest = 1
|
||
ErrMsg('INFO: This function is limited to authorized users only.')
|
||
END
|
||
end else
|
||
InvalidRequest = 1
|
||
ErrMsg('WARNING: Cannot modify lot while it is on hold.')
|
||
end
|
||
END ELSE
|
||
InvalidRequest = 1
|
||
ErrMsg('WARNING: Work Order/Cassette information is missing.')
|
||
END
|
||
|
||
|
||
IF (InvalidRequest = 1) then
|
||
/* Toggle back the checkbox flag */
|
||
IF (CheckValue = 0) THEN
|
||
Set_Property(CtrlEnt, 'DEFPROP', 1)
|
||
END ELSE
|
||
Set_Property(CtrlEnt, 'DEFPROP', 0)
|
||
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<CurrCol> NE '' THEN
|
||
RDSNo = RowData<CurrCol>
|
||
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
|
||
|
||
|