open-insight/LSL2/STPROC/OBJ_SHIPMENT.txt
2025-02-20 18:23:06 +01:00

2239 lines
96 KiB
Plaintext

COMPILE FUNCTION obj_Shipment(Method,Parms)
/*
Methods for Shipment (COC) table
02/02/2005 JCH - Initial Coding
11/13/2024 djm - Add MONA monitoring.
Properties:
Methods:
Find() ;* Lookup Order number
Pick(ShipNo) ;* Adds ShipNo to RDS Records
Unpick(ShipNo) ;* Removes ShipNo from RDS Records
*/
#pragma precomp SRP_PreCompiler
Common /OBJ_SHIPMENT/ Debug@
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Dialog_Box, obj_WO_Log, obj_WM_Out, obj_WO_Mat, NextKey, Logging_Services
DECLARE FUNCTION Export_Coa, Export_Cds, Database_Services, Company_Services, RTI_OS_Directory, Error_Services, SRP_Path, RTI_Task_Credentials
DECLARE FUNCTION Export_IR, Export_Tower_Met, obj_Calendar, Error_Services, Environment_Services, RTI_Task_Submit, RTI_Task_Status, SRP_Encode
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, ErrMsg, obj_WO_Step, obj_WO_Log, obj_RDS, Btree.Extract, Yield, Print_Shipment, Print_Shipment_Dev
DECLARE SUBROUTINE obj_Vision, obj_WM_Out, obj_Post_Log, obj_WO_Mat, obj_Notes, obj_Post_Log, obj_Export, ErrMsg, obj_WO_Mat_Log, Error_Services
DECLARE SUBROUTINE obj_Shipment, Logging_Services, FTP_Services, Database_Services, Error_Services, Mona_Services, Shipment_Services
$Insert LOGICAL
$INSERT MSG_EQUATES
$INSERT COMPANY_EQUATES
$INSERT ORDER_EQU
$INSERT ORDER_DET_EQU
$INSERT WO_LOG_EQUATES
$INSERT WO_STEP_EQU
$INSERT WO_MAT_EQUATES
$INSERT COC_EQUATES
$INSERT RDS_EQU
$INSERT PROD_SPEC_EQUATES
$INSERT PART_EQUATES
$INSERT QUOTE_SPEC_EQU
$INSERT NOTIFICATION_EQU
$INSERT FTP_QUEUE_EQUATES
$INSERT SAP_LOG_EQUATES
$INSERT WM_OUT_EQUATES
$INSERT XO_EQUATES
EQU CRLF$ TO \0D0A\
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
ErrTitle = 'Error in Stored Procedure "obj_Shipment"'
ErrorMsg = ''
ErrCode = ''
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 = 'SAPCreate' ; GOSUB SAPCreate
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 Method = 'SendTechnical' ; GOSUB SendTechnical
CASE Method = 'Repost' ; GOSUB Repost
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
* * * * * * *
SAPCreate:
* * * * * * *
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Shipment'
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : '.csv'
Headers = 'Logging DTM' : @FM: 'WorkOrderNo' : @FM : 'ShipNo' : @FM : 'Service Description'
ColumnWidths = 20 : @FM : 15 : @FM : 10 : @FM : 150
objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ' ', Headers, ColumnWidths, False$, False$)
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
FileIn = Parms[1,@RM]
CassCnt = COUNT(FileIn,@FM) + (FileIn NE '')
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS')
TimeStamp = ICONV(CurrDTM,'DT')
WOMap = '' ;* Col 1 = WONo (@VM) Col2 = SAPOrdNo (@VM) Col3 = CassNo (@VM,@SVM) Col4 = SAPBatchNo (@VM,@SVM)
ShipMap = '' ;* Col 1 = ShipNo (@VM) Col2 = SAPDelNo (@VM)
WOMatMap = '' ;* Col 1 = WOMatKey (@VM) Col2 = SAPBatchNo (@VM)
OPEN 'DICT.WO_LOG' TO DictWO ELSE
ErrMsg("Unable to open DICT.WO_LOG' FOR Btree IN obj_SAP('Create' method")
Shipment_Services('SetMONACritical', 'FILE_GENERATION', "Unable to open DICT.WO_LOG' FOR Btree IN obj_SAP('Create' method")
RETURN
END
OPEN 'DICT.WO_MAT' TO DictWOMat ELSE
ErrMsg("Unable to open DICT.WO_MAT' FOR Btree IN obj_SAP('Create' method")
Shipment_Services('SetMONACritical', 'FILE_GENERATION', "Unable to open DICT.WO_MAT' FOR Btree IN obj_SAP('Create' method")
RETURN
End
ErrFields = ''
ErrValues = ''
ErrDescs = ''
ErrCnt = 0
* Build WOMat data structure to group work orders and associated cassette ID's for shipments *
IF NUM(FileIn<1,1>) THEN
FirstLine = 1
END ELSE
FirstLine = 2
END
Server = Environment_Services('GetServer')
FOR I = FirstLine TO CassCnt
SAPDeliveryNo = FileIn<I,1>
ProdOrdNo = FileIn<I,2>
SAPBatchNo = FileIn<I,3>
LOOP
TestChar = SAPDeliveryNo[1,1]
UNTIL TestChar NE 0 OR SAPDeliveryNo = ''
SAPDeliveryNo[1,1] = ''
REPEAT
If SAPDeliveryNo = '' Then
ErrCnt += 1
ErrFields<1,ErrCnt> = 'SAP_DEL_NO'
ErrDescs<1,ErrCnt> = 'Line ':I:' SAP_DEL_NO: ':SAPDeliveryNo:' PROD_ORD_NO: ':ProdOrdNo:' SAP_BATCH_NO: ':SAPBatchNo
ErrValues<1,ErrCnt> = '<null>'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', 'Line ':I:' SAP_DEL_NO: ':SAPDeliveryNo:' PROD_ORD_NO: ':ProdOrdNo:' SAP_BATCH_NO: ':SAPBatchNo)
End
If ProdOrdNo = '' Then
ErrCnt += 1
ErrFields<1,ErrCnt> = 'PROD_ORD_NO'
ErrDescs<1,ErrCnt> = 'Line ':I:' SAP_DEL_NO: ':SAPDeliveryNo:' PROD_ORD_NO: ':ProdOrdNo:' SAP_BATCH_NO: ':SAPBatchNo
ErrValues<1,ErrCnt> = '<null>'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', 'Line ':I:' SAP_DEL_NO: ':SAPDeliveryNo:' PROD_ORD_NO: ':ProdOrdNo:' SAP_BATCH_NO: ':SAPBatchNo)
End
If Trim(ProdOrdNo) _EQC 'NA' then
// This is an uncommon situation that appears to be rooted in the SAP processes. To avoid unnecessary problems in importing the data,
// the ProdOrdNo can be correctly derived from the SAPBatchNo. However, an error will still be set for ongoing monitoring in hopes that
// the original problem will be resolved. - dmb - 01/22/2018
ProdOrdNo = SAPBatchNo[1, '.'] : '.1'
Error_Services('Add', 'SAP Delivery No #' : SAPDeliveryNo : 'imported with ProdOrderNo having a value of "NA".')
Shipment_Services('SetMONACritical', 'FILE_GENERATION', 'SAP Delivery No #' : SAPDeliveryNo : 'imported with ProdOrderNo having a value of "NA".')
end
If SAPBatchNo = '' Then
ErrCnt += 1
ErrFields<1,ErrCnt> = 'SAP_BATCH_NO'
ErrDescs<1,ErrCnt> = 'Line ':I:' SAP_DEL_NO: ':SAPDeliveryNo:' PROD_ORD_NO: ':ProdOrdNo:' SAP_BATCH_NO: ':SAPBatchNo
ErrValues<1,ErrCnt> = '<null>'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', 'Line ':I:' SAP_DEL_NO: ':SAPDeliveryNo:' PROD_ORD_NO: ':ProdOrdNo:' SAP_BATCH_NO: ':SAPBatchNo)
END
LOCATE ProdOrdNo IN WOMap<2> USING @VM SETTING WOPos THEN
WONo = WOMap<1,WOPos>
END ELSE
SearchString = 'PROD_ORD_NO':@VM:ProdOrdNo:@FM
Btree.Extract(SearchString,'WO_LOG',DictWO,WONo,'','') ;* Get WONo from BTREE index on WO_LOG table
If WONo = '' Then
ErrCnt += 1
ErrFields<1,ErrCnt> = 'PROD_ORD_NO'
ErrDescs<1,ErrCnt> = "No Work Order found for ProdOrdNo. Line ":I:" SAP_DEL_NO: ":SAPDeliveryNo:" PROD_ORD_NO: ":ProdOrdNo:" SAP_BATCH_NO: ":SAPBatchNo
ErrValues<1,ErrCnt> = ProdOrdNo
Shipment_Services('SetMONACritical', 'FILE_GENERATION', "No Work Order found for ProdOrdNo. Line ":I:" SAP_DEL_NO: ":SAPDeliveryNo:" PROD_ORD_NO: ":ProdOrdNo:" SAP_BATCH_NO: ":SAPBatchNo)
END
IF INDEX(WONo,@VM,1) Then
ErrWONos = WONo
Swap @VM With ', ' In ErrWONos
ErrCnt += 1
ErrFields<1,ErrCnt> = 'PROD_ORD_NO'
ErrDescs<1,ErrCnt> = "Multiple WO's found ( ":ErrWONos:" ) Line ":I:" SAP_DEL_NO: ":SAPDeliveryNo:" PROD_ORD_NO: ":ProdOrdNo:" SAP_BATCH_NO: ":SAPBatchNo
ErrValues<1,ErrCnt> = ProdOrdNo
Shipment_Services('SetMONACritical', 'FILE_GENERATION', "Multiple WO's found ( ":ErrWONos:" ) Line ":I:" SAP_DEL_NO: ":SAPDeliveryNo:" PROD_ORD_NO: ":ProdOrdNo:" SAP_BATCH_NO: ":SAPBatchNo)
END
WOMap = INSERT(WOMap,1,WOPos,0,WONo)
WOMap = INSERT(WOMap,2,WOPos,0,ProdOrdNo)
WOMap = INSERT(WOMap,3,WOPos,0,'')
WOMap = INSERT(WOMap,4,WOPos,0,'')
END
WOMatCassIDs = XLATE('WO_LOG',WONo,WO_LOG_WO_MAT_KEY$,'X')
WOMatBatchNos = XLATE('WO_MAT',WOMatCassIDs,WO_MAT_SAP_BATCH_NO$,'X')
LOCATE SAPBatchNo IN WOMatBatchNos USING @VM SETTING BPos THEN
CassNo = WOMatCassIDs<1,BPos>[-1,'B*']
END Else
CassNo = ''
ErrCnt += 1
ErrFields<1,ErrCnt> = 'SAP_BATCH_NO'
ErrDescs<1,ErrCnt> = "SAPBatchNo not in WO_MAT Batch Nos for WONo ":WONo:" Line ":I:" SAP_DEL_NO: ":SAPDeliveryNo:" PROD_ORD_NO: ":ProdOrdNo:" SAP_BATCH_NO: ":SAPBatchNo
ErrValues<1,ErrCnt> = SAPBatchNo
Shipment_Services('SetMONACritical', 'FILE_GENERATION', "SAPBatchNo not in WO_MAT Batch Nos for WONo ":WONo:" Line ":I:" SAP_DEL_NO: ":SAPDeliveryNo:" PROD_ORD_NO: ":ProdOrdNo:" SAP_BATCH_NO: ":SAPBatchNo)
END
IF CassNo NE '' THEN
LOCATE CassNo IN WOMap<3,WOPos> USING @SVM SETTING WMPos THEN
NULL ;* This would be a duplicate!
END ELSE
WOMap = INSERT(WOMap,3,WOPos,WMPos,CassNo)
WOMap = INSERT(WOMap,4,WOPos,WMPos,SAPBatchNo)
END
END
NEXT I
* Create a shipment for each Work Order *
WOCnt = COUNT(WOMap<1>,@VM) + (WOMap<1> NE '')
ShipNos = ''
FOR I = 1 TO WOCnt
WONo = WOMap<1,I>
CassNos = WOMap<3,I>
ShipPSN = XLATE('WO_STEP', WONo:'*1', 1, 'X')
ReactType = XLATE('PROD_SPEC', ShipPSN, 80, 'X') ;* Reactor type
// Clean CassNos lists voided cassettes
NonVoidCassNos = ''
If ReactType = 'P' OR ReactType = 'EPP' THEN
// Clean out voided WM_OUT cassettes
NonVoidWMO = ''
For each CassNo in CassNos using @SVM
WMOutKey = WONo:'*1*':CassNo
CurrStatus = Xlate('WM_OUT', WMOutKey, 'CURR_STATUS', 'X')
If CurrStatus _NEC 'VOID' then
NonVoidCassNos<0, 0, -1> = CassNo
end
Next CassNo
end else
// Clean out voided RDS cassettes
NonVoidRDS = ''
For each CassNo in CassNos using @SVM
WOMatKey = WONo:'*':CassNo
RDSKey = Xlate('WO_MAT', WOMatKey, 'RDS_NO', 'X')
CurrStatus = Xlate('RDS', RDSKey, 'COMB_STATUS', 'X')
If CurrStatus _NEC 'VOID' then
NonVoidCassNos<0, 0, -1> = CassNo
end
Next RDSKey
end
CassNos = NonVoidCassNos
NumCass = DCount(CassNos, @SVM)
If (NumCass GT 0) then
WOStepKeys = XLATE('WO_LOG', WONo, WO_LOG_WO_STEP_KEY$, 'X')
ShipWOStepKey = WOStepKeys[-1,'B':@VM] ;* Last Step No on Work Order
ShipPSN = XLATE('WO_STEP',ShipWOStepKey,1,'X') ;* Last PSN used to produce order
ReactType = XLATE('PROD_SPEC',ShipPSN,80,'X') ;* Reactor type
// Check if ShipNo has already been assigned to this RDS or WM_OUT record before generating a new ShipNo.
// This can occur if users ship cassettes prior to receiving a delivery number from SAP.
FirstCassNo = CassNos<1,1,1>
ShipNo = ''
IF ReactType = 'P' OR ReactType = 'EPP' OR ReactType = 'GAN' THEN
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'EpiPro', @RM, @FM, '')
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'First Cass No: ':FirstCassNo, @RM, @FM, '')
ShipNo = Xlate('WO_MAT', WONo:'*':FirstCassNo, 'SHIP_NO', 'X')
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'Ship No: ':ShipNo, @RM, @FM, '')
END ELSE
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'Non-EpiPro', @RM, @FM, '')
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'First Cass No: ':FirstCassNo, @RM, @FM, '')
ShipRDS = Xlate('WO_MAT', WONo:'*':FirstCassNo, 'SHIP_RDS', 'X')
ShipNo = Xlate('RDS', ShipRDS, RDS_SHIP_NO$, 'X')
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'Ship No: ':ShipNo, @RM, @FM, '')
END
Retransmit = False$
Reship = False$
If ShipNo EQ '' then
ShipNo = NextKey('COC')
end else
OrigShipRec = Database_Services('ReadDataRow', 'COC', ShipNo)
If OrigShipRec NE '' then
OrigSAPDeliveryNo = OrigShipRec<COC_SAP_DEL_NO$>
If OrigSAPDeliveryNo _EQC SAPDeliveryNo then
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'Prior shipment number found', @RM, @FM, '')
Retransmit = True$
end else
ShipNo = NextKey('COC')
Reship = True$
end
end
end
//---------------------------------------------------------------------------------------------------
ShipNos<1,I> = ShipNo ;* List of Shipment Numbers created
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'Begin SAPCreate', @RM, @FM, '')
ShipRec = ''
If Retransmit EQ True$ then
// Do not overwrite the original ship date if we are simply retransmitting the COC file.
OrigShipDt = OrigShipRec<COC_SHIP_DT$>
OrigEntryDt = OrigShipRec<COC_ENTRY_DATE$>
If OrigShipDt NE '' then
ShipRec<COC_SHIP_DT$> = OrigShipDt
end else
ShipRec<COC_SHIP_DT$> = Date()
end
If OrigEntryDt NE '' then
ShipRec<COC_ENTRY_DATE$> = OrigEntryDt
end else
ShipRec<COC_ENTRY_DATE$> = Date()
end
end else
ShipRec<COC_SHIP_DT$> = Date()
ShipRec<COC_ENTRY_DATE$> = Date()
end
ShipRec<COC_ENTRY_ID$> = 'SAP'
ShipRec<COC_WO_NO$> = WONo
ShipRec<COC_SAP_DEL_NO$> = SAPDeliveryNo
ShipRec<COC_PICK_BY$> = 'SAP'
ShipRec<COC_PICK_DTM$> = TimeStamp
ShipRec<COC_REACTOR_TYPE$> = ReactType
CassCnt = COUNT(CassNos,@SVM) + (CassNos NE '')
wmlWONos = '' ;* parameters for obj_WO_Mat_Log('Create' call
wmlCassNos = ''
wmlCassIDs = ''
FOR N = 1 TO CassCnt
CassNo = CassNos<1,1,N>
ShipRDS = XLATE('WO_MAT',WONo:'*':CassNo,'SHIP_RDS','X')
ShipWOStep = XLATE('WO_MAT',WONo:'*':CassNo,'SHIP_WO_STEP','X')
ShipRec<COC_CASS_NO$,N> = CassNo
ShipRec<COC_RDS_NO$,N> = ShipRDS
ShipRec<COC_WO_STEP$,N> = ShipWOStep
obj_WO_Mat('AddShip',WONo:'*':CassNo:@RM:ShipNo:@RM:Reship) ;* Adds ShipNo to WO_MAT record
wmlWONos<1,N> = WONo
wmlCassNos<1,N> = CassNo
IF ReactType = 'P' OR ReactType = 'EPP' THEN
WMOutKey = XLATE('WO_MAT',WONo:'*':CassNo,WO_MAT_WMO_KEY$,'X')
obj_WM_Out('AddShip',WMOutKey:@RM:ShipNo:@RM:Reship)
wmlCassIDs<1,N> = 'O':WONo:'.':ShipWOStep:'.':CassNo
END ELSE
obj_RDS('AddShip', ShipNo : @RM : ShipRDS : @RM : Oconv(ShipRec<COC_ENTRY_DATE$>, 'D4/') : @RM : Oconv(Time(), 'MTH'):@RM:Reship) ; // Adds ship data to the RDS row. dmb 01/02/2018
wmlCassIDs<1,N> = ShipRDS
END
NEXT N
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Called AddShip Method', @RM, @FM, '')
OtParms = 'COC':@RM:ShipNo:@RM:@RM:ShipRec
Set_Status(0)
obj_Tables('WriteRec',OtParms)
IF Get_Status(errCode) THEN
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrCode)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : '1. Error = ' : ErrCode, @RM, @FM, '', 'Daniel.Stieber@infineon.com,jonathan.ouellette@infineon.com', LoggingDTM : ' ' : 'WONo = ' : WONo : ', ShipNo = ' : ShipNo : ', Error = ' : ErrCode)
obj_Tables('UnlockRec',OtParms)
END ELSE
Set_Status(0)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Updated COC Record : ' : ShipNo, @RM, @FM, '')
IF Get_Status(errCode) THEN
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrCode)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : '1.1 Error = ' : ErrCode, @RM, @FM, '', 'Daniel.Stieber@infineon.com,jonathan.ouellette@infineon.com', LoggingDTM : ' ' : 'WONo = ' : WONo : ', ShipNo = ' : ShipNo : ', Error = ' : ErrCode)
obj_Tables('UnlockRec',OtParms)
END ELSE
* Queue Shipments for emailing of shipping documents
CustNo = XLATE('COC', ShipNo, 'WO_CUST_NO_EX', 'X')
If CustNo EQ '' then CustNo = XLATE('WO_LOG',WONo,'CUST_NO','X')
eMailShipFlag = XLATE('COMPANY',CustNo,COMPANY_EMAIL_SHIP_DOC$,'X') ;* Flag to Create *.PDF file and eMail to distribution List in Customer EPI record
AutoDataFlag = XLATE('COMPANY',CustNo,COMPANY_AUTO_SHIP_DOC_FLAG$,'X')
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Read Cust Data : CustNo : ' : CustNo : ', eMailShipFlag : ' : eMailShipFlag : ', AutoDataFlag : ' : AutoDataFlag, @RM, @FM, '')
IF eMailShipFlag = 1 THEN
eMailShipRec = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
sqParms = 'SHIP_EMAIL_QUEUE':@RM:ShipNo:@RM:@RM:eMailShipRec
obj_Tables('WriteRec',sqParms)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Updated SHIP_EMAIL_QUEUE Record : ' : ShipNo, @RM, @FM, '')
IF Get_Status(errCode) THEN
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrCode)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : '2. Error = ' : ErrCode, @RM, @FM, '', 'Daniel.Stieber@infineon.com,jonathan.ouellette@infineon.com', LoggingDTM : ' ' : 'WONo = ' : WONo : ', ShipNo = ' : ShipNo : ', Error = ' : ErrCode)
obj_Tables('UnlockRec',sqParms)
END else
Shipment_Services('ClearMONACritical', 'FILE_GENERATION')
end
If AutoDataFlag then
// This customer has the Auto Data flag set. This means the code to produce the data files
// and place them for FTP pickup should be done automatically here rather than expect the user to do
// this manually through the DIALOG_EMAIL_SHIPMENT form. The logic below is essentially a streamlined
// copy of the TxShipments event handler from DIALOG_EMAIL_SHIPMENT.
cocParms = 'COC':@RM:ShipNo
ShipRec = obj_Tables('ReadOnlyRec',cocParms)
If Not(Get_Status(errCode)) then
SendReason = 'Initial Tx (Auto)'
SendDtm = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
SendUser = @User4
Cred = RTI_Task_Credentials('LSL2', 'LSL22022')
TaskID = RTI_Task_Submit('', 'PRINT_SHIPMENT_DEV', ShipNo, ShipRec, 1, True$)
* Print_Shipment_Dev(ShipNo, ShipRec, True$, True$)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Called PRINT_SHIPMENT_DEV Task. TaskID : ' : TaskID, @RM, @FM, '')
If TaskID NE 0 then
Done = False$
TaskResponse = ''
Loop
Status = RTI_Task_Status(TaskID, TaskResponse)
If (Status EQ 'COMPLETED') OR (Status EQ 'ERROR') then
Done = True$
If Status EQ 'ERROR' then
Shipment_Services('SetMONACritical', 'FILE_GENERATION', 'Error generating file for shipment ' : ShipNo)
end else
Shipment_Services('ClearMONACritical', 'FILE_GENERATION')
end
end
Until Done
Repeat
end else
// Track if task id wasn't created at all.
Shipment_Services('SetMONACritical', 'FILE_GENERATION', 'Error generating file for shipment ' : ShipNo)
end
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Finished PRINT_SHIPMENT_DEV Task. Status : ' : Status, @RM, @FM, '')
StatusError = Get_Status(errCode)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' GetStatus PRINT_SHIPMENT_DEV Task. ErrCode : ' : ErrCode, @RM, @FM, '')
If (Index(errCode, 'SHELLEXECUTE', 1)) NE 0 then StatusError = 0
If Not(StatusError) then
CurrTxCnt = COUNT(ShipRec<COC_EMAIL_DTM$>,@VM) + (ShipRec<COC_EMAIL_DTM$> NE '')
NewTxPos = CurrTxCnt + 1
ShipRec<COC_EMAIL_DTM$,NewTxPos> = SendDtm
ShipRec<COC_EMAIL_USER$,NewTxPos> = SendUser
ShipRec<COC_EMAIL_REASON$,NewTxPos> = SendReason
cocParms = FIELDSTORE(cocParms,@RM,4,0,ShipRec)
obj_Tables('WriteOnlyRec',cocParms)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : ' Updated COC Record : ' : ShipNo, @RM, @FM, '')
end else
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : '3. Error = ' : ErrCode, @RM, @FM, '', 'Daniel.Stieber@infineon.com,jonathan.ouellette@infineon.com', LoggingDTM : ' ' : 'WONo = ' : WONo : ', ShipNo = ' : ShipNo : ', Error = ' : ErrCode)
end
end else
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : '4. Error = ' : ErrCode, @RM, @FM, '', 'Daniel.Stieber@infineon.com,jonathan.ouellette@infineon.com', LoggingDTM : ' ' : 'WONo = ' : WONo : ', ShipNo = ' : ShipNo : ', Error = ' : ErrCode)
end
end
END
end
END
* * * * Add call to obj_WO_Mat_Log('Create' to add inventory transaction * * * *
oWMLParms = 'WO_MAT':@RM ;* LogFile
oWMLParms := CurrDTM:@RM ;* Current DTM
oWMLParms := 'SHIP':@RM ;* Action
oWMLParms := 'SR':@RM ;* WhCd = Shipping / Receiving
oWMLParms := 'SB':@RM ;* LocCd = Shipping Bench
oWMLParms := wmlWONos:@RM ;* WONo(s)
oWMLParms := wmlCassNos:@RM ;* CassNos(s)
oWMLParms := 'SAP':@RM ;* User ID
oWMLParms := wmlCassIDs ;* CassIDs (whats on the label in the bar code!)
obj_WO_Mat_Log('Create',oWMLParms)
CustNo = XLATE('WO_LOG',WONo,'CUST_NO','X') ;* T H I S NEEDS to use the RESHIP_CUST_NO which needs derived above
FTPQueueFlag = XLATE('COMPANY',CustNo,COMPANY_SHIP_DATA_FLAG$,'X')
AutoFTPFlag = XLATE('COMPANY',CustNo,COMPANY_AUTO_FTP_FLAG$,'X')
IF FTPQueueFlag = 1 THEN
If AutoFTPFlag then
// This customer has the Auto FTP flag set. This means the code to produce the shipment documents and
// place them for FTP pickup should be done automatically here rather than expect the user to do this
// manually through the DIALOG_FTP_QUEUE form. The logic below is essentially a streamlined copy of
// the TxShipments event handler from DIALOG_FTP_QUEUE.
obj_Shipment('SendTechnical', ShipNo : @RM : True$)
end else
FTPQueueRec = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
fpParms = 'FTP_QUEUE':@RM:ShipNo:@RM:@RM:FTPQueueRec
obj_Tables('WriteRec',fpParms)
IF Get_Status(errCode) THEN
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrCode)
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : '5. Error = ' : ErrCode, @RM, @FM, '', 'Daniel.Stieber@infineon.com,jonathan.ouellette@infineon.com', LoggingDTM : ' ' : 'WONo = ' : WONo : ', ShipNo = ' : ShipNo : ', Error = ' : ErrCode)
obj_Tables('UnlockRec',fpParms)
END else
Shipment_Services('ClearMONACritical', 'FILE_GENERATION')
end
end
END ;* End of check for FTP_QUEUE flag in the COMPANY (Customer) table.
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'End SAPCreate', @RM, @FM, '')
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : '----' : @FM: '' : @FM : '', @RM, @FM, '')
end else
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: 'No cassettes in this work order. No COC generated.', @RM, @FM, '', '', LoggingDTM : ' ' : 'WONo = ' : WONo : ' No cassettes in this work order. No COC generated.')
end
NEXT I
Recipients = XLATE('NOTIFICATION','SHIP_REC',NOTIFICATION_USER_ID$,'X')
SentFrom = @USER4
Subject = 'New Delivery Note Received ':SAPDeliveryNo
Message = 'New Shipments Created.'
AttachWindow = 'SAP_SHIPMENT'
AttachKey = ShipNos
SendToGroup = ''
Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',Parms)
IF ErrFields NE '' THEN
LogNo = NextKey('SAP_LOG')
LogRec = ''
LogRec<SAP_LOG_TIMESTAMP$> = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
LogRec<SAP_LOG_LOG_DESC$> = 'Error during SAP Shipment creation.'
LogRec<SAP_LOG_PROD_ORD_NO$> = WONo:'*':CassNo
LogRec<SAP_LOG_FIELD_NAME$> = ErrFields
LogRec<SAP_LOG_ERR_DESC$> = ErrDescs
LogRec<SAP_LOG_SAP_VALUE$> = ErrValues
logParms = 'SAP_LOG':@RM:LogNo:@RM:@RM:LogRec
obj_Tables('WriteRec',logParms)
Message = 'Batch ID error from SAP':CRLF$:CRLF$
fCnt = Count(ErrFields,@VM) + (ErrFields NE '')
For N = 1 To fCnt
Message := FMT(ErrFields<1,N>, "L#20")' ':FMT(ErrValues<1,N>, "L#20"):' ':ErrDescs<1,N>:CRLF$
Next I
Recipients = Xlate('SEC_GROUPS', 'SAP_ADMIN', 'USER', 'X')
SentFrom = "SAP Posting Process"
Subject = 'SAP Error Logged ':LogNo
AttachWindow = 'SAP_LOG'
AttachKey = LogNo
SendToGroup = ''
Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',Parms)
Error_Services('Add', 'One or more errors occured within the SAPCreate method.')
END
Result = 1 ;* Set to 1 if we were successful in creating the Shipment (COC) Record
RETURN
* * * * * * *
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 = ''
WONo = thisShipRec<COC_WO$>
WOCassNos = thisShipRec<COC_CASS_NO$>
IF RDSNos = '' THEN
WOStepNos = thisShipRec<COC_WO_STEP$>
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 OrderItemNo IN OrderItemNos USING @VM SETTING Pos ELSE
OrderItemNos = INSERT(OrderItemNos,1,Pos,0,OrderItemNo)
END
NEXT I
END ELSE
CassCnt = COUNT(WOCassNos,@VM) + (WOCassNos NE '')
FOR I = 1 TO CassCnt
WOMatKey = WONo:'*':WOCassNos<1,I>
OrderItemNo = XLATE('WO_MAT',WOMatKey,WO_MAT_ORDER_ITEM$,'X')
LOCATE OrderItemNo IN OrderItemNos USING @VM SETTING Pos ELSE
OrderItemNos = INSERT(OrderItemNos,1,Pos,0,OrderItemNo)
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
WONo = thisShipRec<COC_WO$>
WOCassNos = thisShipRec<COC_CASS_NO$>
GOSUB OrdItemNos
OrderItems = Result
Result = ''
CassCnt = COUNT(WOCassNos,@VM) + (WOCassNos NE '')
FOR I = 1 TO CassCnt
WOMatKEy = WONo:'*':WOCassNos<1,I>
WOMatRec = XLATE('WO_MAT',WOMatKey,'','X')
OrderItem = WOMatRec<WO_MAT_ORDER_ITEM$>
CurrWfrCnt = obj_WO_Mat('CurrWaferCnt',WOMatKey:@RM:WOMatRec:@RM:1)
LOCATE OrderItem IN OrderItems USING @VM SETTING Pos THEN
Result<1,Pos> = Result<1,Pos> + CurrWfrCnt
END ELSE
Result = INSERT(Result,1,Pos,0,CurrWfrCnt)
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
WONo = thisShipRec<COC_WO$>
WOCassNos = thisShipRec<COC_CASS_NO$>
ShipOrdItemNos = ''
ShipOrdItmRejQty = ''
CassCnt = COUNT(WOCassNos,@VM) + (WOCassNos NE '')
FOR I = 1 TO CassCnt
WOMatKey = WONo:'*':WOCassNos<1,I>
WOMatRec = XLATE('WO_MAT',WOMatKey,'','X')
CassOrdItemNo = WOMatRec<WO_MAT_ORDER_ITEM$>
CassRejQty = XLATE('WO_MAT',WOMatKey,'CURR_WFR_CNT_REJ','X')
LOCATE CassOrdItemNo IN ShipOrdItemNos USING @VM SETTING Pos THEN
Result<1,Pos> = Result<1,Pos> + CassRejQty
END ELSE
ShipOrdItemNos = INSERT(Result,1,Pos,0,CassOrdItemNO)
Result = INSERT(Result,1,Pos,0,CassRejQty)
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
WONo = thisShipRec<COC_WO$>
WOCassNos = thisShipRec<COC_CASS_NO$>
ShipOrdItemNos = ''
ShipOrdItmRejQty = ''
CassCnt = COUNT(WOCassNos,@VM) + (WOCassNos NE '')
FOR I = 1 TO CassCnt
WOMatKey = WONo:'*':WOCassNos<1,I>
WOMatRec = XLATE('WO_MAT',WOMatKey,'','X')
CassOrdItemNo = WOMatRec<WO_MAT_ORDER_ITEM$>
CassRejQty = XLATE('WO_MAT',WOMatKey,'TW_PROD','X')
LOCATE CassOrdItemNo IN ShipOrdItemNos USING @VM SETTING Pos THEN
Result<1,Pos> = Result<1,Pos> + CassRejQty
END ELSE
ShipOrdItemNos = INSERT(Result,1,Pos,0,CassOrdItemNO)
Result = INSERT(Result,1,Pos,0,CassRejQty)
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(),'MTS') ;* 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 NE '' THEN
PickedWOMatKeys = ''
FOR I = 1 TO LineCnt
WOCassNo = WOCassNos<1,I>
IF WOCassNo NE '' THEN
WOMatKey = WONo:'*':WOCassNo
obj_WO_Mat('AddShip',WOMatKey:@RM:ShipNo) ;* 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(PickedWOMatKeys,@VM) + (PickedWOMatKeys NE '')
PickedWOMatKey = PickedWOMatKeys<1,N>
obj_WO_Mat('RemShip',PickedWOMatKey:@RM:ShipNo) ;* Back out Ship Info already added
NEXT N
obj_Tables('UnlockRec',OtParms) ;* Unlock the Shipment record
RETURN
END ELSE
PickedWOMatKeys<1,-1> = WOMatKey
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(),'MTS'),'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(),'MTS') ;* 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
UnPickedWOMatKeys = ''
FOR I = 1 TO LineCnt
WOCassNo = WOCassNos<1,I>
IF WOCassNo NE '' THEN
WOMatKey = WONo:'*':WOCassNo
obj_WO_Mat('RemShip',WOMatKey:@RM:ShipNo)
IF Get_Status(errCode) THEN
ErrMsg(errCode) ;* Problem UnPicking
FOR N = 1 TO COUNT(UnPickedWOMatKeys,@VM) + (UnPickedWOMatKeys NE '')
UnPickedWOMatKey = UnPickedWOMatKeys<1,N>
obj_WO_Mat('AddShip',UnPickedWOMatKey:@RM:ShipNo) ;* Back out Ship Info already added
NEXT N
obj_Tables('UnlockRec',OtParms) ;* Unlock the Shipment record
RETURN
END ELSE
UnPickedWOMatKeys<1,-1> = WOMatKey
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 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>
* This section copied from OrderItems method 7/29/2008
InCassIDs = obj_WM_Out('InCassData',WorkOrderNo:'*':WOStepNo:'*':WOCassNo)<1> ;* Inbound cassette IDs (Includes Makeups)
LOOP
InCassID = InCassIDs[1,@VM]
InCassIDs[1,COL2()] = ''
InWONo = InCassID[1,'*']
UNTIL InWONo = WorkOrderNo OR InCassIDS = ''
REPEAT
OrderItem = XLATE('WO_MAT',InCassID,WO_MAT_ORDER_ITEM$,'X')
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
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> = OrderDetRec<ORDER_DET_ITEM_QTY$> ;* Changed from '1' 11/24/2008 JCH - J.C. Henry & Co., Inc.
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
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'
IF OrderType = 'MERCHANT' THEN
XTOLOC = 'FGS'
END ELSE
XTOLOC = 'PACKING'
END
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:"', "
DetailScript := "' ')":@VM ;*XTSPLD
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
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>
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')
CassNo = FIELD(WMOutNo,'*',3)
END ELSE
RDSRec = XLATE('RDS',RDSNo,'','X')
CassNo = RDSRec<RDS_CASS_NO$>
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
WOMatKey = WorkOrderNo:'*':CassNo ;* Added 7/21/2008 JCH
XTSPLD = XLATE('WO_MAT',WOMatKey,'SUB_SUPP_CD','X') ;* Added 7/21/2008 JCH
IF Captive OR Consignment THEN
RDSRejQty = 0
END ELSE
RDSRejQty = RDSRejQty + RDSTwProd
END
XTVLOT = LotNo
XTRDSN = RDSNo
XTSQTY = WfrsOut
IF OrderType = 'MERCHANT' THEN
XTOLOC = 'FGS'
END ELSE
XTOLOC = 'PACKING'
END
XTBALT = 'D'
XTRJQT = RDSRejQty
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:"', "
DetailScript := "'":XTSPLD:"')":@VM
NEXT R
IF ShipLineRejQty > 0 THEN
XTRJQT = ShipLineRejQty
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
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
* * * * * * *
SendTechnical:
* * * * * * *
FTPLogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Shipment_FTP'
FTPLogDate = Oconv(Date(), 'D4/')
FTPLogTime = Oconv(Time(), 'MTS')
FTPLogFileName = FTPLogDate[7, 4] : '-' : FTPLogDate[1, 2] : '-' : FTPLogDate[4, 2] : '.csv'
FTPHeaders = 'Logging DTM' : @FM: 'Customer' : @FM : 'ShipNo' : @FM : 'Service Description'
FTPColumnWidths = 20 : @FM : 15 : @FM : 10 : @FM : 150
FTPobjLog = Logging_Services('NewLog', FTPLogPath, FTPLogFileName, CRLF$, ' ', FTPHeaders, FTPColumnWidths, False$, False$)
FTPLoggingDTM = FTPLogDate : ' ' : FTPLogTime ; // Logging DTM
IF Not(Assigned(ShipNo)) THEN
ShipNo = Parms[1,@RM]
AutoFlag = Parms[Col2() + 1, @RM]
END
IF ShipNo = '' THEN
ErrorMsg = 'Null parameter "ShipNo" passed to routine. (':Method:')'
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
RETURN
END
OtParms = 'COC':@RM:ShipNo
ShipRec = obj_Tables('ReadOnlyRec',OtParms)
If ShipRec EQ '' then
ErrorMsg = 'Invalid "ShipNo" passed to routine. ShipRec does not exist. (':Method:')'
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
RETURN
end
ShipDt = ShipRec<COC_SHIP_DT$>
If ShipDt NE '' then
SendDate = OCONV(ShipDt, 'D4-')
end else
SendDate = OCONV(Date(), 'D4-')
end
IF Get_Status(errCode) THEN RETURN
ReactType = ShipRec<COC_REACTOR_TYPE$>
RDSNos = ShipRec<COC_RDS_NO$>
IF ShipRec<COC_SEND_DTM$> NE '' THEN
SendReason = Msg(@WINDOW,'','RESEND_REASON') ;* This has already been sent
IF SendReason = CHAR(27) OR SendReason = '' THEN
RETURN
END
END ELSE
SendReason = 'Initial Tx'
If AutoFlag EQ True$ then SendReason := ' (Auto)'
END
SendDtm = ICONV(OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTS'),'DT')
SendUser = @USER4
WorkOrderNo = ShipRec<COC_WO_NO$>
WORec = XLATE('WO_LOG',WorkOrderNo,'','X')
CustNo = Xlate('COC', ShipNo, 'WO_CUST_NO_EX', 'X')
StandardCOA = Xlate('COMPANY', CustNo, 'STANDARD_COA', 'X')
*Looks at first RDS and sees if it is has any second layer Metrology keys
IsMultiLayer = XLATE('REACT_RUN',RDSNos<1,1>,'MET_KEYS_L2','X')[1,@VM]
SentFlag = 0
SendErrorMsg = ''
Server = Environment_Services('GetServer')
IF Server EQ 'MESST5202' OR Server EQ 'MESST5201' then Server = 'MESSA01EC'
LoggingErrMsg = ''
//Default
If StandardCOA then
KeyList = RDSNos
SentFlag = 1
FTPSettings = Company_Services('GetFTPServer', CustNo);//this is new
FTPHost = FTPSettings<1>;//this is new
Username = FTPSettings<2>;//this is new
Password = FTPSettings<3>;//this is new
CustPath = Environment_Services('GetApplicationRootPath') : '\Ship_Data\' : CustNo : '\'
RemoteDirectory = '/' : FTPSettings<5>;//this is new
SSH = FTPSettings<6>;//this is new
ScriptPath = CustPath : 'FTPTransfer.scr'
DeleteScript = False$
IF FTPHost EQ '' then
LoggingErrMsg = 'Missing FTP Host in COMPANY record for ' : CustNo : '. Shipment #': ShipNo
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
end
IF RemoteDirectory EQ '' then
LoggingErrMsg = 'Missing FTP Directory in COMPANY record for ' : CustNo : '. Shipment #': ShipNo
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
end
IF RTI_OS_Directory( "EXISTS", CustPath ) NE True$ AND LoggingErrMsg EQ '' then
successful = RTI_OS_Directory("CREATE", CustPath)
If successful NE True$ then
LoggingErrMsg = 'Unable to create shipment directory for ' : CustNo : '. Shipment #': ShipNo
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end
IF LoggingErrMsg EQ '' then
If ReactType Eq 'EPP' AND StandardCOA then
//EpiPro
LocalFile = Export_Coa(ShipNo,AutoFlag,CustPath)
LocalFileCDS = Export_Cds(ShipNo,AutoFlag, CustPath)
end else
//All other Reactor Types
IF StandardCOA then
LocalFile = CustPath : ShipNo:'+': SendDate : '+SHIPMENT.csv'
if IsMultiLayer NE '' Then
ExportID = 'COA_STANDARD_MULTI'
NoHeader = 0
end else
ExportID = "COA_STANDARD"
NoHeader = 0
end
end else
end
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:LocalFile:@RM:@RM:@RM:NoHeader:@RM:1, AutoFlag)
end
IF SRP_Path("Exists", LocalFile) then
FTP_Services('PostRequest', 'put', FTPHost, Server, LocalFile, '', Username, Password, CustPath, RemoteDirectory, RemoteFile, ScriptPath, DeleteScript, SSH, '', 3, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end else
LoggingErrMsg = 'Unable to send CSV COA via FTP for customer ' : CustNo : '. Shipment #': ShipNo :'. File was not found in the expected location'
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
If ReactType Eq 'EPP' then
IF SRP_Path("Exists", LocalFileCDS) then
FTP_Services('PostRequest', 'put', FTPHost, Server, LocalFileCDS, '', Username, Password, LocalDirectory, RemoteDirectory, RemoteFile, ScriptPath, DeleteScript, SSH, '', 3, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end else
LoggingErrMsg = 'Unable to send CSV COA CDS via FTP for customer ' : CustNo : '. Shipment #': ShipNo :'. File was not found in the expected location'
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
end
end else
LoggingErrMsg = 'Unable to send CSV COA via FTP for customer ' : CustNo : '. Shipment #': ShipNo
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
end else
Begin Case
Case CustNo EQ '6593' OR CustNo EQ '408' OR CustNo EQ '7076'
* This is Temecula & El Segundo -> transmit via ftp
KeyList = RDSNos
SentFlag = 1
IF KeyList = '' THEN
ErrorMsg = 'There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrorMsg)
LogData = ''
LogData<1> = LoggingDTM
LogData<2> = CustNo
LogData<3> = ShipNo
LogData<4> = ErrorMsg
Logging_Services('AppendLog', FTPobjLog, LogData, @RM, @FM)
obj_Tables('UnlockRec',OtParms)
RETURN
END
CustPath = Environment_Services('GetApplicationRootPath') : '\Ship_Data\' : CustNo : '\'
IF RTI_OS_Directory( "EXISTS", CustPath ) NE True$ then
successful = RTI_OS_Directory("CREATE", CustPath)
If successful NE True$ then
null
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end
DosTable = Export_IR(ShipNo, AutoFlag, CustPath)
Host = '10.72.176.48'
LocalFile = DosTable
Username = 'Infineon\TEMFTPEPIMesa'
Password = 'fW&EHJhKWg!skUKV4_34'
LocalDirectory = ''
RemoteDirectory = '\TEMFTP_EPIMesa\Archive'
RemoteFile = ''
ScriptPath = CustPath : 'ToTemeculacsv.scr'
DeleteScript = False$
SSH = False$
IF SRP_Path("Exists", LocalFile) then
FTP_Services('PostRequest', 'put', Host, Server, LocalFile, '', Username, Password, LocalDirectory, RemoteDirectory, RemoteFile, ScriptPath, DeleteScript, SSH, '', 3, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end else
LoggingErrMsg = 'Unable to send CSV COA via FTP for customer ' : CustNo : '. Shipment #': ShipNo :'. File was not found in the expected location'
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
Case CustNo EQ '6775'
KeyList = RDSNos
SentFlag = 1
IF KeyList = '' THEN
ErrorMsg = 'There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrorMsg)
LogData = ''
LogData<1> = LoggingDTM
LogData<2> = CustNo
LogData<3> = ShipNo
LogData<4> = ErrorMsg
Logging_Services('AppendLog', FTPobjLog, LogData, @RM, @FM)
obj_Tables('UnlockRec',OtParms)
SentFlag = 0
RETURN
END
CustPath = Environment_Services('GetApplicationRootPath') : '\Ship_Data\' : CustNo : '\'
IF RTI_OS_Directory( "EXISTS", CustPath ) NE True$ then
successful = RTI_OS_Directory("CREATE", CustPath)
If successful NE True$ then
null
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end
DosTable = CustPath : ShipNo:'.csv'
ExportID = 'VIS_SYSTEM_RDS_DATA'
ExportExists = XLATE('EXPORTS', ExportID, '', 'X')
If ExportExists then
NoHeader = 1
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:DosTable:@RM:@RM:@RM:NoHeader, AutoFlag)
Host = 'sFTPNA.extra.infineon.com'
LocalFile = DosTable
Username = 'DNAMesaFI-FTP'
Password = 'OpenInsight2018....!'
LocalDirectory = '\apps\Ship_Data'
RemoteDirectory = '/Tower'
RemoteFile = ''
ScriptPath = CustPath : 'ToTowercsv.scr'
DeleteScript = False$
SSH = True$ = Error_Services('GetMessage')
IF SRP_Path("Exists", LocalFile) then
FTP_Services('PostRequest', 'put', Host, Server, LocalFile, '', Username, Password, LocalDirectory, RemoteDirectory, RemoteFile, ScriptPath, DeleteScript, SSH, '', 3, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end else
LoggingErrMsg = 'Unable to send CSV COA via FTP for customer ' : CustNo : '. Shipment #': ShipNo :'. File was not found in the expected location'
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
end else
LoggingErrMsg = 'Export ' : ExportID: ' does not exist for customer ' : CustNo : '. Shipment #': ShipNo
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
Case CustNo EQ '7053' OR CustNo EQ '7092'
KeyList = RDSNos
IF KeyList = '' THEN
ErrorMsg = 'There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', ErrorMsg)
LogData = ''
LogData<1> = LoggingDTM
LogData<2> = CustNo
LogData<3> = ShipNo
LogData<4> = ErrorMsg
Logging_Services('AppendLog', FTPobjLog, LogData, @RM, @FM)
obj_Tables('UnlockRec',OtParms)
RETURN
END
CustPath = Environment_Services('GetApplicationRootPath') : '\Ship_Data\' : CustNo : '\'
IF RTI_OS_Directory( "EXISTS", CustPath ) NE True$ then
successful = RTI_OS_Directory("CREATE", CustPath)
If successful NE True$ then
null
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end
DosTable = CustPath :ShipNo:'.csv'
ExportID = 'VIS_SYSTEM_RDS_DATA'
ExportExists = XLATE('EXPORTS', ExportID, '', 'X')
IF ExportExists then
NoHeader = 1
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:DosTable:@RM:@RM:@RM:NoHeader, AutoFlag)
Host = 'sFTPNA.extra.infineon.com'
LocalFile = DosTable
Username = 'DNAMesaFI-FTP'
Password = 'OpenInsight2018....!'
LocalDirectory = '\apps\Ship_Data'
RemoteDirectory = '/Tower'
RemoteFile = ''
ScriptPath = CustPath : 'ToTowercsv.scr'
DeleteScript = False$
SSH = True$
IF SRP_Path("Exists", LocalFile) then
FTP_Services('PostRequest', 'put', Host, Server, LocalFile, '', Username, Password, LocalDirectory, RemoteDirectory, RemoteFile, ScriptPath, DeleteScript, SSH, '', 3, False$)
If Error_Services('HasError') then
ErrorMsg = Error_Services('GetMessage')
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', ErrorMsg)
end else
Shipment_Services('ClearMONACritical', 'FILE_TRANSMISSION')
end
end else
LoggingErrMsg = 'Unable to send CSV COA via FTP for customer ' : CustNo : '. Shipment #': ShipNo :'. File was not found in the expected location'
Shipment_Services('SetMONACritical', 'FILE_GENERATION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
end else
LoggingErrMsg = 'Export ' : ExportID: ' does not exist for customer ' : CustNo : '. Shipment #': ShipNo
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
Recipients = XLATE('NOTIFICATION','COC_DELIVERY',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'COC Generation Failure.'
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
MessageParms = Recipients:@RM:SendFrom:@RM:Subject:@RM:LoggingErrMsg:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',MessageParms)
end
Case 1
LoggingErrMsg = 'Shipment settings do not exist for customer ' : CustNo : '. Shipment #': ShipNo
Shipment_Services('SetMONACritical', 'FILE_TRANSMISSION', LoggingErrMsg)
Logging_Services('AppendLog', FTPobjLog, FTPLoggingDTM : @FM : CustNo : @FM: ShipNo : @FM : LoggingErrMsg, @RM, @FM, '')
SentFlag = 0
End Case
end
* * * * * * *
Done_with_Transmit:
* * * * * * *
IF SentFlag = 1 THEN
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)
END ELSE
obj_Tables('UnlockRec',OtParms)
END
RETURN
* * * * * * *
Repost:
* * * * * * *
ShipNo = Parms[1,@RM]
ShipRec = Parms[COL2()+1,@RM]
IF ShipNo = '' THEN RETURN
IF ShipRec = '' THEN
ShipRec = XLATE('COC',ShipNo,'','X')
IF ShipRec = '' THEN RETURN
END
WONo = ShipRec<COC_WO_NO$>
StepNos = ShipRec<COC_WO_STEP$>
CassNos = ShipRec<COC_CASS_NO$>
wmlWONos = '' ;* parameters for obj_WO_Mat_Log('Create' call
wmlCassNos = ''
wmlCassIDs = ''
CassCnt = COUNT(CassNos,@VM) + (CassNos NE '')
FOR I = 1 TO CassCnt
StepNo = StepNos<1,I>
CassNo = CassNos<1,I>
WOMatKey = WONo:'*':CassNo
WOMatRec = XLATE('WO_MAT',WOMatKey,'','X')
IF WOMatRec<WO_MAT_SHIP_NO$> = '' OR WOMatRec<WO_MAT_SHIP_NO$> NE ShipNo THEN
obj_WO_Mat('AddShip',WOMatKey:@RM:ShipNo)
IF Get_Status(errCode) THEN
END
END
WMOutKey = WOMatRec<WO_MAT_WMO_KEY$>
ShipDTM = OCONV(ShipRec<COC_PICK_DTM$>,'DT4/^S')
LOCATE 'SHIP' IN WOMatRec<WO_MAT_INV_ACTION$> USING @VM SETTING Pos ELSE
wmlWONos<1,-1> = WONo
wmlCassNos<1,-1> = CassNo
IF WMOutKey NE '' THEN
obj_WM_Out('AddShip',WMOutKey:@RM:ShipNo)
wmlCassIDs<1,-1> = 'O':WONo:'.':StepNo:'.':CassNo
END ELSE
wmlCassIDs<1,-1> = WOMatRec<WO_MAT_RDS_NO$>[-1,'B':@VM] ;* Ship RDS No
END
END ;* End of check for SHIP inventory log entry
NEXT I
IF WmlCassNos NE '' THEN
oWMLParms = 'WO_MAT':@RM ;* LogFile
oWMLParms := ShipDTM:@RM ;* Use PickDTM from shipment record
oWMLParms := 'SHIP':@RM ;* Action
oWMLParms := 'SR':@RM ;* WhCd = Shipping / Receiving
oWMLParms := 'SB':@RM ;* LocCd = Shipping Bench
oWMLParms := wmlWONos:@RM ;* WONo(s)
oWMLParms := wmlCassNos:@RM ;* CassNos(s)
oWMLParms := 'SAP':@RM ;* User ID
oWMLParms := wmlCassIDs ;* CassIDs (whats on the label in the bar code!)
obj_WO_Mat_Log('Create',oWMLParms)
IF Get_Status(errCode) THEN ErrMsg(errCode)
END
RETURN