COMPILE FUNCTION Comm_Shipment(Instruction, Parm1,Parm2)
#pragma precomp SRP_PreCompiler
/*
Commuter module for Shipment (COC) window
02/02/2005 - John C. Henry, J.C. Henry & Co., Inc. (Happy Ground Hog's day)
*/
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, Set_List_Box_Data, Print_Shipment, Print_Carton_Labels
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, obj_Shipment, Print_Ship_CheckList,Print_Pallet_Labels
DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window,Print_Cass_Ship_Label, Print_COC_Back, Print_Packing_Slip, Print_CoC_Invoice
DECLARE SUBROUTINE obj_Invoice, obj_Export, Print_Comm_Invoice
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Popup, Collect.Ixvals, obj_RDS, ETMethod, Export_Tower_Met, Export_IR
DECLARE FUNCTION Send_Message, Msg, Security_Check, RowExists, NextKey, obj_Shipment, obj_WO_Log, Set_Printer, obj_Install, MemberOf, Environment_Services
$INSERT POPUP_EQUATES
$INSERT LOGICAL
$INSERT MSG_EQUATES
$INSERT APPCOLORS
$INSERT COC_EQUATES
$INSERT LSL_USERS_EQU
$INSERT SECURITY_RIGHTS_EQU
$INSERT WO_LOG_EQU
$INSERT WO_STEP_EQU
$INSERT COMPANY_EQU
$INSERT ORDER_EQU
$INSERT OIPRINT_EQUATES
EQU COL$WO_STEP TO 1
EQU COL$CASS_NO TO 2
EQU COL$RDS_NO TO 3
EQU COL$RDS_LOT_NO TO 4
EQU COL$RDS_PART_NO TO 5
EQU COL$RDS_SCHED TO 6
EQU COL$RDS_PTEST TO 7
EQU COL$RDS_REJECT TO 8
EQU COL$RDS_OUT TO 9
EQU COL$RDS_HOT_LOT TO 10
EQU COL$RDS_CURR_STATUS TO 11 ;* OCONV'd status
EQU COL$RDS_STAT_CD TO 12 ;* Internal status
EQU PI$LEFT TO 1 ;* Page info stuff until I can get the printing routines cleaned up
EQU PI$TOP TO 2
EQU PI$RIGHT TO 3
EQU PI$BOTTOM TO 4
EQU PI$WIDTH TO 5
EQU PI$HEIGHT TO 6
EQU PI$SIZE TO 7
ErrTitle = 'Error in Comm_Shipment'
ErrorMsg = ''
Result = ''
BEGIN CASE
CASE Instruction = 'Create' ; GOSUB Create
CASE Instruction = 'Refresh' ; GOSUB Refresh
CASE Instruction = 'Read' ; GOSUB Read
CASE Instruction = 'Write' ; GOSUB Write
CASE Instruction = 'Clear' ; GOSUB Clear
CASE Instruction = 'Delete' ; GOSUB Delete
CASE Instruction = 'Page' ; GOSUB Page
CASE Instruction = 'Close' ; GOSUB Close
CASE Instruction = 'LUShipNo' ; GOSUB LUShipNo
CASE Instruction = 'ShipNoLF' ; GOSUB ShipNoLF
CASE Instruction = 'ShippingWOS' ; GOSUB ShippingWOS
CASE Instruction = 'NewShipment' ; GOSUB NewShipment
CASE Instruction = 'TodaysShipments' ; GOSUB TodaysShipments
CASE Instruction = 'ActiveShipments' ; GOSUB ActiveShipments
CASE Instruction = 'NewViewInvoice' ; GOSUB NewViewInvoice
CASE Instruction = 'LUShipVia' ; GOSUB LUShipVia
CASE Instruction = 'ShipViaGF' ; GOSUB ShipViaGF
CASE Instruction = 'WONoLF' ; GOSUB WONoLF
CASE Instruction = 'RDSDetailDC' ; GOSUB RDSDetailDC
CASE Instruction = 'SelectCassettes' ; GOSUB SelectCassettes
CASE Instruction = 'ScanCassettes' ; GOSUB ScanCassettes
CASE Instruction = 'Pick' ; GOSUB Pick
CASE Instruction = 'Unpick' ; GOSUB Unpick
CASE Instruction = 'ViewBillCust' ; GOSUB ViewBillCust
CASE Instruction = 'ViewOrder' ; GOSUB ViewOrder
CASE Instruction = 'ViewWO' ; ; GOSUB ViewWO
CASE Instruction = 'PrintCassLabel' ; GOSUB PrintCassLabel
CASE Instruction = 'PrintCheck' ; GOSUB PrintCheck
CASE Instruction = 'PrintPackingList' ; GOSUB PrintPackingList
CASE Instruction = 'PrintDocuments' ; GOSUB PrintDocuments
CASE Instruction = 'PrintPalletLabels' ; GOSUB PrintPalletLabels
CASE Instruction = 'PrintCartonLabels' ; GOSUB PrintCartonLabels
CASE Instruction = 'PrintCoCInvoice' ; GOSUB PrintCoCInvoice
CASE Instruction = 'PrintCommInvoice' ; GOSUB PrintcommInvoice
CASE Instruction = 'SendToVision' ; GOSUB SendToVision
CASE Instruction = 'VtsDel' ; GOSUB VtsDel
CASE Instruction = 'VtsIns' ; GOSUB VtsIns
CASE Instruction = 'ReTxTechData' ; GOSUB ReTxTechData
CASE 1
ErrorMsg = 'Unknown Instruction ':QUOTE(Instruction):' passed to routine.'
ErrMsg(ErrorMsg)
END CASE
RETURN Result
* * * * * * *
Create:
* * * * * * *
IF NOT(Security_Check('COC',READ$)) THEN
Security_Err_Msg('COC',READ$)
End_Window(@WINDOW)
RETURN
END
obj_Appwindow('Create',@WINDOW)
* Provides compatibility with the existing messaging attachment system
IF Parm1 NE '' THEN
PassedKeys = FIELD(Parm1,'*',1)
obj_Appwindow('ViewRelated',@WINDOW:@RM:PassedKeys)
END
GOSUB Refresh
RETURN
* * * * * * *
Clear:
* * * * * * *
Send_Event(@WINDOW,'PAGE',1)
* * * * * * *
Refresh:
* * * * * * *
IF Security_Check('COC',EDIT$) AND (Get_Property(@WINDOW:'.PICK_BUTTON','TEXT') = 'Pick') THEN
Set_Property(@WINDOW:'.RDS_DETAIL','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.RDS_DETAIL','ENABLED',0)
END
Invoiced = ''
IF Get_Property(@WINDOW:'.INVOICE_NO','TEXT') = '' THEN Invoiced = 0 ELSE Invoiced = 1
IF NOT(Invoiced) THEN
obj_Appwindow('ReadOnly',@WINDOW:@RM:1) ;* Clear Read Only
END ELSE
obj_Appwindow('ReadOnly',@WINDOW) ;* Set window to read only
END
WindowTitle = Get_Property(@WINDOW,'TEXT')
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF INDEX(WindowTitle,'New',1) OR ShipNo = '' THEN
Set_Property(@WINDOW:'.WO_NO','ENABLED',1)
Set_Property(@WINDOW:'.WO_NO','BACKCOLOR',WHITE$)
END ELSE
Set_Property(@WINDOW:'.WO_NO','ENABLED',0)
Set_Property(@WINDOW:'.WO_NO','BACKCOLOR',GREEN$)
END
IF Get_Property(@WINDOW:'.INVOICE_NO','TEXT') = '' THEN
Set_Property(@WINDOW:'.INVOICE_BUTTON','TEXT','New Invoice')
END ELSE
Set_Property(@WINDOW:'.INVOICE_BUTTON','TEXT','View Invoice')
END
Ctrls = @WINDOW:'.PICK_BUTTON':@RM ; Props = 'TEXT':@RM
Ctrls := @WINDOW:'.PICK_BUTTON':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.PICKED_FIX':@RM ; Props := 'VISIBLE':@RM
Ctrls := @WINDOW:'.UNPICK_BUTTON':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.SELECT_RDS':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.SCAN_CASS_BUTTON' ; Props := 'ENABLED'
PrintCtrls = @WINDOW:'.PRINT_PACKINGLIST':@RM ; PrintProps = 'ENABLED':@RM
PrintCtrls := @WINDOW:'.PRINT_DOCUMENTS':@RM ; PrintProps := 'ENABLED':@RM
PrintCtrls := @WINDOW:'.PRINT_LABELS':@RM ; PrintProps := 'ENABLED':@RM
PrintCtrls := @WINDOW:'.PRINT_CARTON_LABELS':@RM ; PrintProps := 'ENABLED':@RM
PrintCtrls := @WINDOW:'.PRINT_PALLET_LABELS' ; PrintProps := 'ENABLED'
Vals = ''
IF Get_Property(@WINDOW:'.PICK_DTM','TEXT') NE '' THEN
Vals<1> = 'Picked' ;* PickButton text
Vals<2> = 0 ;* PickButton Disabled
Vals<3> = 1 ;* Picked Text Visisble
Vals<4> = 1 ;* Unpick button Enabled
Vals<5> = 0 ;* Select RDS button Disabled
Vals<6> = 0 ;* Scan Cassettes button Disabled
PrintVals = '1':@RM:'1':@RM:'1':@RM:'1':@RM:'1'
END ELSE
Vals<1> = 'Pick' ;* PickButton text
IF Get_Property(@WINDOW,'QBFLIST') = '' THEN
Vals<2> = 1 ;* PickButton Enabled
Vals<3> = 0 ;* Picked Text invisible
Vals<4> = 0 ;* Unpick button Disabled
Vals<5> = 1 ;* Select RDS button Enabled
Vals<6> = 1 ;* Scan Cassettes button Enabled
END ELSE
Vals<2> = 0 ;* PickButton Enabled
Vals<3> = 0 ;* Picked Text invisible
Vals<4> = 0 ;* Unpick button Disabled
Vals<5> = 0 ;* Select RDS button Disabled
Vals<6> = 0 ;* Scan Cassettes button Disabled
END
PrintVals = '0':@RM:'0':@RM:'0':@RM:'0':@RM:'0'
END
Set_Property(PrintCtrls,PrintProps,PrintVals)
IF Invoiced THEN
Vals<1> = 'Picked' ;* PickButton text
IF Get_Property(@WINDOW:'.INVOICE_NO','TEXT') = '' THEN
Set_Property(@WINDOW:'.INVOICE_BUTTON','TEXT','New Invoice')
END ELSE
Set_Property(@WINDOW:'.INVOICE_BUTTON','TEXT','View Invoice')
END
Vals<2> = 0 ;* PickButton Disabled
Vals<3> = 1 ;* Picked Text Visisble
Vals<4> = 0 ;* Unpick button Enabled
Vals<5> = 0 ;* Select RDS button Disabled
Vals<6> = 0
END
CONVERT @FM TO @RM IN Vals
Set_Property(Ctrls,Props,Vals)
Ctrls = @WINDOW:'.ENTER_BY':@RM ; Props = 'TEXT':@RM
Ctrls := @WINDOW:'.ENTER_DTM' ; Props := 'TEXT'
Vals = Get_Property(Ctrls,Props)
EnterBy = Vals[1,@RM]
EnterDTM = Vals[COL2()+1,@RM]
IF EnterBy = '' THEN Vals = 1:@RM ELSE Vals = 0:@RM
IF EnterDTM = '' THEN Vals := 1 ELSE Vals := 0
Props = 'ENABLED':@RM:'ENABLED'
Set_Property(Ctrls,Props,Vals)
NextNumber = XLATE('DICT.COC','%SK%',1,'X')
Set_Property(@WINDOW:'.NEW_BUTTON','TEXT',NextNumber)
* QBF buttons
Ctrls = @WINDOW:'.QBF_FIRST_FIX':@RM ; Props = 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_PREV_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_ABS_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_NEXT_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_LAST_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_STOP_FIX' ; Props := 'ENABLED'
IF Get_Property(@WINDOW,'QBFLIST') = '' THEN
Vals = 0:@RM:0:@RM:0:@RM:0:@RM:0:@RM:0
END ELSE
Vals = 1:@RM:1:@RM:1:@RM:1:@RM:1:@RM:1
END
Set_Property(Ctrls,Props,Vals)
* All cassette detail background colors
CtrlName = @WINDOW:'.RDS_DETAIL'
RDSArray = Get_Property(CtrlName,'INVALUE')
RdsStatuses = RDSArray
FOR I = 1 TO COUNT(RdsStatuses,@VM) + (RdsStatuses NE '')
RdsStatus = RdsStatuses<1,I>
RdsHotLot = RDSArray
IF RdsHotLot THEN
IF RdsHotLot THEN LineColor = RED$
END ELSE
BEGIN CASE
CASE RdsStatus[1,3] = 'Rec' ; LineColor = RCV_BLUE$
CASE RdsStatus[1,3] = 'Pre' ; LineColor = PRE_BLUE$
CASE RdsStatus[1,3] = 'In ' ; LineColor = INP_BLUE$
CASE RdsStatus[1,3] = 'Pos' ; LineColor = POS_BLUE$
CASE RdsStatus[1,3] = 'Rea' ; LineColor = GREEN$
CASE RdsStatus[1,3] = 'Shi' ; LineColor = LTGREY$
CASE RdsStatus[1,3] = 'Pro' ; LineColor = RED$
CASE 1 ; LineColor = WHITE$
END CASE
END
stat = Send_Message(CtrlName,'COLOR_BY_POS',0,I,LineColor)
NEXT I
* Turn edit table symbolic column backgrounds to green
ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow
ETCtrls = ETSymbolics<1>
ETCols = ETSymbolics<2>
FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '')
ETCtrl = ETCtrls<1,I>
IF ETCtrl NE @WINDOW:'.RDS_DETAIL' THEN
ETList = Get_Property(ETCtrl,'LIST')
FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '')
IF ETList NE '' THEN
FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '')
stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$)
NEXT N
END
NEXT I
END
NEXT I
RETURN
* * * * * * *
Page:
* * * * * * *
Page = Parm1
IF Page = '' THEN
Page = Get_Property(@WINDOW:'.TAB_MAIN','VALUE')
END ELSE
Set_Property(@WINDOW:'.TAB_MAIN','VALUE',Page)
END
Set_Property(@WINDOW,'VPOSITION', Page)
RETURN
* * * * * * *
Read:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'SHIP_NO','TEXT')
IF RowExists('COC',ShipNo) ELSE
IF NOT(Security_Check('COC',WRITE$)) THEN
Send_Event(@WINDOW,'CLEAR')
Security_Err_Msg('COC',WRITE$)
RETURN
END
END
EnterBy = Get_Property(@WINDOW:'.ENTER_BY','TEXT')
IF EnterBy = '' THEN
CurrDate = OCONV(Date(),'D4/')
CurrTime = OCONV(Time(),'MTH')
IF @USER4 = '' THEN @USER4 = 'TESTING'
Set_Property(@WINDOW:'.ENTER_BY','TEXT',OCONV(@USER4,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'))
Set_Property(@WINDOW:'.ENTER_DT','TEXT',CurrDate)
END
GOSUB Refresh
RETURN
* * * * * * *
Write:
* * * * * * *
Result = 1
RETURN
* * * * * * *
Delete:
* * * * * * *
IF Security_Check('COC',Delete$) THEN
Result = 0
IF Get_Property(@WINDOW:'.INVOICE_NO','TEXT') = '' THEN
IF Get_Property(@WINDOW:'.PICK_BY','TEXT') = '' THEN
Result = 1
END ELSE
ErrMsg('Record has material picked against it and may not be deleted.')
Result = 0
END
END ELSE
ErrMsg('Record has been invoiced and may not be deleted.')
Result = 0
END
IF Get_Property(@WINDOW:'.RDS_DETAIL','ARRAY') = '' THEN
Result = 1
END ELSE
ErrMsg('Record has material picked against it and may not be deleted.')
Result = 0
END
END ELSE
Security_Err_Msg('COC',Delete$)
Result = 0 ;* Stop event chain
END
RETURN
* * * * * * *
LUShipNo:
* * * * * * *
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
Set_Status(0)
ShipKeys = obj_Shipment('Find')
errCode = ''
IF Get_Status(errCode) THEN ErrMsg(ErrCode)
IF INDEX(ShipKeys,@VM,1) THEN
TypeOver = ''
TypeOver = 'K'
TypeOver = ShipKeys
ShipKeys = Popup(@WINDOW,TypeOver,'COC_QUERY')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
END
CONVERT @VM TO @FM IN ShipKeys
IF INDEX(ShipKeys,@FM,1) THEN
Send_Event(@WINDOW,'QBFINIT')
Set_Property(@WINDOW,'QBFLIST',ShipKeys)
GOSUB Refresh
Send_Event(@WINDOW,'QBFIRST')
END ELSE
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipKeys)
END
RETURN
* * * * * * *
ShipNoLF:
* * * * * * *
RETURN
* * * * * * *
NewShipment:
* * * * * * *
ShipNo = Get_Property(@WINDOW,'ID')
IF NOT(Security_Check('COC',WRITE$)) THEN
Security_Err_Msg('COC',WRITE$)
RETURN
END
IF ShipNo = '' THEN
NextShipNo = NextKey('COC')
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:NextShipNo)
END
RETURN
* * * * * * *
TodaysShipments:
* * * * * * *
ShipNo = Get_Property(@WINDOW,'ID')
IF ShipNo NE '' THEN
Send_Event(@WINDOW,'WRITE')
END
OpenShipKeys = obj_Shipment('TodaysShipments')
IF INDEX(OpenShipKeys,@VM,1) THEN
OpenShipKeys := @VM
CONVERT @VM TO @RM IN OpenShipKeys
CALL V119('S','','D','R',OpenShipKeys,'')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
CONVERT @RM TO @VM IN OpenShipKeys
OpenShipKeys[-1,1] = '' ;* Strip trailing delimiter
TypeOver = ''
TypeOver = 'K'
TypeOver = OpenShipKeys
TypeOver = 2 ;* Single Select
ShipKeys = Popup(@WINDOW,TypeOver,'COC_QUERY')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
END ELSE
ShipKeys = OpenShipKeys
END
IF INDEX(ShipKeys,@VM,1) THEN
Send_Event(@WINDOW,'QBFINIT')
Set_Property(@WINDOW,'QBFLIST',ShipKeys)
Send_Event(@WINDOW,'QBFFIRST')
END ELSE
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipKeys)
END
RETURN
* * * * * * *
ActiveShipments:
* * * * * * *
ShipNo = Get_Property(@WINDOW,'ID')
IF ShipNo NE '' THEN
Send_Event(@WINDOW,'WRITE')
END
OpenShipKeys = obj_Shipment('OpenShipments')
IF INDEX(OpenShipKeys,@VM,1) THEN
OpenShipKeys := @VM
CONVERT @VM TO @RM IN OpenShipKeys
CALL V119('S','','D','R',OpenShipKeys,'')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
CONVERT @RM TO @VM IN OpenShipKeys
OpenShipKeys[-1,1] = '' ;* Strip trailing delimiter
TypeOver = ''
TypeOver = 'K'
TypeOver = OpenShipKeys
TypeOver = 2 ;* Single Select
ShipKeys = Popup(@WINDOW,TypeOver,'COC_QUERY')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
END ELSE
ShipKeys = OpenShipKeys
END
IF INDEX(ShipKeys,@VM,1) THEN
Send_Event(@WINDOW,'QBFINIT')
Set_Property(@WINDOW,'QBFLIST',ShipKeys)
Send_Event(@WINDOW,'QBFFIRST')
END ELSE
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipKeys)
END
RETURN
* * * * * * *
NewViewInvoice:
* * * * * * *
Ctrls = @WINDOW:@RM ; Props = 'ID':@RM
Ctrls := @WINDOW:'.SHIP_DT':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.WO_NO':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.RDS_DETAIL':@RM ; Props := 'ARRAY':@RM
Ctrls := @WINDOW:'.TRACKING_NOS':@RM ; Props := 'ARRAY':@RM
Ctrls := @WINDOW:'.INVOICE_NO':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.CUST_NO':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.WO_CUST_NO_SHIP_TO' ; Props := 'TEXT'
Vals = Get_Property(Ctrls,Props)
ShipNo = Vals[1,@RM]
ShipDt = Vals[COL2()+1,@RM]
WONo = Vals[COL2()+1,@RM]
RDSList = Vals[COL2()+1,@RM]
TrackingNo = Vals[COL2()+1,@RM]<1,1>
InvoiceNo = Vals[COL2()+1,@RM]
CustNo = Vals[COL2()+1,@RM]
ShipCustNo = Vals[COL2()+1,@RM]
RDSNos = RDSList
WOSteps = RDSList
CassNos = RDSList
SWAP @VM:@VM WITH '' IN RDSNos
IF RDSNos[-1,1] = @VM THEN RDSNos[-1,1] = ''
IF InvoiceNo NE '' THEN
obj_AppWindow('ViewRelated','INVOICE':@RM:InvoiceNo)
END ELSE
IF ShipNo = '' OR ShipDt = '' OR WONo = '' THEN RETURN ;* Not finished with the shipment yet
LOOP
UNTIL RDSNos[-1,1] NE @VM OR RDSNos = ''
RDSNos[-1,1] = ''
REPEAT
LOOP
UNTIL WOSteps[-1,1] NE @VM OR WOSteps = ''
WOSteps[-1,1] = ''
REPEAT
LOOP
UNTIL CassNos[-1,1] NE @VM OR CassNos = ''
CassNos[-1,1] = ''
REPEAT
Send_Event(@WINDOW,'CLEAR')
obj_Invoice('Create',ShipNo:@RM:ShipDt:@RM:WONo:@RM:WOSteps:@RM:CassNos:@RM:RDSNos)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
IF CustNo = '6874' OR CustNo = '7055' THEN
* This is Wales -> transmit via ftp
KeyList = RDSNos
IF KeyList = '' THEN
ErrMsg('There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)')
RETURN
END
DosTable = Environment_Services('GetReportsRootPath') : '\W':ShipNo:'.csv'
ExportID = 'WALES_SYSTEM_RDS_DATA'
NoHeader = 1
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:DosTable:@RM:@RM:@RM:NoHeader)
// Default Remote Directory "/NPTirep"
ToWalesScript = 'open 10.131.104.18' :CRLF$
ToWalesScript := 'user' :CRLF$
ToWalesScript := 'EU\NPTirep' :CRLF$
ToWalesScript := 'Wk4F6X61!2016Friday1' :CRLF$
ToWalesScript := 'pwd ' :CRLF$
ToWalesScript := 'append ':DosTable:' EpiMesa_2018.csv' :CRLF$
ToWalesScript := 'bye' :CRLF$
OSWrite ToWalesScript ON Environment_Services('GetReportsRootPath') : '\ToWales.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToWales.scr", -1 )
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable
END
IF CustNo = '7053' THEN
* This is Tower via El Segundo - uses same setup as Wales
KeyList = RDSNos
IF KeyList = '' THEN
ErrMsg('There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)')
RETURN
END
DosTable = Environment_Services('GetReportsRootPath') : '\T':ShipNo:'.csv'
ExportID = 'WALES_SYSTEM_RDS_DATA'
NoHeader = 0
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:DosTable:@RM:@RM:@RM:NoHeader)
ToTowerScript = 'open 194.90.108.5':CRLF$
ToTowerScript := 'user':CRLF$
ToTowerScript := 'irepif2':CRLF$
ToTowerScript := 'BGfq1h':CRLF$
ToTowerScript := 'lcd \':CRLF$
ToTowerScript := 'append ':DosTable:' EpiMesa.csv':CRLF$ ;* * * * * * * * *Append to existing file
ToTowerScript := 'bye':CRLF$
OSWrite ToTowerScript ON Environment_Services('GetReportsRootPath') : '\ToTower.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToTower.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
IF CustNo = '6593' OR CustNo = '408' OR CustNo = '7076' THEN
* This is Temecula & El Segundo -> transmit via ftp
DosTable = Export_IR(ShipNo)
ToTemeculaScript = 'open 10.72.100.40':CRLF$
ToTemeculaScript := 'user':CRLF$
ToTemeculaScript := 'EPIMesa':CRLF$
ToTemeculaScript := 'irepi01':CRLF$
ToTemeculaScript := 'lcd \':CRLF$
ToTemeculaScript := 'send ':DosTable:CRLF$ ;* Send file to file with same name on remote
ToTemeculaScript := 'bye':CRLF$
OSWrite ToTemeculaScript ON Environment_Services('GetReportsRootPath') : '\ToTemecula.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToTemecula.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
IF ShipCustNo = '6775' THEN
DosTable = Export_Tower_Met(ShipNo) ;* This is Tower -> transmit via ftp
ToTowerScript = 'open 194.90.108.5':CRLF$ ;* Secured server
ToTowerScript := 'user':CRLF$
ToTowerScript := 'irepi':CRLF$
ToTowerScript := 'REPii2':CRLF$
ToTowerScript := 'lcd \':CRLF$
ToTowerScript := 'put ':DosTable:CRLF$ ;* Single file transfer
ToTowerScript := 'bye':CRLF$
OSWrite ToTowerScript ON Environment_Services('GetReportsRootPath') : '\ToTower.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToTower.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END
RETURN
* * * * * * *
ShipViaGF:
* * * * * * *
WONo = Get_Property(@WINDOW:'.WO_NO','TEXT')
ShipVia = Get_Property(@WINDOW:'.SHIP_VIA','TEXT')
IF WONo NE '' AND ShipVia = '' THEN
OrderNo = XLATE('WO_LOG',WONo,WO_LOG_ORDER_NO$,'X')
ShipVia = XLATE('ORDER',OrderNo,ORDER_SHIP_VIA$,'X')
AcctNo = XLATE('ORDER',OrderNo,ORDER_ACCOUNT_NO$,'X')
Set_Property(@WINDOW:'.SHIP_VIA','TEXT',ShipVia)
Set_Property(@WINDOW:'.SHIP_VIA_ACCT_NO','TEXT',AcctNo)
END
RETURN
* * * * * * *
LUShipVia:
* * * * * * *
CustNo = Get_Property(@WINDOW:'.CUST_NO','TEXT')
ShipVia = Get_Property(@WINDOW:'.SHIP_VIA','TEXT')
IF CustNo NE '' AND ShipVia = '' THEN
CustRec = XLATE('COMPANY',CustNo,'','X')
ShipVias = CustRec
IF INDEX(ShipVias,@VM,1) THEN
Display = ''
FOR I = 1 TO COUNT(ShipVias,@VM) + (ShipVias NE '')
Display<1,I> = ShipVias<1,I>:@SVM:CustRec
NEXT I
TypeOver = ''
TypeOver = Display
SelectedItems = Popup(@WINDOW,TypeOver,'ORDER_SHIPPER_INFO')
IF SelectedItems = '' THEN RETURN
ShipVia = SelectedItems<1,1>
AcctNo = SelectedItems<1,2>
END ELSE
ShipVia = ShipVias
AcctNo = CustRec
END
Set_Property(@WINDOW:'.SHIP_VIA','TEXT',ShipVia)
Set_Property(@WINDOW:'.SHIP_VIA_ACCT_NO','TEXT',AcctNo)
END
RETURN
* * * * * * *
WONoLF:
* * * * * * *
WONo = Get_Property(@WINDOW:'.WO_NO','DEFPROP')
ReactType = Get_Property(@WINDOW:'.REACTOR_TYPE','DEFPROP')
IF WONo NE '' AND ReactType = '' THEN
WOStepKeys = XLATE('WO_LOG',WONo,WO_LOG_WO_STEP_KEY$,'X')
ShipWOStepKey = WOStepKeys[-1,'B':@VM]
ShipPSN = XLATE('WO_STEP',ShipWOStepKey,1,'X')
ReactType = XLATE('PROD_SPEC',ShipPSN,80,'X')
Set_Property(@WINDOW:'.REACTOR_TYPE','DEFPROP',ReactType)
END
GOSUB Refresh
RETURN
* * * * * * *
Close:
* * * * * * *
obj_Notes('Inbox',@USER4) ;* Checks for any new messages
obj_Appwindow('CardReturn',@WINDOW)
RETURN
* * * * * * *
LUWONo:
* * * * * * *
Set_Status(0)
WOKeys = obj_WO_Log('Find')
IF Get_Status(errCode) THEN ErrMsg(ErrCode)
IF WOKeys NE '' THEN
TypeOver = ''
TypeOver = WOKeys
TypeOver = 'K'
WOKeys = Popup(@WINDOW,TypeOver,'WO_LOG_QUERY')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
END
RETURN
* * * * * * *
ShippingWOS:
* * * * * * *
OpenWONo = obj_WO_Log('ShipWONos','')
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
WONo = Get_Property(@WINDOW:'.WO_NO','TEXT')
IF OpenWONo NE '' AND ShipNo NE '' AND WONo = '' THEN
obj_AppWindow('LUValReturn',OpenWONo:@RM:@WINDOW:'.WO_NO')
END
RETURN
* * * * * * *
ViewBillCust:
* * * * * * *
BillCustNo = Get_Property(@WINDOW:'.BILL_CUST_NO','TEXT')
IF BillCustNo NE '' THEN
obj_Appwindow('ViewRelated','COMPANY':@RM:BillCustNo)
END
RETURN
* * * * * * *
ViewOrder:
* * * * * * *
OrderNo = Get_Property(@WINDOW:'.ORD_NO','TEXT')
IF OrderNo NE '' THEN
obj_Appwindow('ViewRelated','ORDER2':@RM:OrderNo)
END
RETURN
* * * * * * *
RDSDetailDC:
* * * * * * *
ShipNo = Get_Property(@WINDOW,'ID')
CtrlEntID = @WINDOW:'.RDS_DETAIL'
CurrPos = Get_Property(CtrlEntID,'SELPOS')
CurrCol = CurrPos<1>
CurrRow = CurrPos<2>
IF CurrCol = 1 THEN
RdsNo = Get_Property(CtrlEntID,'CELLPOS',1:@FM:CurrRow)
IF RdsNo NE '' THEN
thisFormName = 'RDS_UNLOAD'
thisFormWindowUp = Get_Property(thisFormName,'VISIBLE') ;* Returns 0 = hidden, 1 = visible, 2 = minimized, 3 = maximized
IF thisFormWindowUp = '' THEN
If Get_Property('NDW_MAIN', 'VISIBLE') then
AppMain = 'NDW_MAIN'
end else
AppMain = 'LSL_MAIN2'
end
Start_Window(thisFormName,AppMain,RDSNo:'*CENTER', '', '') ;* Put up the card window
RETURN
END
IF thisFormWindowUp = 2 THEN Set_Property(thisFormName,'VISIBLE',9) ;* Restore the window if minimized
IF Get_Property(thisFormName,'SAVEWARN') THEN
Send_Event(thisFormName,'CLEAR') ;* Clear anything existing (prompts for save first)
END
END
END ;* End of ItemNo column
RETURN
* * * * * * *
SelectCassettes:
* * * * * * *
WONo = Get_Property(@WINDOW:'.WO_NO','TEXT')
IF WONo = '' THEN RETURN
ReactorType = XLATE('WO_STEP',WONo:'*1','PS_REACTOR_TYPE','X')
IF ReactorType = 'P' OR ReactorType = 'EPP' THEN
* EpiPRO process
OPEN 'DICT.WM_OUT' TO DictVar ELSE
ErrMsg('Unable to open "DICT.WM_OUT" for index lookup in COMM_SHIPMENT routine.')
RETURN
END
SearchString = 'WO_NO':@VM:WONo:@FM
WMOutKeys = ''
Flag = ''
Btree.Extract(SearchString, 'WM_OUT', DictVar, WMOutKeys, '', Flag)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
IF WMOutKeys = '' THEN
ErrMsg('Work Order has no WM_OUT cassettes.')
RETURN
END
PopupData = ''
PLineCnt = 0
FOR I = 1 TO COUNT(WMOutKeys,@VM) + (WMOutKEys NE '')
CurrStatus = XLATE('WM_OUT',WMOutKeys<1,I>,'CURR_STATUS','X')
WfrQty = XLATE('WM_OUT',WMOutKeys<1,I>,'WFRS_OUT','X')
IF CurrStatus = 'RTS' THEN
PLineCnt += 1
PopupData<1,PLineCnt,1> = FIELD(WMOutKeys<1,I>,'*',2)
PopupData<1,PLineCnt,2> = FIELD(WMOutKeys<1,I>,'*',3)
PopupData<1,PLineCnt,3> = ''
PopupData<1,PLineCnt,4> = WfrQty
END
NEXT I
IF PopupData = '' THEN
ErrMsg('Work Order has no Ready To Ship cassettes.')
RETURN
END
TypeOver = ''
TypeOver = PopupData
NewRows = Popup(@WINDOW,TypeOver,'SHIP_RTS_CASSETTES')
END ELSE
WOMatKeys = XLATE('WO_LOG',WONo,WO_LOG_WO_MAT_KEY$,'X')
IF WOMatKeys = '' THEN
ErrMsg('Work Order has no Material (WO_MAT) records.')
RETURN
END
PopupData = ''
PLineCnt = 0
FOR I = 1 TO COUNT(WOMatKeys,@VM) + (WOMatKeys NE '')
WOMatKey = WOMatKeys<1,I>
CurrStatus = XLATE('WO_MAT',WOMatKey,'CURR_STATUS','X')
WfrQty = XLATE('WO_MAT',WOMatKey,'CURR_WFR_CNT','X')
ShipRDS = XLATE('WO_MAT',WOMatKey,'SHIP_RDS','X')
ShipStep = XLATE('WO_MAT',WOMatKey,'SHIP_WO_STEP','X')
IF CurrStatus = 'RTS' THEN
PLineCnt += 1
PopupData<1,PLineCnt,1> = ShipStep
PopupData<1,PLineCnt,2> = FIELD(WOMatKeys<1,I>,'*',2)
PopupData<1,PLineCnt,3> = ShipRDS
PopupData<1,PLineCnt,4> = WfrQty
END
NEXT I
IF PopupData = '' THEN
ErrMsg('Work Order has no Ready To Ship cassettes.')
RETURN
END
TypeOver = ''
TypeOver = PopupData
NewRows = Popup(@WINDOW,TypeOver,'SHIP_RTS_CASSETTES')
END
IF NewRows NE '' THEN
OrgArray = Get_Property(@WINDOW:'.RDS_DETAIL','DEFPROP')
OrgCassNos = OrgArray
OrgLineCnt = COUNT(OrgArray,@FM) + (OrgCassNos NE '') ;* Number of lines in edit table (including blank lines)
CurrStepNos = ''
CurrCassNos = ''
CurrRDSNos = ''
FOR I = 1 TO OrgLineCnt
IF OrgCassNos<1,I> NE '' THEN
CurrStepNos<1,-1> = OrgArray<1,I>
CurrCassNos<1,-1> = OrgArray<2,I>
CurrRDSNos<1,-1> = OrgArray<3,I>
END
NEXT I
FOR I = 1 TO COUNT(NewRows,@FM) + (NewRows NE '')
NewStepNo = NewRows
NewCassNo = NewRows
NewRdsNo = NewRows
LOCATE NewCassNo IN CurrCassNos BY 'AR' USING @VM SETTING Pos ELSE
CurrStepNos = INSERT(CurrStepNos,1,Pos,0,NewStepNo)
CurrCassNos = INSERT(CurrCassNos,1,Pos,0,NewCassNo)
CurrRdsNos = INSERT(CurrRdsNos,1,Pos,0,NewRdsNo)
END
NEXT I
CurrLineCnt = COUNT(CurrRdsNos,@VM) + (CurrRdsNos NE '')
IF CurrLineCnt < OrgLineCnt THEN
CurrStepNos := Str(@VM,OrgLineCnt - CurrLineCnt) ;* Pad with blank lines to fill edit table control
CurrCassNos := Str(@VM,OrgLineCnt - CurrLineCnt)
CurrRdsNos := Str(@VM,OrgLineCnt - CurrLineCnt)
END ELSE
CurrStepNos := @VM
CurrCassNos := @VM
CurrRdsNos := @VM ;* Pad with single blank line at end of edit table
END
Set_Property(@WINDOW:'.RDS_DETAIL','DEFPROP',CurrStepNos:@FM:CurrCassNos:@FM:CurrRdsNos)
FOR I = COL$RDS_LOT_NO TO COL$RDS_STAT_CD
Send_Event(@WINDOW:'.RDS_DETAIL','CALCULATE',I)
NEXT I
GOSUB Refresh
END
RETURN
* * * * * * *
ScanCassettes:
* * * * * * *
WONo = Get_Property(@WINDOW:'.WO_NO','DEFPROP')
NewRows = Dialog_Box("DIALOG_MAT_SCAN", @window, 'Ship':@VM:'Scan Cassettes for WO ':WONo)
IF NewRows = 'Cancel' THEN RETURN
IF NewRows NE '' THEN
OrgArray = Get_Property(@WINDOW:'.RDS_DETAIL','DEFPROP')
OrgCassNos = OrgArray
OrgLineCnt = COUNT(OrgArray,@FM) + (OrgCassNos NE '') ;* Number of lines in edit table (including blank lines)
CurrStepNos = ''
CurrCassNos = ''
CurrRDSNos = ''
FOR I = 1 TO OrgLineCnt
IF OrgCassNos<1,I> NE '' THEN
CurrStepNos<1,-1> = OrgArray<1,I>
CurrCassNos<1,-1> = OrgArray<2,I>
CurrRDSNos<1,-1> = OrgArray<3,I>
END
NEXT I
FOR I = 1 TO COUNT(NewRows,@FM) + (NewRows NE '')
NewStepNo = NewRows
NewCassNo = NewRows
NewRdsNo = NewRows
LOCATE NewCassNo IN CurrCassNos USING @VM SETTING Pos ELSE
CurrStepNos = INSERT(CurrStepNos,1,Pos,0,NewStepNo)
CurrCassNos = INSERT(CurrCassNos,1,Pos,0,NewCassNo)
CurrRdsNos = INSERT(CurrRdsNos,1,Pos,0,NewRdsNo)
END
NEXT I
CurrLineCnt = COUNT(CurrRdsNos,@VM) + (CurrRdsNos NE '')
IF CurrLineCnt < OrgLineCnt THEN
CurrStepNos := Str(@VM,OrgLineCnt - CurrLineCnt) ;* Pad with blank lines to fill edit table control
CurrCassNos := Str(@VM,OrgLineCnt - CurrLineCnt)
CurrRdsNos := Str(@VM,OrgLineCnt - CurrLineCnt)
END ELSE
CurrStepNos := @VM
CurrCassNos := @VM
CurrRdsNos := @VM ;* Pad with single blank line at end of edit table
END
Set_Property(@WINDOW:'.RDS_DETAIL','DEFPROP',CurrStepNos:@FM:CurrCassNos:@FM:CurrRdsNos)
FOR I = COL$RDS_LOT_NO TO COL$RDS_STAT_CD
Send_Event(@WINDOW:'.RDS_DETAIL','CALCULATE',I)
NEXT I
GOSUB Refresh
END
RETURN
* * * * * * *
Pick:
* * * * * * *
IF Get_Property(@WINDOW:'.PICK_DTM','TEXT') NE '' THEN RETURN ;* Check for pre-existing picked flag
ShipNo = Get_Property(@WINDOW,'ID')
IF ShipNo = '' THEN RETURN
Send_Event(@WINDOW,'WRITE')
obj_Shipment('Pick',ShipNo)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
Send_Event(@WINDOW,'PAGE',2)
GOSUB REFRESH
RETURN
* * * * * *
UnPick:
* * * * * *
IF Get_Property(@WINDOW:'.PICK_DTM','TEXT') = '' THEN RETURN ;* Check for null pickeded flag
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
Set_Property(@WINDOW,'SAVEWARN',0)
Send_Event(@WINDOW,'CLEAR')
obj_Shipment('UnPick',ShipNo)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
obj_AppWindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
Send_Event(@WINDOW,'PAGE',2)
GOSUB Refresh
RETURN
* * * * * * *
ViewWO:
* * * * * * *
WONo = Get_Property(@WINDOW:'.WO_NO','TEXT')
IF WONo NE '' THEN
WOStepKeys = XLATE('WO_LOG',WONo,34,'X')
LastStepKey = WOStepKeys[-1,'B':@VM]
obj_Appwindow('ViewRelated','WO_PROD':@RM:LastStepKey)
END
RETURN
* * * * * * *
PrintCassLabel:
* * * * * * *
CtrlEntID = @WINDOW:'.RDS_DETAIL'
RDSArray = Get_Property(CtrlEntID,'DEFPROP')
WONo = Get_Property(@WINDOW:'.WO_NO','DEFPROP')
PDisplay = ''
LineCnt = 0
FOR I = 1 TO COUNT(RDSArray<1>,@VM) + (RDSArray<1> NE '')
IF RDSArray NE '' OR RDSArray NE '' THEN
LineCnt += 1
PDisplay<1,LineCnt,1> = RDSArray
PDisplay<1,LineCnt,2> = RDSArray
PDisplay<1,LineCnt,3> = RDSArray
END
NEXT I
TypeOver = ''
TypeOver = PDisplay
SelectedCassettes = Popup(@WINDOW,TypeOver,'PRINT_CASS_SHIP_LABELS')
WOStepNos = ''
WOCassNos = ''
RDSNos = ''
FOR I = 1 TO COUNT(SelectedCassettes,@FM) + (SelectedCassettes NE '')
WOStepNos<1,I> = SelectedCassettes
WOCassNos<1,I> = SelectedCassettes
RDSNos<1,I> = SelectedCassettes
NEXT I
Print_Cass_Ship_Label( WONo,WOStepNos,WOCassNos,RDSNos )
RETURN
* * * * * * *
PrintPackingList:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF security_check( 'COC', Print$ ) THEN
Send_Event(@WINDOW,'WRITE')
Print_Packing_Slip(ShipNo)
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END ELSE
Security_Err_Msg( 'COC', Print$ )
END
RETURN
* * * * * * *
PrintCheck:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
Send_Event(@WINDOW,'WRITE')
Print_Ship_CheckList(ShipNo)
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
RETURN
* * * * * * *
PrintDocuments:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF Security_Check( 'COC', Print$ ) THEN
Send_Event(@WINDOW,'WRITE')
Print_Shipment(ShipNo)
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END ELSE
Security_Err_Msg( 'COC', Print$ )
END
RETURN
* * * * * * *
PrintPalletLabels:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF Security_Check( 'COC', Print$ ) THEN
Send_Event(@WINDOW,'WRITE')
Print_Pallet_Labels( ShipNo )
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END ELSE
Security_Err_Msg( 'COC', Print$ )
END
RETURN
* * * * * * *
PrintCartonLabels:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF Security_Check( 'COC', Print$ ) THEN
Send_Event(@WINDOW,'WRITE')
Print_Carton_Labels( ShipNo )
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END ELSE
Security_Err_Msg( 'COC', Print$ )
END
RETURN
* * * * * * *
PrintCoCInvoice:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF Security_Check( 'COC', Print$ ) THEN
Send_Event(@WINDOW,'WRITE')
Print_CoC_Invoice( ShipNo )
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END ELSE
Security_Err_Msg( 'COC', Print$ )
END
RETURN
* * * * * * *
PrintCommInvoice:
* * * * * * *
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF Security_Check( 'COC', Print$ ) THEN
Send_Event(@WINDOW,'WRITE')
Print_Comm_Invoice( ShipNo )
obj_Appwindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
END ELSE
Security_Err_Msg( 'COC', Print$ )
END
RETURN
* * * * * * *
SendToVision:
* * * * * * *
IF Get_Property(@WINDOW:'.VISION_DTM','TEXT') NE '' THEN RETURN ;* Check for null picked flag
ShipNo = Get_Property(@WINDOW:'.SHIP_NO','TEXT')
IF ShipNo = '' THEN RETURN
IF NOT(Security_Check('Vision',WRITE$)) THEN
IF NOT(MemberOf(@USER4,'SHIPPING')) THEN
Security_Err_Msg('Vision',WRITE$)
RETURN
END
END
Set_Property(@WINDOW,'SAVEWARN',0)
Send_Event(@WINDOW,'CLEAR')
obj_Shipment('SendToVision',ShipNo)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
obj_AppWindow('LoadFormKeys',@WINDOW:@RM:ShipNo)
RETURN
* * * * * * *
VtsDel:
* * * * * * *
RETURN
* * * * * * *
VtsIns:
* * * * * * *
RETURN
* * * * * * *
ReTxTechData:
* * * * * * *
Ctrls = @WINDOW:@RM ; Props = 'ID':@RM
Ctrls := @WINDOW:'.RDS_DETAIL':@RM ; Props := 'ARRAY':@RM
Ctrls := @WINDOW:'.CUST_NO':@RM ; Props := 'TEXT':@RM
Ctrls := @WINDOW:'.WO_CUST_NO_SHIP_TO' ; Props := 'TEXT'
Vals = Get_Property(Ctrls,Props)
ShipNo = Vals[1,@RM]
RDSList = Vals[COL2()+1,@RM]
CustNo = Vals[COL2()+1,@RM]
ShipCustNo = Vals[COL2()+1,@RM]
RDSNos = RDSList
SWAP @VM:@VM WITH '' IN RDSNos
IF RDSNos[-1,1] = @VM THEN RDSNos[-1,1] = ''
LOOP
UNTIL RDSNos[-1,1] NE @VM OR RDSNos = ''
RDSNos[-1,1] = ''
REPEAT
IF CustNo = '6874' OR CustNo = '7055' THEN
* This is Wales -> transmit via ftp
KeyList = RDSNos
IF KeyList = '' THEN
ErrMsg('There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)')
RETURN
END
DosTable = Environment_Services('GetReportsRootPath') : '\W':ShipNo:'.csv'
ExportID = 'WALES_SYSTEM_RDS_DATA'
NoHeader = 1
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:DosTable:@RM:@RM:@RM:NoHeader)
ToWalesScript = 'open 10.131.104.18' :CRLF$
ToWalesScript := 'user' :CRLF$
ToWalesScript := 'EU\NPTirep' :CRLF$
ToWalesScript := 'Wk4F6X61!2016Friday1' :CRLF$
ToWalesScript := 'pwd ' :CRLF$
ToWalesScript := 'append ':DosTable:' EpiMesa_2018.csv' :CRLF$
ToWalesScript := 'bye' :CRLF$
OSWrite ToWalesScript ON Environment_Services('GetReportsRootPath') : '\ToWales.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToWales.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
IF CustNo = '7053' THEN
* This is TSMC - uses same setup as Wales
KeyList = RDSNos
IF KeyList = '' THEN
ErrMsg('There are no RDS records attached to this shipment. No data will be sent to the customer. (EpiPRO process)')
RETURN
END
DosTable = Environment_Services('GetReportsRootPath') : '\T':ShipNo:'.csv'
ExportID = 'WALES_SYSTEM_RDS_DATA'
NoHeader = 0
obj_Export('ExportDelimited','Comma':@RM:KeyList:@RM:ExportID:@RM:DosTable:@RM:@RM:@RM:NoHeader)
ToWalesScript = 'open 194.90.108.5':CRLF$
ToWalesScript := 'user':CRLF$
ToWalesScript := 'irepif2':CRLF$
ToWalesScript := 'BGfq1h':CRLF$
ToWalesScript := 'lcd \':CRLF$
ToWalesScript := 'append ':DosTable:' EpiMesa.csv':CRLF$ ;* * * * * * * * *Append to existing file
ToWalesScript := 'bye':CRLF$
OSWrite ToWalesScript ON Environment_Services('GetReportsRootPath') : '\ToWales.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToWales.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
IF CustNo = '6593' OR CustNo = '408' OR CustNo = '7076' THEN
* This is Temecula & El Segundo -> transmit via ftp
DosTable = Export_IR(ShipNo)
ToTemeculaScript = 'open 10.72.100.40':CRLF$
ToTemeculaScript := 'user':CRLF$
ToTemeculaScript := 'EPIMesa':CRLF$
ToTemeculaScript := 'irepi01':CRLF$
ToTemeculaScript := 'lcd \':CRLF$
ToTemeculaScript := 'send ':DosTable:CRLF$ ;* Send file to file with same name on remote
ToTemeculaScript := 'bye':CRLF$
OSWrite ToTemeculaScript ON Environment_Services('GetReportsRootPath') : '\ToTemecula.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToTemecula.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
IF ShipCustNo = '6775' THEN
DosTable = Export_Tower_Met(ShipNo) ;* This is Tower -> transmit via ftp
* This is the ftp code here
ToTowerScript = 'open 194.90.108.5':CRLF$ ;* Secured Server - ftps.ts.co.il
ToTowerScript := 'user':CRLF$
ToTowerScript := 'irepi':CRLF$
ToTowerScript := 'REPii2':CRLF$
ToTowerScript := 'lcd \':CRLF$
ToTowerScript := 'put ':DosTable:CRLF$ ;* Single file transfer
ToTowerScript := 'bye':CRLF$
OSWrite ToTowerScript ON Environment_Services('GetReportsRootPath') : '\ToTower.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToTower.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable ;* Removes table from C: drive
END
IF ShipCustNo = '7053' OR ShipCustNo = '7092' THEN
DosTable = Export_Tower_Met(ShipNo) ;* This is Tower -> transmit via ftp
* This is the ftp code here
ToTowerScript = 'open 194.90.108.5':CRLF$ ;* Secured Server - ftps.ts.co.il
ToTowerScript := 'user':CRLF$
ToTowerScript := 'irepif2':CRLF$
ToTowerScript := 'BGfq1h':CRLF$
ToTowerScript := 'lcd \':CRLF$
ToTowerScript := 'put ':DosTable:CRLF$ ;* Single file transfer
ToTowerScript := 'bye':CRLF$
OSWrite ToTowerScript ON Environment_Services('GetReportsRootPath') : '\ToTower.scr'
stat = UTILITY('RUNWIN',"ftp -i -n -s:" : Environment_Services('GetReportsRootPath') : "\ToTower.scr",-1)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
OSDelete DosTable
END
RETURN