open-insight/LSL2/STPROC/OBJ_SHIPMENT_DEV.txt
Infineon\StieberD 7762b129af pre cutover push
2024-09-04 20:33:41 -07:00

1171 lines
31 KiB
Plaintext

COMPILE FUNCTION obj_Shipment_Dev(Method,Parms)
/*
Methods for Shipment (COC) table
02/02/2005 JCH - Initial Coding
Properties:
Methods:
Find() ;* Lookup Order number
Pick(ShipNo) ;* Adds ShipNo to RDS Records
Unpick(ShipNo) ;* Removes ShipNo from RDS Records
*/
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Dialog_Box, obj_WO_Log, obj_WM_Out, Environment_Services
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, ErrMsg, obj_WO_Step, obj_WO_Log, obj_RDS, Btree.Extract, Yield
DECLARE SUBROUTINE obj_Vision, obj_WM_Out
$INSERT MSG_EQUATES
$INSERT COMPANY_EQU
$INSERT ORDER_EQU
$INSERT ORDER_DET_EQU
$INSERT WO_LOG_EQU
$INSERT WO_STEP_EQU
$INSERT WO_MAT_EQUATES
$INSERT COC_EQU
$INSERT RDS_EQU
$INSERT XO_EQUATES
EQU CRLF$ TO \0D0A\
ErrTitle = 'Error in Stored Procedure "obj_Shipment"'
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 = 'Find' ; GOSUB Find
CASE Method = 'OrdItemNos' ; GOSUB OrdItemNos
CASE Method = 'ItemWaferQty' ; GOSUB ItemWaferQty
CASE Method = 'ItemRejQty' ; GOSUB ItemRejQty
CASE Method = 'ItemProdTestQty' ; GOSUB ItemProdTestQty
CASE Method = 'OpenShipments' ; GOSUB OpenShipments
CASE Method = 'TodaysShipments' ; GOSUB TodaysShipments
CASE Method = 'PrevStepRDSNos' ; GOSUB PrevStepRDSNos
CASE Method = 'Pick' ; GOSUB Pick
CASE Method = 'UnPick' ; GOSUB UnPick
CASE Method = 'SendToVision' ; GOSUB SendToVision
CASE 1
ErrorMsg = 'Unknown Method ':QUOTE(Method):' passed to routine.'
END CASE
IF ErrorMsg NE '' THEN
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
RETURN ''
END
RETURN Result
* * * * * * *
Find:
* * * * * * *
ShipKeys = Dialog_Box( 'COC_QUERY', @window, '' )
CONVERT @FM TO @VM IN ShipKeys
Result = ShipKeys
RETURN
* * * * * * *
OrdItemNos:
* * * * * * *
IF NOT(ASSIGNED(thisShipNo)) THEN
thisShipNo = Parms[1,@RM]
END
IF NOT(ASSIGNED(thisShipRec)) THEN
thisShipRec = Parms[COL2()+1,@RM]
END
IF thisShipNo = '' THEN RETURN
IF thisShipRec = '' THEN thisShipRec = XLATE('COC',thisShipNo,'','X')
IF thisShipRec = '' THEN RETURN
RDSNos = thisShipRec<COC_RDS_NO$>
OrderItemNos = ''
thisRDSItemNos = ''
IF RDSNos = '' THEN
WONo = thisShipRec<COC_WO$>
WOStepNos = thisShipRec<COC_WO_STEP$>
WOCassNos = thisShipRec<COC_CASS_NO$>
WORec = XLATE('WO_LOG',WONo,'','X')
FOR I = 1 TO COUNT(WOCassNos,@VM) + (WOCassNos NE '')
WOStepNo = WOStepNos<1,I>
WOCassNo = WOCassNos<1,I>
InCassIDs = obj_WM_Out('InCassData',WONo:'*':WOStepNo:'*':WOCassNo)<1> ;* Inbound cassette IDs (Includes Makeups)
* Following added 4/25/07 JCH - Problem with makeup wafer cassette ID's being returned
LOOP
InCassID = InCassIDs[1,@VM]
InCassIDs[1,COL2()] = ''
InWONo = InCassID[1,'*']
UNTIL InWONo = WONo OR InCassIDS = ''
REPEAT
OrderItemNo = XLATE('WO_MAT',InCassID,WO_MAT_ORDER_ITEM$,'X')
*LOCATE InCassNo IN WORec<WO_LOG_CASS_NO$> USING @VM SETTING Pos THEN ;*Dead 1/2/2007 JCH
* OrderItemNo = WORec<WO_LOG_CASS_ORDER_ITEM$,Pos>
*END
LOCATE OrderItemNo IN OrderItemNos USING @VM SETTING Pos ELSE
OrderItemNos = INSERT(OrderItemNos,1,Pos,0,OrderItemNo)
END
NEXT I
END ELSE
thisRDSItemNos = XLATE('RDS',RDSNos,RDS_ORDER_ITEM$,'X')
OrderItemNos = ''
thisOrderItemRDSKeys = ''
FOR I = 1 TO COUNT(thisRDSItemNos,@VM) + (thisRDSItemNos NE '')
thisRDSItemNo = thisRDSItemNos<1,I>
LOCATE thisRdsItemNo IN OrderItemNos BY 'AR' USING @VM SETTING Pos THEN
thisOrderItemRDSKeys = INSERT(thisOrderItemRDSKeys,1,Pos,-1,RDSNos<1,I>)
END ELSE
OrderItemNos = INSERT(OrderItemNos,1,Pos,0,thisRdsItemNo)
thisOrderItemRDSKeys = INSERT(thisOrderItemRDSKeys,1,Pos,-1,RDSNos<1,I>)
END
NEXT I
END
Result = OrderItemNos
RETURN
* * * * * * *
ItemWaferQty:
* * * * * * *
IF NOT(ASSIGNED(thisShipNo)) THEN
thisShipNo = Parms[1,@RM]
END
IF NOT(ASSIGNED(thisShipRec)) THEN
thisShipRec = Parms[COL2()+1,@RM]
END
IF thisShipNo = '' THEN RETURN
IF thisShipRec = '' THEN thisShipRec = XLATE('COC',thisShipNo,'','X')
IF thisShipRec = '' THEN RETURN
GOSUB OrdItemNos ;* Get unique Order Item numbers found in the RDS detail, This also sets thisRDSItemNos matching the RDSNos
ItemNos = Result
Result = ''
ShipRDSNos = thisShipRec<COC_RDS_NO$>
ShipRDSWaferQtys = XLATE('RDS',ShipRDSNos,'WFRS_OUT','X')
FOR I = 1 TO COUNT(ShipRdsNos,@VM) + (ShipRDSNos NE '')
thisRDSItemNo = thisRDSItemNos<1,I>
ShipRDSWaferQty = ShipRDSWaferQtys<1,I>
LOCATE thisRDSItemNo IN ItemNos USING @VM SETTING Pos THEN
Result<1,Pos> = Result<1,Pos> + ShipRDSWaferQty
END ELSE
Result = INSERT(Result,1,Pos,0,ShipRDSWaferQty)
END
NEXT I
RETURN
* * * * * * *
ItemRejQty:
* * * * * * *
IF NOT(ASSIGNED(thisShipNo)) THEN
thisShipNo = Parms[1,@RM]
END
IF NOT(ASSIGNED(thisShipRec)) THEN
thisShipRec = Parms[COL2()+1,@RM]
END
IF thisShipNo = '' THEN RETURN
IF thisShipRec = '' THEN thisShipRec = XLATE('COC',thisShipNo,'','X')
IF thisShipRec = '' THEN RETURN
GOSUB OrdItemNos ;* Get unique Order Item numbers found in the RDS detail
ItemNos = Result
Result = ''
GOSUB OrdItemNos ;* Get unique Order Item numbers found in the RDS detail, This also sets thisRDSItemNos matching the RDSNos
ItemNos = Result
Result = ''
ShipRDSNos = thisShipRec<COC_RDS_NO$>
ShipRDSRejQtys = XLATE('RDS',ShipRDSNos,'TOT_REJ','X')
FOR I = 1 TO COUNT(ShipRDSNos,@VM) + (ShipRDSNos NE '')
thisRDSItemNo = thisRDSItemNos<1,I>
ShipRDSRejQty = ShipRDSRejQtys<1,I>
LOCATE thisRDSItemNo IN ItemNos USING @VM SETTING Pos THEN
Result<1,Pos> = Result<1,Pos> + ShipRDSRejQty
END ELSE
Result = INSERT(Result,1,Pos,0,ShipRDSRejQty)
END
NEXT I
RETURN
* * * * * * *
ItemProdTestQty:
* * * * * * *
IF NOT(ASSIGNED(thisShipNo)) THEN
thisShipNo = Parms[1,@RM]
END
IF NOT(ASSIGNED(thisShipRec)) THEN
thisShipRec = Parms[COL2()+1,@RM]
END
IF thisShipNo = '' THEN RETURN
IF thisShipRec = '' THEN thisShipRec = XLATE('COC',thisShipNo,'','X')
IF thisShipRec = '' THEN RETURN
GOSUB OrdItemNos ;* Get unique Order Item numbers found in the RDS detail
ItemNos = Result
Result = ''
GOSUB OrdItemNos ;* Get unique Order Item numbers found in the RDS detail, This also sets thisRDSItemNos matching the RDSNos
ItemNos = Result
Result = ''
ShipRDSNos = thisShipRec<COC_RDS_NO$>
ShipRDSProdTestQtys = XLATE('RDS',ShipRDSNos,RDS_TW_PROD$,'X')
FOR I = 1 TO COUNT(ShipRDSNos,@VM) + (ShipRDSNos NE '')
thisRDSItemNo = thisRDSItemNos<1,I>
ShipRDSProdTestQty = ShipRDSProdTestQtys<1,I>
LOCATE thisRDSItemNo IN ItemNos USING @VM SETTING Pos THEN
Result<1,Pos> = Result<1,Pos> + ShipRDSProdTestQty
END ELSE
Result = INSERT(Result,1,Pos,0,ShipRDSProdTestQty)
END
NEXT I
RETURN
* * * * * * *
OpenShipments:
* * * * * * *
StartDt = ICONV('3/2/2006','D')
OPEN 'DICT.COC' TO DictVar THEN
SearchString = 'ENTRY_DATE':@VM:'>=':OConv(StartDt, 'D4/'):@FM
Flag = ''
Btree.Extract(SearchString, 'COC', DictVar, ShipKeys, '', Flag)
IF Get_Status(errCode) THEN
Msg(@window, MsgUp)
ErrMsg(errCode)
RETURN
END
IF ShipKeys = '' THEN
ErrMsg("No Shipments (COC's) on file for last 5 days.")
RETURN
END
OpenShipKeys = ''
CurrStatuses = XLATE('COC',ShipKeys,'CURR_STATUS','X')
FOR I = 1 TO COUNT(ShipKeys,@VM) + (ShipKeys NE '')
IF CurrStatuses<1,I> NE 'COMP' THEN
OpenShipKeys<1,-1> = ShipKeys<1,I>
END
NEXT I
Result = OpenShipKeys
END
RETURN
* * * * * * *
TodaysShipments:
* * * * * * *
OPEN 'DICT.COC' TO DictVar THEN
SearchString = 'ENTRY_DATE':@VM:'>=':OConv(Date(), 'D4/'):@FM
Flag = ''
Btree.Extract(SearchString, 'COC', DictVar, ShipKeys, '', Flag)
IF Get_Status(errCode) THEN
Msg(@window, MsgUp)
ErrMsg(errCode)
RETURN
END
IF ShipKeys = '' THEN
ErrMsg("No Shipments (COC's) on file for today.")
RETURN
END
Result = ShipKeys
END
RETURN
* * * * * * *
PrevStepRDSNos:
* * * * * * *
ShipNo = Parms[1,@RM]
StepNo = Parms[COL2()+1,@RM]
ShipRDSKeys = Parms[COL2()+1,@RM]
ShipRec = Parms[COL2()+1,@RM]
IF ShipNo = '' THEN ErrorMsg = 'Null parameter "ShipNo" passed to routine. (':Method:')'
IF StepNo = '' THEN ErrorMsg = 'Null parameter "StepNo" passed to routine. (':Method:')'
IF ShipRDSKeys = '' THEN ErrorMsg = 'Null parameter "ShipRDSKeys" passed to routine. (':Method:')'
IF ErrorMsg NE '' THEN RETURN
IF ShipRec = '' THEN
ShipRec = XLATE('COC',ShipNo,'','X')
END
IF ShipRec = '' THEN RETURN
WONo = ShipRec<COC_WO$>
WOStepKeys = XLATE('WO_LOG',WONo,WO_LOG_WO_STEP_KEY$,'X')
LastStep = WOStepKeys[-1,'B':@VM]
LastStepRDSKeys = XLATE('WO_STEP',LastStep,WO_STEP_RDS_KEY$,'X')
StepRDSKeys = XLATE('WO_STEP',WONo:'*':StepNo,WO_STEP_RDS_KEY$,'X')
FOR I = 1 TO COUNT(ShipRDSKeys,@VM) + (ShipRDSKeys NE '')
ShipRDSKey = ShipRDSKeys<1,I>
LOCATE ShipRDSKey IN LastStepRDSKeys USING @VM Setting Pos THEN
Result<1,-1> = StepRDSKeys<1,Pos>
END
NEXT I
RETURN
* * * * * * *
Pick:
* * * * * * *
IF NOT(ASSIGNED(ShipNo)) THEN
ShipNo = Parms[1,@RM] ;* External call - get parameters
END
IF ShipNo = '' THEN
ErrorMsg = 'Null parameter "ShipNo" passed to routine. (':Method:')'
RETURN
END
OtParms = 'COC':@RM:ShipNo
ShipRec = obj_Tables('ReadRec',OtParms)
IF Get_Status(errCode) THEN RETURN
IF ShipRec<COC_PICK_DTM$> NE '' THEN
obj_Tables('UnlockRec',OtParms)
RETURN ;* Already picked
END
WONo = ShipRec<COC_WO$>
RDSNos = ShipRec<COC_RDS_NO$>
WOStepNos = ShipRec<COC_WO_STEP$>
WOCassNos = ShipRec<COC_CASS_NO$>
LineCnt = COUNT(WOCassNos,@VM) + (WOCassNos NE '')
IF LineCnt = 0 THEN RETURN
ShipDt = OCONV(ShipRec<COC_ENTRY_DATE$>,'D4/') ;* Pass to object in EXTERNAL format
ShipTm = OCONV(Time(),'MTH') ;* Pass to object in EXTERNAL format
IF LineCnt > 2 THEN
Def = ''
Def<MCAPTION$> = 'Picking Shipment Line Items...'
Def<MTYPE$> = 'G'
Def<MEXTENT$> = LineCnt
Def<MTEXTWIDTH$> = 600
MsgUp = Msg(@WINDOW,Def)
END ELSE
MsgUp = ''
END
IF RDSNos<1,1> NE '' THEN
PickedRDSNos = ''
FOR I = 1 TO LineCnt
RDSNo = RDSNos<1,I>
IF RDSNo NE '' THEN
obj_RDS('AddShip',ShipNo:@RM:RDSNo:@RM:ShipDt:@RM:ShipTm) ;* Add Ship info to RDS Record
IF MsgUp NE '' THEN
Msg(@WINDOW, MsgUp, I, MSGINSTUPDATE$)
END
IF Get_Status(errCode) THEN
IF MsgUp NE '' THEN Msg(@WINDOW,MsgUp)
ErrMsg(errCode)
FOR N = 1 TO COUNT(PickedRDSNos,@VM) + (PickedRDSNos NE '')
PickedRDSNo = PickedRDSNos<1,N>
obj_RDS('RemShip',ShipNo:@RM:PickedRDSNo) ;* Back out Ship Info already added
NEXT N
obj_Tables('UnlockRec',OtParms) ;* Unlock the Shipment record
RETURN
END ELSE
PickedRDSNos<1,-1> = RDSNo
END
END
NEXT I
END ELSE
PickedWMOutKeys = ''
FOR I = 1 TO LineCnt
WMOutKey = WONo:'*':WOStepNos<1,I>:'*':WOCassNos<1,I>
IF WOStepNos<1,I> NE '' AND WOCassNos<1,I> NE '' THEN
obj_WM_Out('AddShip',WMOutKey:@RM:ShipNo) ;* Add Ship info to WM_OUT Record
IF MsgUp NE '' THEN
Msg(@WINDOW, MsgUp, I, MSGINSTUPDATE$)
END
IF Get_Status(errCode) THEN
IF MsgUp NE '' THEN Msg(@WINDOW,MsgUp)
ErrMsg(errCode)
FOR N = 1 TO COUNT(PickedWMOutKeys,@VM) + (PickedWMOutKeys NE '')
PickedWMOutKey = PickedWMOutKeys<1,N>
obj_WM_Out('RemShip',PickedWMOutKey:@RM:ShipNo) ;* Back out Ship Info already added
NEXT N
obj_Tables('UnlockRec',OtParms) ;* Unlock the Shipment record
RETURN
END ELSE
PickedWMOutKeys<1,-1> = WMOutKey
END
END
NEXT I
END
IF MsgUp NE '' THEN Msg(@WINDOW,MsgUp)
* Update Shipment (COC) record with picked info
ShipRec<COC_PICK_DTM$> = ICONV(OCONV(Date(),'D2/'):' ':OCONV(Time(),'MT'),'DT')
ShipRec<COC_PICK_BY$> = @USER4
OtParms = FieldStore(OtParms,@RM,4,0,ShipRec) ;* Put record in 4th field of OtParms
obj_Tables('WriteRec',OtParms)
IF Get_Status(errCode) THEN
obj_Tables('UnlockRec',OtParms)
END
RETURN
* * * * * * *
UnPick:
* * * * * * *
IF NOT(ASSIGNED(ShipNo)) THEN
ShipNo = Parms[1,@RM] ;* External call - get parameters
END
OtParms = 'COC':@RM:ShipNo
ShipRec = obj_Tables('ReadRec',OtParms)
IF Get_Status(errCode) THEN RETURN
IF ShipRec<COC_PICK_DTM$> = '' THEN
obj_Tables('UnlockRec',OtParms)
RETURN ;* Not picked
END
WONo = ShipRec<COC_WO$>
RDSNos = ShipRec<COC_RDS_NO$>
WOStepNos = ShipRec<COC_WO_STEP$>
WOCassNos = ShipRec<COC_CASS_NO$>
LineCnt = COUNT(WOCassNos,@VM) + (WOCassNos NE '')
IF LineCnt = 0 THEN RETURN
ShipDt = OCONV(ShipRec<COC_ENTRY_DATE$>,'D4/') ;* Pass to object in EXTERNAL format - Used in case of problem
ShipTm = OCONV(Time(),'MTH') ;* Pass to object in EXTERNAL format
IF LineCnt > 2 THEN
Def = ''
Def<MCAPTION$> = 'UnPicking Shipment Line Items...'
Def<MTYPE$> = 'G'
Def<MEXTENT$> = LineCnt
Def<MTEXTWIDTH$> = 600
MsgUp = Msg(@WINDOW,Def)
END ELSE
MsgUp = ''
END
IF RDSNos<1,1> NE '' THEN
UnPickedRDSNos = ''
FOR I = 1 TO LineCnt
RDSNo = RDSNos<1,I>
IF RDSNo NE '' THEN
obj_RDS('RemShip',ShipNo:@RM:RdsNo)
IF Get_Status(errCode) THEN
ErrMsg(errCode) ;* Problem UnPicking
FOR N = 1 TO COUNT(UnPickedRDSNos,@VM) + (UnPickedRDSNos NE '')
UnPickedRDSNo = UnPickedRDSNos<1,N>
obj_RDS('AddShip',ShipNo:@RM:UnPickedRDSNo:@RM:ShipDt:@RM:ShipTm) ;* Back out Ship Info already added
NEXT N
obj_Tables('UnlockRec',OtParms) ;* Unlock the Shipment record
RETURN
END ELSE
UnPickedRDSNos<1,-1> = RDSNo
END
END
NEXT I
END ELSE
UnPickedWMOutKeys = ''
FOR I = 1 TO LineCnt
WMOutKey = WONo:'*':WOStepNos<1,I>:'*':WOCassNos<1,I>
IF WOStepNos<1,I> NE '' AND WOCassNos<1,I> NE '' THEN
obj_WM_Out('RemShip',WMOutKey:@RM:ShipNo) ;* Add Ship info to WM_OUT Record
IF MsgUp NE '' THEN
Msg(@WINDOW, MsgUp, I, MSGINSTUPDATE$)
END
IF Get_Status(errCode) THEN
IF MsgUp NE '' THEN Msg(@WINDOW,MsgUp)
ErrMsg(errCode)
FOR N = 1 TO COUNT(UnPickedWMOutKeys,@VM) + (UnPickedWMOutKeys NE '')
UnPickedWMOutKey = UnPickedWMOutKeys<1,N>
obj_WM_Out('AddShip',UnPickedWMOutKey:@RM:ShipNo) ;* Back out Ship Info already added
NEXT N
obj_Tables('UnlockRec',OtParms) ;* Unlock the Shipment record
RETURN
END ELSE
UnPickedWMOutKeys<1,-1> = WMOutKey
END
END
NEXT I
END
IF MsgUp NE '' THEN Msg(@WINDOW,MsgUp)
* Update Shipment (COC) record with picked info
ShipRec<COC_PICK_DTM$> = ''
ShipRec<COC_PICK_BY$> = ''
OtParms = FieldStore(OtParms,@RM,4,0,ShipRec) ;* Put record in 4th field of OtParms
obj_Tables('WriteRec',OtParms)
IF Get_Status(errCode) THEN
obj_Tables('UnlockRec',OtParms)
END
RETURN
* * * * * * *
SendToVision:
* * * * * * *
ShipNo = Parms[1,@RM]
IF ShipNo = '' THEN
ErrorMsg = 'Null parameter "ShipNo" passed to routine. (':Method:')'
RETURN
END
OtParms = 'COC':@RM:ShipNo
ShipRec = obj_Tables('ReadRec',OtParms)
IF Get_Status(errCode) THEN RETURN
IF ShipRec<COC_SEND_DTM$> NE '' THEN
SendReason = Msg(@WINDOW,'','RESEND_REASON') ;* This guy has already been sent
IF SendReason = CHAR(27) OR SendReason = '' THEN
obj_Tables('UnlockRec',OtParms)
RETURN
END
END ELSE
SendReason = 'Initial Tx'
END
SendDtm = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
SendUser = @USER4
WorkOrderNo = ShipRec<COC_WO$>
WORec = XLATE('WO_LOG',WorkOrderNo,'','X')
OrderNo = WORec<WO_LOG_ORDER_NO$>
WOCustNo = WORec<WO_LOG_CUST_NO$>
OrderItemNos = WORec<WO_LOG_ORDER_ITEM$>
OrderDetKeys = ''
FOR I = 1 TO COUNT(OrderItemNos,@VM) + (OrderItemNos NE '')
OrderDetKeys<1,I> = OrderNo:'*':OrderItemNos<1,I> ;* All of Order Item Keys on the Work Order
NEXT I
Captive = XLATE('COMPANY',WOCustNo,COMPANY_CAPTIVE$,'X')
Consignment = XLATE('COMPANY',WOCustNo,COMPANY_CONSIGNMENT$,'X')
BEGIN CASE
CASE Captive ; Ordertype = 'CAPTIVE'
CASE Consignment ; OrderType = 'CAPTIVE' ;* Vision doesn't know about consignment orders yet
CASE 1 ; OrderType = 'MERCHANT'
END CASE
* Build the Order Line Item Detail from RDS records using local methods
OrderItemShippedQtys = ''
OrderItemRejQtys = ''
OrderItemRDSNos = ''
RDSNos = ShipRec<COC_RDS_NO$>
IF RDSNos = '' THEN
WOStepNos = ShipRec<COC_WO_STEP$>
WOCassNos = ShipRec<COC_CASS_NO$>
FOR I = 1 TO COUNT(WOCassNos,@VM) + (WOCassNos NE '')
WOStepNo = WOStepNos<1,I>
WOCassNo = WOCassNos<1,I>
LOCATE WOCassNo IN WORec<WO_LOG_CASS_NO$> USING @VM SETTING Pos THEN
OrderItem = WORec<WO_LOG_CASS_ORDER_ITEM$,Pos>
END
WfrsOut = XLATE('WM_OUT',WorkOrderNo:'*':WOStepNo:'*':WOCassNo,'WAFER_CNT','X')
Rejects = 0
LOCATE OrderItem IN OrderItemNos USING @VM SETTING Pos THEN
OrderItemShippedQtys<1,Pos> = OrderItemShippedQtys<1,Pos> + WfrsOut
OrderItemRejQtys<1,Pos> = OrderItemRejQtys<1,Pos> + Rejects
OrderItemRDSNos<1,Pos,-1> = WorkOrderNo:'.':WOStepNo:'.':WOCassNo ;* Substitute CassID for RDS
END
NEXT I
END ELSE
FOR I = 1 TO COUNT(RDSNos,@VM) + (RDSNos NE '')
RDSNo = RDSNos<1,I>
RDSRec = XLATE('RDS',RDSNo,'','X')
Rejects = XLATE('RDS',RDSNo,'TOT_REJ','X')
WfrsOut = XLATE('RDS',RDSNo,'WFRS_OUT','X')
TWProd = RDSRec<RDS_TW_PROD$>
OrderItem = RDSRec<RDS_ORDER_ITEM$>
IF Captive OR Consignment THEN
Rejects = 0
END ELSE
Rejects += TWProd
END
LOCATE OrderItem IN OrderItemNos USING @VM SETTING Pos THEN
OrderItemShippedQtys<1,Pos> = OrderItemShippedQtys<1,Pos> + WfrsOut
OrderItemRejQtys<1,Pos> = OrderItemRejQtys<1,Pos> + Rejects
OrderItemRDSNos<1,Pos,-1> = RDSNo
END
NEXT I
END
DEBUG
OrderRec = XLATE('ORDER',OrderNo,'','X')
Company = '001'
Warehouse = 'ME1'
VisionOrderNo = OrderRec<ORDER_VISION_ORDER_NO$>
VisionRelNo = '0' ;* Send as null - Vision will return the number
WorkOrderItem = '0'
CustPONo = OrderRec<ORDER_PO_NO$> ;* Doctor this up to include the Release No
CustPOLineNo = OrderRec<ORDER_PO_LINE$>
ShipToCustNo = OrderRec<ORDER_SHIP_TO_CUST_NO$>
BillToCustNo = OrderRec<ORDER_BILL_TO_CUST_NO$>
IF ShipToCustNo = '' THEN
ErrMsg('Missing Vision Ship To Customer No')
obj_Tables('UnlockRec',OtParms)
RETURN
END
IF BillToCustNo = '' THEN
ErrMsg('Missing Vision Bill To Customer No')
obj_Tables('UnlockRec',OtParms)
RETURN
END
TotalWafersOrdered = SUM(XLATE('ORDER_DET',OrderDetKeys,'WAFER_QTY','X'))
TotalShipWfrQty = XLATE('COC',ShipNo,'TOT_QTY','X') ;* Total Good Wafers on Shipment
TotalShipRejQty = XLATE('COC',ShipNo,'TOT_REJ','X') ;* Total Reject Wafers in Shipment
TotalShipProdQty = XLATE('COC',ShipNo,'TOT_PROD','X')
TotalShipmentWafers = TotalShipWfrQty + TotalShipRejQty + TotalShipProdQty ;* Total wafers in this shipment
OrderItemPartTypes = XLATE('ORDER_DET',OrderDetKeys,ORDER_DET_VISION_PART_TYPE$,'X') ;* Part Types on this Work Order
PrevShipNos = XLATE('ORDER_DET',OrderDetKeys,ORDER_DET_SHIP_NO$,'X') ;* All shipments on work order
LOCATE ShipNo IN PrevShipNos USING @VM SETTING Pos THEN
PrevShipNos = DELETE(PrevShipNos,1,Pos,0) ;* Remove current shipment from list
END
PrevSRP_MiscQtys = XLATE('COC',PrevShipNos,'ITEM_MISC_QTY','X')
CONVERT @VM TO '' IN PrevSRP_MiscQtys
IF PrevSRP_MiscQtys NE '' THEN SurchargesSent = 1 ELSE SurchargesSent = 0
TotPrevShipQtys = SUM(XLATE('COC',PrevShipNos,'TOT_WAFERS_SHIPPED','X')) ;* All wafers shipped on previous shipments against this Work Order
HeaderScript = ''
DetailScript = ''
RejectsScript = ''
* Load Common parameters first
EPIPCO = Company
EPIWHS = Warehouse
EPISHN = ShipNo
EPIONO = OrderNo
XTONO = VisionOrderNo
XTRLNO = VisionRelNo
EPIWON = WorkOrderNo
EPIWLN = WorkOrderItem
XTCSPO = CustPONo
XTPOLN = CustPOLineNo
IF XTPOLN = '' THEN XTPOLN = 0
IF XTRLNO = '' THEN XTRLNO = 0
XTSTCN = ShipToCustNo ;* This should be the Vision version of the customer number
XTBTCN = BillToCustNo ;* This should be the Vision version of the customer number
EPIPPN = OrderType ;* 'CAPTIVE' or 'MERCHANT' ???
ResultLine = 0 ;* Pointer for invoice information placed in the Shipment (COC) record.
* Now Load the Line Item specific stuff
IF INDEX(OrderItemPartTypes,'5',1) THEN
* This Work Order has SRP and/or surcharges on it
IF TotalShipmentWafers + TotPRevShipQtys >= TotalWafersOrdered THEN
FOR I = 1 TO COUNT(OrderItemPartTypes,@VM) + (OrderItemPartTypes NE '')
IF OrderItemPartTypes<1,I> = '5' AND NOT(SurchargesSent) THEN
OrderItemKey = OrderDetKeys<1,I>
OrderDetRec = XLATE('ORDER_DET',OrderItemKey,'','X')
Canceled = (OrderDetRec<ORDER_DET_UNIT_PRICE$> = 0 AND OrderDetRec<ORDER_DET_ITEM_QTY$> = 0)
IF NOT(Canceled) THEN
ResultLine += 1 ;* Added 10/29/2005 JCH - J.C. Henry & Co., Inc.
ShipRec<COC_ORDER_ITEM$,ResultLine> = OrderItemNos<1,I>
ShipRec<COC_ITEM_WFR_QTY$,ResultLine> = ''
ShipRec<COC_ITEM_MISC_QTY$,ResultLine> = '1'
ShipRec<COC_ITEM_UNIT_PRICE$,ResultLine> = OrderDetRec<ORDER_DET_UNIT_PRICE$>
* If Both Unit Price and Item Qty are 0 then this item has been canceled
EPILNO = OrderItemKey[-1,'B*'] ;* Order Item No
XTLNO = OrderDetRec<ORDER_DET_VISION_LINE_NO$>
IF XTLNO = '' THEN
ErrMsg('Missing Vision Line No')
RETURN
END
EPIPTN = OrderDetRec<ORDER_DET_EPI_PN$>
IF EPIPTN = '' THEN
ErrMsg('Missing EPI Part No')
RETURN
END
IF OrderDetRec<ORDER_DET_UNIT_PRICE$> = '' THEN
UnitPrice = 0
END ELSE
UnitPrice = OrderDetRec<ORDER_DET_UNIT_PRICE$>
END
XTPTNO = OrderDetRec<ORDER_DET_CUST_PN$>
EPIUPR = OCONV(UnitPrice,'MD32')
EPIQTN = OrderDetRec<ORDER_DET_QUOTE_NO$>
XTCRDT = OCONV(OrderDetRec<ORDER_DET_CUST_REQ_DT$>,'[VISION_DT_FORMAT]')
EPICDT = OCONV(OrderDetRec<ORDER_DET_PROMISE_DT$>,'[VISION_DT_FORMAT]')
XTSQTY = OrderDetRec<ORDER_DET_ITEM_QTY$>
IF EPILNO = '' THEN EPILNO = 0 ;* Added 10/03/2005 - JCH - J.C. Henry & Co.,Inc.
IF XTRLNO = '' THEN XTRLNO = 0 ;* Null numerics give the AS/400 SQL heartburn so load zeroes instead (and give the application heartburn)
IF XTLNO = '' THEN XTRLNO = 0
IF EPIWLN = '' THEN EPIWLN = 0
IF EPIUPR = '' THEN EPIUPR = 0
IF XTCRDT = '' THEN XTCRDT = 0
IF EPICDT = '' THEN EPICDT = 0
IF XTSQTY = '' THEN XTSQTY = 0
HeaderScript := "insert into VUS1CNV.XTI60MF1 VALUES( "
HeaderScript := "'":EPIPCO:"', "
HeaderScript := "'":EPIWHS:"', "
HeaderScript := "'":EPISHN:"', "
HeaderScript := "'":EPIONO:"', "
HeaderScript := EPILNO:", "
HeaderScript := "'":XTONO:"', "
HeaderScript := XTRLNO:", "
HeaderScript := XTLNO:", "
HeaderScript := "'":EPIWON:"', "
HeaderScript := EPIWLN:", "
HeaderScript := "'":XTCSPO:"', "
IF XTPOLN = '' OR XTPOLN = 0 THEN ;* This substitutes the EPI Line No for the Customer PO Line Number when Cust PO Line doesn't exist (Vision expectation)
HeaderScript := EPILNO:", "
END ELSE
HeaderScript := XTPOLN:", "
END
HeaderScript := "'":XTSTCN:"', "
HeaderScript := "'":XTBTCN:"', "
HeaderScript := "'":EPIPTN:"', "
HeaderScript := "'":XTPTNO:"', "
HeaderScript := EPIUPR:", "
HeaderScript := "'":EPIQTN:"', "
HeaderScript := XTCRDT:", "
HeaderScript := EPICDT:", "
HeaderScript := XTSQTY:", "
HeaderScript := "0, " ;* XTRQTY
HeaderScript := "' ', " ;* XTSHTP
HeaderScript := "' ', " ;* XTINNO
HeaderScript := "0, " ;* XTINLN
HeaderScript := "' ', " ;* XTSHID
HeaderScript := "' ', " ;* XTGSHN
HeaderScript := "'":EPIPPN:"', "
HeaderScript := STR("' ', ",10) ;* Trailing blank fields
HeaderScript := "' ')":@VM ;* Last field
XTVLOT = ' '
XTRDSN = ' '
XTSQTY = '1'
XTOLOC = 'FGS'
XTBALT = 'D'
XTRJQT = 0
DetailScript := "insert into VUS1CNV.XTI60MF2 VALUES( "
DetailScript := "'":EPIPCO:"', "
DetailScript := "'":EPIWHS:"', "
DetailScript := "'":EPISHN:"', "
DetailScript := "'":EPIONO:"', "
DetailScript := EPILNO:", "
DetailScript := "'":XTONO:"', "
DetailScript := XTRLNO:", "
DetailScript := XTLNO:", "
DetailScript := "'":EPIPTN:"', "
DetailScript := "' ', " ;* XTSHTP
DetailScript := "'":XTVLOT:"', "
DetailScript := "'":XTRDSN:"', "
DetailScript := XTSQTY:", "
DetailScript := "0, " ;*XTRQTY
DetailScript := "' ', " ;*XTPPFG
DetailScript := "' ', " ;*XTOPKF
DetailScript := "' ', " ;*XTOINF
DetailScript := "' ', " ;*XTOUSE
DetailScript := "'":XTOLOC:"', "
DetailScript := "'":XTBALT:"')":@VM
END
END
NEXT I
END ;* End of check for last shipment on order
END
FOR I = 1 TO COUNT(OrderItemNos,@VM) + (OrderItemNos NE '')
IF OrderItemShippedQtys<1,I> NE '' OR OrderItemRejQtys<1,I> NE '' THEN
OrderItemNo = OrderItemNos<1,I>
OrderDetRec = XLATE('ORDER_DET',OrderNo:'*':OrderItemNo,'','X')
VisionLineNo = FMT(ABS(OrderDetRec<ORDER_DET_VISION_LINE_NO$>),'R(0)#3')
EPIPartNo = OrderDetRec<ORDER_DET_EPI_PN$>
CustPartNo = OrderDetRec<ORDER_DET_CUST_PN$>
IF OrderDetRec<ORDER_DET_UNIT_PRICE$> = '' THEN
UnitPrice = OCONV(0,'MD32')
END ELSE
UnitPrice = OCONV(OrderDetRec<ORDER_DET_UNIT_PRICE$>,'MD32')
END
QuoteNo = OrderDetRec<ORDER_DET_QUOTE_NO$>
CustReqDt = OCONV(OrderDetRec<ORDER_DET_CUST_REQ_DT$>,'[VISION_DT_FORMAT]')
PromiseDt = OCONV(OrderDetRec<ORDER_DET_PROMISE_DT$>,'[VISION_DT_FORMAT]')
ShipLineShipQty = OrderItemShippedQtys<1,I>
ShipLineRejQty = OrderItemRejQtys<1,I>
ItemRDSNos = OrderItemRDSNos<1,I>
IF VisionLineNo = '' THEN VisionLineNo = '0'
IF ShipLineShipQty NE '' THEN
ResultLine += 1 ;* Added 10/29/2005 JCH - J.C. Henry & Co., Inc.
ShipRec<COC_ORDER_ITEM$,ResultLine> = OrderItemNos<1,I>
ShipRec<COC_ITEM_WFR_QTY$,ResultLine> = OrderItemShippedQtys<1,I>
ShipRec<COC_ITEM_MISC_QTY$,ResultLine> = ''
ShipRec<COC_ITEM_UNIT_PRICE$,ResultLine> = OrderDetRec<ORDER_DET_UNIT_PRICE$>
END
EPILNO = OrderItemNo
XTLNO = VisionLineNo
EPIPTN = EpiPartNo
XTPTNO = CustPartNo
EPIUPR = UnitPrice
EPIQTN = QuoteNo
XTCRDT = CustReqDt
EPICDT = PromiseDt
XTSQTY = ShipLineShipQty ;* Inside of loop
XTRJQT = ShipLineRejQty ;* 5/24/2007 JCH
HeaderScript := "insert into VUS1CNV.XTI60MF1 VALUES( "
HeaderScript := "'":EPIPCO:"', "
HeaderScript := "'":EPIWHS:"', "
HeaderScript := "'":EPISHN:"', "
HeaderScript := "'":EPIONO:"', "
HeaderScript := EPILNO:", "
HeaderScript := "'":XTONO:"', "
HeaderScript := XTRLNO:", "
HeaderScript := XTLNO:", "
HeaderScript := "'":EPIWON:"', "
HeaderScript := EPIWLN:", "
HeaderScript := "'":XTCSPO:"', "
IF XTPOLN = '' OR XTPOLN = 0 THEN ;* This substitutes the EPI Line No for the Customer PO Line Number when Cust PO Line doesn't exits (Vision expectation)
HeaderScript := EPILNO:", "
END ELSE
HeaderScript := XTPOLN:", "
END
HeaderScript := "'":XTSTCN:"', "
HeaderScript := "'":XTBTCN:"', "
HeaderScript := "'":EPIPTN:"', "
HeaderScript := "'":XTPTNO:"', "
HeaderScript := EPIUPR:", "
HeaderScript := "'":EPIQTN:"', "
HeaderScript := XTCRDT:", "
HeaderScript := EPICDT:", "
HeaderScript := XTSQTY:", "
HeaderScript := "0, " ;* XTRQTY
HeaderScript := "' ', " ;* XTSHTP
HeaderScript := "' ', " ;* XTINNO
HeaderScript := "0, " ;* XTINLN
HeaderScript := "' ', " ;* XTSHID
HeaderScript := "' ', " ;* XTGSHN
HeaderScript := "'":EPIPPN:"', "
HeaderScript := STR("' ', ",10) ;* Trailing blank fields
HeaderScript := "' ')":@VM ;* Last field
FOR R = 1 TO COUNT(ItemRDSNos,@SVM) + (ItemRDSNos NE '')
RDSNo = ItemRDSNos<1,1,R>
RDSRec = XLATE('RDS',RDSNo,'','X')
IF INDEX(RDSNo,'.',1) THEN
RDSRejQty = 0
RDSTwProd = 0
LotNo = 'L':RDSNo
CONVERT '.' TO '' IN LotNo
WMOutNo = RDSNo
CONVERT '.' TO '*' in WMOutNo
WfrsOut = XLATE('WM_OUT',WMOutNo,'WFRS_OUT','X')
END ELSE
RDSRejQty = XLATE('RDS',RDSNo,'TOT_REJ','X')
RDSTwProd = RDSRec<RDS_TW_PROD$>
LotNo = RDSRec<RDS_LOT_NUM$>[1,12]
WfrsOut = XLATE('RDS',RDSNo,'WFRS_OUT','X')
END
IF Captive OR Consignment THEN
RDSRejQty = 0
END ELSE
RDSRejQty = RDSRejQty + RDSTwProd
END
XTVLOT = LotNo
XTRDSN = RDSNo
XTSQTY = WfrsOut
XTOLOC = 'FGS'
XTBALT = 'D'
DetailScript := "insert into VUS1CNV.XTI60MF2 VALUES( "
DetailScript := "'":EPIPCO:"', "
DetailScript := "'":EPIWHS:"', "
DetailScript := "'":EPISHN:"', "
DetailScript := "'":EPIONO:"', "
DetailScript := EPILNO:", "
DetailScript := "'":XTONO:"', "
DetailScript := XTRLNO:", "
DetailScript := XTLNO:", "
DetailScript := "'":EPIPTN:"', "
DetailScript := "' ', " ;* XTSHTP
DetailScript := "'":XTVLOT:"', "
DetailScript := "'":XTRDSN:"', "
DetailScript := XTSQTY:", "
DetailScript := "0, " ;*XTRQTY
DetailScript := "' ', " ;*XTPPFG
DetailScript := "' ', " ;*XTOPKF
DetailScript := "' ', " ;*XTOINF
DetailScript := "' ', " ;*XTOUSE
DetailScript := "'":XTOLOC:"', "
DetailScript := "'":XTBALT:"')":@VM
NEXT R
IF ShipLineRejQty > 0 THEN
RejectsScript := "insert into VUS1CNV.XTI60MF4 VALUES( "
RejectsScript := "'":EPIPCO:"', "
RejectsScript := "'":EPIWHS:"', "
RejectsScript := "'":EPISHN:"', "
RejectsScript := "'":EPIONO:"', "
RejectsScript := EPILNO:", "
RejectsScript := "'":XTONO:"', "
RejectsScript := XTRLNO:", "
RejectsScript := XTLNO:", "
RejectsScript := XTRJQT:", "
RejectsScript := "' ', " ;* XTSTFG
RejectsScript := "0, " ;* XTPKDT
RejectsScript := "0, " ;* XTPKTM
RejectsScript := "' ')":@VM ;* XTPKUS
END
END ;* End of check for Shipped or Reject Qtys
NEXT I
ShipScript = HeaderScript:DetailScript
IF INDEX(RejectsScript,')',1) THEN
ShipScript := RejectsScript
END
CommandLine = "CALL VUSPE.SHP_PRC_NEW ('":ShipNo:"' , 'fmustha1@irf.com')"
ShipScript := CommandLine
TShipScript = ShipScript
SWAP @VM WITH CRLF$ IN TShipScript
* OSWRITE TShipScript ON 'C:\OIReport\ShpScrpt.TXT' ;* Take this out after startup testing ********************************************************
OSWRITE TShipScript ON Environment_Services('GetReportsRootPath') : '\ShpScrpt.TXT' ;* Take this out after startup testing ********************************************************
Test = Status()
obj_Vision('AddTransaction','SHIPMENT':@RM:ShipScript)
CurrTxCnt = COUNT(ShipRec<COC_SEND_DTM$>,@VM) + (ShipRec<COC_SEND_DTM$> NE '')
NewTxPos = CurrTxCnt + 1
ShipRec<COC_SEND_DTM$,NewTxPos> = SendDtm
ShipRec<COC_SEND_USER$,NewTxPos> = SendUser
ShipRec<COC_SEND_REASON$,NewTxPos> = SendReason
otParms = FIELDSTORE(otParms,@RM,4,0,ShipRec)
*obj_Tables('WriteRec',OtParms)
RETURN