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