open-insight/LSL2/STPROC/OBJ_SHIPMENT.txt
Infineon\Mitchem 8dce7988c6 Add monitoring for COC file generation and
transmission.

Commit to save progress.

Commit to save progress.

Finished ListDirectory service with full 'mls'
command functionality.

Final commit for COC availability checks.

Implement further changes requested by Daniel.
Add notifications to critical statuses and automatic status clearing.

Change Mona resource from dev to prod.
2024-12-03 09:57:32 -07:00

2216 lines
95 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$
If ShipNo EQ '' then
ShipNo = NextKey('COC')
end else
Logging_Services('AppendLog', objLog, LoggingDTM : @FM : WONo : @FM: ShipNo : @FM : 'Prior shipment number found', @RM, @FM, '')
Retransmit = True$
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.
OrigShipRec = Database_Services('ReadDataRow', 'COC', ShipNo)
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) ;* 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)
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')) ; // 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
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
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
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
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
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
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