COMPILE SUBROUTINE Print_Shipment_Dev(ShipNo, ShipRec, AutoPrint, HideUI) #pragma precomp SRP_PreCompiler DECLARE FUNCTION Msg,Set_Printer, Dialog_Box, Security_Check, FieldCount, ex_vm_rem, obj_WM_Out, SRP_Send_Mail DECLARE FUNCTION Utility, Send_Event, Popup, Printer_Select, obj_Install,obj_RDS, obj_Shipment, Environment_Services Declare function RTI_CreateGUID, Logging_Services, PrintSetup DECLARE SUBROUTINE Msg, extract_si_keys, record_lock, security_err_msg, ErrMsg, Start_Window, obj_Tables, GetTempPath DECLARE SUBROUTINE Print_Packing_Slip, Print_SRP, Print_Coc_Back, Print_Cust_Rds, Print_Vend_CofA, Print_NCR, PrintSetup DECLARE SUBROUTINE Create_Note, Btree.Extract, Print_Cass_Out, obj_Export, Set_Status, obj_Notes, Logging_Services Declare subroutine FTP_Services $INSERT APPCOLORS $INSERT COMPANY_EQUATES $INSERT COC_EQUATES $INSERT EXPORTS_EQU $INSERT LOGICAL $INSERT LSL_USERS_EQU $INSERT MSG_EQUATES $INSERT POPUP_EQUATES $INSERT PROD_SPEC_EQUATES $INSERT RDS_EQU $INSERT RDS_LAYER_INFO_EQU $INSERT QUOTE_EQU $INSERT QUOTE_SIGS_EQU $INSERT QUOTE_SPEC_EQU $INSERT SCHEDULE_EQU $INSERT SECURITY_RIGHTS_EQU $INSERT OIPRINT_EQUATES $INSERT RDS_TEST_EQUATES $INSERT RDS_LAYER_EQUATES $INSERT WO_STEP_EQU $INSERT WO_LOG_EQUATES $insert PRINTSETUP_EQUATES $INSERT SRPMail_Inserts * * * * * * * * * * * * * * * * Major Update Test Program - JCH * * * * * * * * * * * * * * * If Assigned(HideUI) else HideUI = False$ If HideUI NE True$ then HideUI = False$ equ OutSpecThickLossCode$ to 'D1' equ OutSpecResLossCode$ to 'D2' EQU PI$LEFT TO 1 ;* OIPI page parameters 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 * * * Main: * * * IF NOT(ASSIGNED(ShipNo)) THEN RETURN IF NOT(ASSIGNED(ShipRec)) THEN ShipRec = '' If Not(Assigned(AutoPrint)) Then Autosend = '' If Not(Assigned(AutoPrint)) Then AutoPrint = '' IF ShipNo = '' THEN RETURN IF ShipRec = '' THEN ShipRec = XLATE('COC',ShipNo,'','X') ShipWONo = ShipRec 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 Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Begin PRINT_SHIPMENT_DEV', @RM, @FM, '') ShipRdsKeys = ShipRec IF INDEX(ShipRdsKeys,@VM,1) THEN testShipRdsKeys = ShipRdsKeys CONVERT @VM TO '' IN testShipRdsKeys IF testShipRdsKeys = '' AND ShipRdsKeys NE '' THEN ShipRdsKeys = '' END END ShipWOStepNos = ShipRec ShipCassNos = ShipRec ShipDt = OCONV(ShipRec,'D4/') ShipEpiPart = XLATE('COC',ShipNo,'EPI_PART_NO','X') TotWfrsShip = XLATE('COC',ShipNo,'TOT_QTY','X') SAPDelNo = ShipRec WORec = XLATE('WO_LOG',ShipWONo,'','X') CustNo = Xlate('COC', ShipNo, 'WO_CUST_NO_EX', 'X') EpiPartNo = Xlate('COC', ShipNo, 'EPI_PART_NO_EX', 'X') WOStepKeys = WORec ProdOrdNo = WORec WMOutKeys = '' FOR I = 1 TO COUNT(ShipWOStepNos,@VM) + (ShipWOStepNos NE '') WMOutKeys<1,I> = ShipWONo:'*':ShipWOStepNos<1,I>:'*':ShipCassNos<1,I> ;* These will drive this process when update of the RDS process is completed JCH 6/14/2006 NEXT I If ( (ShipRDSKeys NE '') or (WMOutKeys NE '') ) then // We have RDS or WM_OUT key(s), so go ahead and print * Get printing options PrintOpts = '' eMailAddr = '' eMailNames = '' PDFFileName = '' If AutoPrint = 1 Then CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS') CompRec = Xlate('COMPANY', CustNo, '','X') PrintOpts<1,1> = '' PrintOpts<1,2> = CompRec PrintOpts<1,3> = '' PrintOpts<1,4> = CompRec PrintOpts<1,5> = '' PrintOpts<1,6> = CompRec PrintOpts<1,7> = CompRec PrintOpts<1,8> = '' PrintOpts<1,9> = CompRec TestPrintOpts = PrintOpts Convert @VM To '' In TestPrintOpts IF TestPrintOpts = '' THEN Return eMailNames = CompRec eMailAddr = CompRec CompName = CompRec ShipDocDir = CompRec ;* Shipment directory name in COMPANY record Swap 'R:' with Environment_Services('GetApplicationRootIP') : '\apps' in ShipDocDir ShipDocFileName = CompRec ;* Shipment .pdf filename format IF ShipDocDir = '' OR ShipDocFileName = '' THEN RETURN Def = "" Def = 'Auto Transmitting Shipment Documents ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) eMailPath = ShipDocDir:'\' ;* Ship_eMail path IF ShipDocFileName = 'DLV' THEN eMailFileName = ShipNo:'+':OCONV(ShipRec,'D4-'):'+SHIPMENT' ;* JCH & DKK 11/30/2016 per customer request! :() :) tee hee hee END ELSE eMailFileName = ShipNo:'_':OCONV(ShipRec,'D4-') ;* Ship_eMail filename **************** Needs changed for specific customers ************** END TruePDFFileName = eMailPath:eMailFileName:'.pdf' PDFFileName = Str(\00\, 1024) GetTempPath(Len(PDFFileName), PDFFileName) Convert \00\ to '' in PDFFileName PDFFileName := RTI_CreateGUID() : '.pdf' SWAP @VM WITH ',' in eMailAddr ;* List of email addresses to use in eMail process SWAP @VM WITH ', ' in eMailNames ;* Names of recipients eMailAddr = 'daniel.stieber@infineon.com' eMailAddr := ',jonathan.ouellette@infineon.com' Message = '' Message<-1> = '' Message<-1> = 'Delivery No: ':ShipRec Message<-1> = '' Message<-1> = 'Ship No: ':ShipNo Message<-1> = '' Message<-1> = 'Shipped To: ':CustNo:' - ':CompName Message<-1> = '' Message<-1> = 'Epi Part No: ':EpiPartNo Message<-1> = '' Message<-1> = 'Total Wafers: ':TotWfrsShip Message<-1> = '' Message<-1> = 'Shipment Documents Attached' eMailText = '' eMailText<-1> = 'Automatic eMail from: Infineon Epi Services at ':CurrDTM eMailText<-1> = '' eMailText<-1> = 'Recipients: ':eMailNames eMailText<-1> = '' eMailText<-1> = 'Subject: Automated Shipment Notification' eMailText<-1> = '' eMailText<-1> = 'Message: ' eMailText<-1> = '' eMailText<-1> = Message eMailText<-1> = '' eMailHeader = eMailText<1> CONVERT \00\ TO ',' IN eMailText SWAP @VM WITH ':@VM:' IN eMailText SWAP @FM WITH CHAR(13):CHAR(10) IN eMailText SWAP @TM WITH CHAR(13):CHAR(10) IN eMailText End ELSE PrintOpts = Dialog_Box( 'DIALOG_SHIP_PRINT_OPTS', @WINDOW, CustNo:'*':EpiPartNo ) IF PrintOpts = '' THEN RETURN End ;* End of Check for AutoPrint Flag PrintFrontPage = PrintOpts<1,1> FrontPageCopies = PrintOpts<1,2> PrintBackPage = PrintOpts<1,3> BackPageCopies = PrintOpts<1,4> ShipType = PrintOpts<1,5> CustRDSs = PrintOpts<1,6> NCRRejCnt = PrintOpts<1,7> PrintPDF = PrintOpts<1,8> ;* 01/27/04 JCH VendorCOA = PrintOpts<1,9> ;* 04/02/04 JCH * Following Fills PageCopies if PrintOpts were entered by the Dialog Box and the PageCopies was not filled in If FrontPageCopies = '' Then ;* If PrintFrontPage = 1 Then FrontPageCopies = 1 End Else FrontPageCopies = 0 End End If BackPageCopies = '' Then If PrintBackPage = 1 Then BackPageCopies = 1 End Else BackPageCopies = 0 End End If FrontPageCopies = '' Then FrontPageCopies = 0 ;* This stays after the dialog box is updated If BackPageCopies = '' Then BackPageCopies = 0 * Initialize Common Printer parms PageInfo = '' PageInfo = 0.5 ;* Margins PageInfo = 1.35 PageInfo = 0.5 PageInfo = 0.25 PageSetup = '0' ;* Portrait Models = '' Printers = '' Default = '' PrinterCount = PrintSetup(PRN_GET$, Models, Printers, Default) IF PrintPDF THEN FileNameParms = 'Printing PDF Document':@FM: '' :@FM:'':@FM: '' TitleParms = 'Shipping Documents' PrintSetup = '' PrintSetup<1,1> = '2' ;* Preview Normal PrintSetup<1,2> = '5' ;* Display Print and PDF buttons PrintSetup<1,3> = '0' ;* Display Printing Window PrintSetup<1,4> = '0' ;* Normal Start Mode PrinterParm = '' PrinterParm<1, 1> = 'Microsoft XPS Document Writer' PrinterParm<1, 2> = False$ ; // Do not set Windows default printer to this printer PrinterParm<2> = 'Ne00:' ; // Printer port PrinterParm<3> = 100 ; // Scale PrinterParm<4> = '' ; // Bin Number StartTime = Time() Loop TimeElapsed = Time() - StartTime stat = Set_Printer('INIT', FileNameParms, 'Shipping Documents', PageInfo, PageSetup, PrintSetup, PrinterParm) While ( (Stat LT 0) and (TimeElapsed LT 60) ) Repeat If Stat LT 0 then EmailAddresses = 'daniel.stieber@infineon.com,jonathan.ouellette@infineon.com' EmailMessage = LoggingDTM : ' ' : 'WONo = ' : ShipWONo : ', ShipNo = ' : ShipNo : ', INIT Stat = ' : Stat end else EmailAddresses = '' EmailMessage = '' end Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Called INIT Method. Stat : ' : Stat, @RM, @FM, '', EmailAddresses, EmailMessage) END ELSE IF AutoPrint = 1 THEN FileNameParms = 'Printing PDF Document' FileNameParms<3> = 6 ;* Export to PDF FileNameParms<4> = PDFFileName ;* Filename to export pdf file to TitleParms = 'Shipping Documents' PrintSetup = '' PrintSetup<1,1> = '2' ;* Preview Normal PrintSetup<1,3> = '0' ;* Hide Printing Window PrintSetup<1,4> = '3' ;* Start completely hidden END ELSE PrintSetup = '0' ;* Print to printer without preview END PrinterParm = '' PrinterParm<1, 1> = 'Microsoft XPS Document Writer' PrinterParm<1, 2> = False$ ; // Do not set Windows default printer to this printer PrinterParm<2> = 'Ne00:' ; // Printer port PrinterParm<3> = 100 ; // Scale PrinterParm<4> = '' ; // Bin Number stat = Set_Printer('INIT', FileNameParms, TitleParms, PageInfo, PageSetup, PrintSetup, PrinterParm) If Stat LT 0 then EmailAddresses = 'daniel.stieber@infineon.com,jonathan.ouellette@infineon.com' EmailMessage = LoggingDTM : ' ' : 'WONo = ' : ShipWONo : ', ShipNo = ' : ShipNo : ', INIT Stat = ' : Stat end else EmailAddresses = '' EmailMessage = '' end Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Called INIT Method. Stat : ' : Stat, @RM, @FM, '', EmailAddresses, EmailMessage) END If HideUI EQ False$ then Msg(@window, MsgUp) ;* Msg box down PrinterInitialized = 1 font = 'Arial' ;* Font basics font<2> = 10 font<4> = 0 stat = Set_Printer('FONTHEADFOOT', font) stat = Set_Printer('LINESTYLE', PS_SOLID:@FM:2) stat = Set_Printer('LINE', -0.1:@FM:-1.2:@FM:7.7:@FM:-1.2, 1) stat = Set_Printer('LINE', -0.1:@FM:-0.1:@FM:7.7:@FM:-0.1, 1) location = -.15:@fm:-1.150:@fm:1.57:@fm:1 stat = Set_Printer('BMP',obj_Install('Get_Prop','ColorBMP'),location, 0,1) font = 'Arial' font<2> = '18' ;* Big type font<4> = 1 ;* Bold on font<5> = 1 ;* Italics font<2> = 12 ;* Drop the font size font<5> = 0 ;* Italics off Company = obj_Install('Get_Prop','Company') Division = obj_Install('Get_Prop','Division') font = 'Arial' font<2> = '12' ;* Big type font<4> = 1 ;* Bold on font<5> = 0 ;* Italics stat = Set_Printer('TEXTXY',Company,5.7:@FM:-1.15,font,1) font<2> = 10 ;* 10 point font font<4> = 0 ;* Bold off font<5> = 0 ;* Italics Off stat = Set_Printer('TEXTXY',obj_Install('Get_Prop','Address'),5.7:@fm:-0.775,font,1) stat = Set_Printer('TEXTXY',obj_Install('Get_Prop','CSZC'),5.7:@fm:-0.625,font,1) stat = Set_Printer('TEXTXY','Tel: ':obj_Install('Get_Prop','Phone'),5.7:@fm:-0.475,font,1) stat = Set_Printer('TEXTXY','FAX: ':obj_Install('Get_Prop','FAX'),5.7:@fm:-0.325,font,1) stat = Set_Printer('TEXTXY','Shipment No: ':ShipNo,3.0:@FM:-0.325,font,1) IF ShipRec NE '' THEN SAPDelNo = ShipRec stat = Set_Printer('TEXTXY','SAP Delivery No: ':SAPDelNo,2.8:@FM:-0.525,font,1) END WOStepCnt = COUNT(WOStepKeys,@VM) + (WOStepKeys NE '') FOR WOStep = 1 TO WOStepCnt IF WOStep > 1 THEN stat = Set_Printer('PAGEBREAK') END IF WOStep NE WOStepCnt THEN Parms = ShipNo:@RM:WOStep:@RM:ShipRDSKeys:@RM:ShipRec PrintRDSKeys = obj_Shipment('PrevStepRDSNos',Parms) PrintWMOutKeys = '' FOR I = 1 TO COUNT(PrintRDSKeys,@VM) + (PrintRDSKeys NE '') LOCATE PrintRDSKeys<1,I> IN ShipRDSKeys USING @VM SETTING Pos THEN PrintWMOutKeys<1,I> = WMOutKeys<1,Pos> END NEXT I END ELSE PrintRdsKeys = ShipRdsKeys PrintWMOutKeys = WMOutKeys END IF WOStep = 1 THEN Def = "" Def = 'Printing Packing Slip ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) Print_Packing_Slip( ShipNo, '', '', PrinterInitialized, HideUI) ;* Two copies of the packing slip If HideUI EQ False$ then Msg(@WINDOW, MsgUp) END IF FrontPageCopies > 0 THEN stat = Set_Printer('PAGEBREAK') Def = "" Def = 'Printing COC Front ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) FOR H = 1 TO FrontPageCopies font = 'Arial' font<2> = '18' ;* Big type font<4> = 1 ;* Bold on font<5> = 1 ;* Italics stat = Set_Printer('TEXTXY','Certificate of Compliance',2.1:@FM:-0.80,font,0) font<2> = 12 ;* Normal size font<4> = 0 ;* Bold off font<5> = 0 ;* Italics off GOSUB PrintCocFront NEXT H If HideUI EQ False$ then Msg(@WINDOW, MsgUp) END IF BackPageCopies > 0 THEN Def = "" Def = 'Printing COC Back ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) FOR H = 1 TO BackPageCopies stat = Set_Printer('PAGEBREAK') * false for not prelim, is is a full shipment and no email addresses Print_Coc_Back( PrintRdsKeys, PrintWMOutKeys, false$, '', PrintOnly, ShipDt, HideUI, ShipNo) NEXT H If HideUI EQ False$ then Msg(@WINDOW, MsgUp) END IF CustRDSs AND PrintRDSKeys NE '' THEN Def = "" Def = 'Printing Cust RDS sheets ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) CustRDSPrintRdsKeys = PrintRdsKeys CONVERT @VM TO @FM IN CustRDSPrintRdsKeys PrintPath = '' Print_Cust_Rds( CustRDSPrintRdsKeys, PrintWMOutKeys, PrintOnly, PrintPath, PDFFileName,PrinterInitialized, HideUI) If HideUI EQ False$ then Msg(@WINDOW,MsgUp) END IF WMOutKeys NE '' THEN Def = "" Def = 'Printing Cass Data Sheets ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) PrintCDSKeys = WMOutKeys CONVERT @VM TO @FM IN PrintCDSKeys Print_Cass_Out( PrintCDSKeys, PrintOnly, PrintPath, PDFFileName,PrinterInitialized, HideUI) If HideUI EQ False$ then Msg(@WINDOW,MsgUp) END IF VendorCOA THEN Def = "" Def = 'Printing Vendor COA sheets ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) AllLotNos = XLATE('RDS',PrintRdsKeys,rds_lot_num$,'X') VendLotNos = '' FOR A = 1 TO COUNT(AllLotNos,@VM) + (AllLotNos NE '') AllLotNo = AllLotNos<1,A> LOCATE AllLotNo IN VendLotNos BY 'AR' USING @VM SETTING Pos ELSE VendLotNos = INSERT(VendLotNos,1,Pos,0,AllLotNo) END NEXT A OPEN 'DICT.COA' TO DictVar THEN SearchString = 'LOT_NO':@VM:VendLotNos:@FM CoaKey = '' Option = '' Flag = '' CoaKeys = '' Btree.Extract(SearchString, 'COA', DictVar, CoaKeys, Option, Flag) FOR VendCoa = 1 TO COUNT(CoaKeys,@VM) + (CoaKeys NE '') Print_Vend_CofA(CoaKeys<1,VendCoa>,PrintPath, PDFFileName, PrinterInitialized, HideUI) NEXT VendCoa END If HideUI EQ False$ then Msg(@WINDOW,MsgUp) END NCRRDsPrintIDs = '' IF ( NCRRejCnt <> '' ) THEN Def = "" Def = 'Printing NCR Sheets ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) NCRRDSPrintRdsKeys = PrintRdsKeys CONVERT @VM TO @FM IN NCRRDSPrintRdsKeys Ncnt = COUNT( NCRRDSPrintRdsKeys, @FM ) + (NCRRDSPrintRdsKeys NE '') NCRPrn = '' FOR I = 1 TO Ncnt NCRIds = XLATE('RDS',NCRRDSPrintRdsKeys,RDS_NCR_KEYS$,'X') RDSRejCnt = SUM(XLATE('NCR',NCRIds,'REJ_CNT','X')) IF RDSRejCnt >= NCRRejCnt THEN NCRPrn<1,-1> = NCRIds END NEXT I CONVERT @VM TO @FM IN NCRPrn SuppliedBy = XLATE( 'PROD_SPEC', xlate( 'RDS', PrintRdsKeys<1,1>, rds_prod_spec_id$, 'X' ), 'SUB_SUPPLIED_BY', 'X' ) IF SuppliedBy = 'C' THEN ;* Wafers are supplied by the customer so print the NCRS IF NCRPrn <> '' THEN * Print the NCRs that are over the ncr_rej cnt IF Security_Check( 'NCR', Print$ ) THEN Print_NCR( NCRPrn, '', PrintOnly, PrintPath, PDFFileName ,PrinterInitialized, HideUI) END ELSE If HideUI EQ False$ then Security_Err_Msg( 'NCR', Print$ ) END END END ;* End of check for SuppliedBy = 'C' If HideUI EQ False$ then Msg(@WINDOW,MsgUp) END ;* End of check for NCRRecCnt NE '' * Now print the SRP plot if there are any SRPScanPrintRdsKeys = PrintRdsKeys CONVERT @VM TO @FM IN SRPScanPrintRdsKeys SRPPointers = xlate( 'RDS', SRPScanPrintRdsKeys, 'SRP_PROFILE_PATH', 'X' ) SRPCnt = COUNT( SRPPointers, @fm ) + (SRPPointers NE '') IF SRPCnt > 0 THEN Def = "" Def = 'Printing SRP sheets ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) FOR I = 1 TO SRPCnt TheseSRPs = SRPPointers Pcnt = COUNT( TheseSRPs, @vm ) + (TheseSRPs NE '') FOR J = 1 TO Pcnt ThisSRP = TheseSRPs<1,J> IF ThisSRP NE '' THEN Print_SRP( ThisSRP, PrintPath, PDFFileName , PrinterInitialized, HideUI) END NEXT J NEXT I If HideUI EQ False$ then Msg(@WINDOW,MsgUp) END NEXT WOStep Stat = Set_Printer('TERM') Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Called TERM Method', @RM, @FM, '') Success = Utility('COPYFILE', PDFFileName, TruePDFFileName) Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Called COPYFILE Method', @RM, @FM, '') Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' SourceFile : ' : PDFFileName, @RM, @FM, '') Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' DestFile : ' : TruePDFFileName, @RM, @FM, '') LengthSourceFile = Dir(PDFFileName)<1> LengthDestFile = Dir(TruePDFFileName)<1> If Success NE True$ then EmailAddresses = 'Daniel.Stieber@infineon.com,francois.rivard@infineon.com,jonathan.ouellette@infineon.com' EmailMessage = LoggingDTM : ' ' : 'WONo = ' : ShipWONo : ', ShipNo = ' : ShipNo : ', COPYFILE Success = ' : Success end else EmailAddresses = '' EmailMessage = '' end Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' COPYFILE Success : ' : Success, @RM, @FM, '', EmailAddresses, EmailMessage) Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Length of SourceFile : ' : LengthSourceFile, @RM, @FM, '') Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' Length of DestFile : ' : LengthDestFile, @RM, @FM, '') If Success then OSDelete PDFFileName Begin Case Case CustNo EQ '7127' // Samsung Host = 'sFTPNA.extra.infineon.com' Username = 'DNAMesaFI-FTP' Password = 'OpenInsight2018....!' RemoteDirectory = '/Samsung' ProcessDirectory = Environment_Services('GetApplicationRootPath') : '\Ship_Processed\Samsung\' SSH = True$ FTP_Services('PostRequest', 'put', Host, 'MESSA01EC', TruePDFFileName, '', Username, Password, '', RemoteDirectory, '', '', True$, SSH, ProcessDirectory, 3, False$) Case CustNo EQ '7126' // SGM Host = 'sFTPNA.extra.infineon.com' Username = 'DNAMesaFI-FTP' Password = 'OpenInsight2018....!' RemoteDirectory = '/SGM' ProcessDirectory = Environment_Services('GetApplicationRootPath') : '\Ship_Processed\SGM\' SSH = True$ FTP_Services('PostRequest', 'put', Host, 'MESSA01EC', TruePDFFileName, '', Username, Password, '', RemoteDirectory, '', '', True$, SSH, ProcessDirectory, 3, False$) Case CustNo EQ '7102' OR CustNo EQ '7125' // Vanguard Host = 'sFTPNA.extra.infineon.com' Username = 'DNAMesaFI-FTP' Password = 'OpenInsight2018....!' RemoteDirectory = '/Vanguard' ProcessDirectory = Environment_Services('GetApplicationRootPath') : '\Ship_Processed\Vanguard\' SSH = True$ FTP_Services('PostRequest', 'put', Host, 'MESSA01EC', TruePDFFileName, '', Username, Password, '', RemoteDirectory, '', '', True$, SSH, ProcessDirectory, 3, False$) Case CustNo EQ '7108' // Episil Host = 'sFTPNA.extra.infineon.com' Username = 'DNAMesaFI-FTP' Password = 'OpenInsight2018....!' RemoteDirectory = '/Episil' ProcessDirectory = Environment_Services('GetApplicationRootPath') : '\Ship_Processed\EpiSil\' SSH = True$ FTP_Services('PostRequest', 'put', Host, 'MESSA01EC', TruePDFFileName, '', Username, Password, '', RemoteDirectory, '', '', True$, SSH, ProcessDirectory, 3, False$) Case CustNo EQ '7053' // Tower Host = 'sFTPNA.extra.infineon.com' Username = 'DNAMesaFI-FTP' Password = 'OpenInsight2018....!' RemoteDirectory = '/Tower' ProcessDirectory = Environment_Services('GetApplicationRootPath') : '\Ship_Processed\Tower\' SSH = True$ FTP_Services('PostRequest', 'put', Host, 'MESSA01EC', TruePDFFileName, '', Username, Password, '', RemoteDirectory, '', '', True$, SSH, ProcessDirectory, 3, False$) Case CustNo EQ '6874' OR CustNo EQ '7055' // Wales/Newport Host = 'sFTPNA.extra.infineon.com' Username = 'DNAMesaFI-FTP' Password = 'OpenInsight2018....!' RemoteDirectory = '/Newport' ProcessDirectory = Environment_Services('GetApplicationRootPath') : '\Ship_Processed\Newport\' SSH = True$ FTP_Services('PostRequest', 'put', Host, 'MESSA01EC', TruePDFFileName, '', Username, Password, '', RemoteDirectory, '', '', True$, SSH, ProcessDirectory, 3, False$) End Case end Transfer TruePDFFileName to PDFFileName IF eMailAddr NE '' THEN * * * * * * * * Get and eMail documents InitDir eMailPath:'*.pdf' FileList = DirList() *** Parameter setup of SRP_Send_Mail *** ConfigFile = '' ConfigFile<1> = SendUsing_Port$ ConfigFile<2> = '' ConfigFile<3> = 25 ;// Server port ConfigFile<4> = 'smtp.intra.infineon.com' ;// Infineon Mail Server ConfigFile<5> = Yes$ ;// Authenticate ConfigFile<6> = 'oinotify@infineon.com' ;// Username ********************* Suspected Problem ******************* ConfigFile<7> = 'oinotify1' ;// Password ********************* Suspected Problem ******************* ConfigFile<8> = No$ ;// Use SSL SentFrom = 'oinotify@infineon.com' ;* Sent From eMail addr SendTo = eMailAddr ;* eMailAddr (comma separated) Message = '' Message<1> = eMailHeader ; // Subject Message<2> = SentFrom ; // From (email address) Message<3> = SendTo ; // Send to (email address) Message<5> = '' ; // Blind Carbon Copy (email address) Message<6> = '' ; // Reply To (email address) Message<7> = 'TEXT' ; // Content Type (TEXT or HTML) Message<8> = eMailText ; // Content / Body Message<9> = PDFFileName ; // Attachment(s) (path to file name(s)) Def = "" Def = 'Sending eMail w/attachements ':ShipNo:'...' Def = "U" If HideUI EQ False$ then MsgUp = Msg(@window, Def) MsgSent = 1 If HideUI EQ False$ then Msg(@WINDOW,MsgUp) mbParms = 'SHIP_EMAIL_QUEUE':@RM:ShipNo:@RM:@RM IF MsgSent = 1 THEN NULL /* Prevent deleting the shippment numbers from the queue after clicking on the "Transmit" button */ END ELSE Set_Status(0) TypeOver = '' TypeOver = 'eMail Server Error' If HideUI EQ False$ then void = Msg(@WINDOW,TypeOver,'TWO_SECONDS') END * * * * * * * * * * * * * End of eMail section END ELSE NULL /* Prevent deleting the shippment numbers from the queue after clicking on the "Transmit" button */ END ;* End of check for AutoPrint Logging_Services('AppendLog', objLog, LoggingDTM : @FM : ShipWONO : @FM: ShipNo : @FM : ' End PRINT_SHIPMENT_DEV', @RM, @FM, '') end RETURN '' * * * * * * * PrintCocFront: * * * * * * * ShipDt = OCONV(ShipRec,'D4/') IF XLATE('COC',ShipNo,'WO_CUST_NO','X') = '7067' THEN CustAddrInfo = XLATE('COC',ShipNo,'ORD_SHIP_TO_INFO','X') ;* Added customer specific code 3/4/2010 JCH END ELSE CustAddrInfo = XLATE('COC',ShipNo,'ORD_BILL_TO_INFO','X') END SWAP @TM WITH CRLF$ IN CustAddrInfo * Bill to and Ship to information stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') colFormat = '>1440' colFormat<1,2> = '<9360' colData = 'Ship Dt:' colData<1,2> = ShipDt colData<3,1> = 'Customer:' colData<3,2> = CustAddrInfo font<1> = 'Courier New' font<2> = 12 font<4> = 0 stat = Set_Printer('FONT',font) stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_NONE) stat = Set_Printer('TEXT') PSNo = XLATE('WO_STEP',ShipWONo:'*':WOStep,WO_STEP_PROD_SPEC_ID$,'X') Dopant = XLATE('PROD_SPEC',PSNo,'DOPANT_L1','X') Recipe = XLATE('PROD_SPEC',PSNo,'RECIPE_NAME','X') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') colFormat = '<10800' colData = 'The enclosed material has been manufactured, inspected and/or tested in the' colData := ' U.S.A. in accordance with specifications outlined on your purchase order.' font<1> = 'Courier New' font<2> = 10 font<4> = 0 ;* Bold off font<5> = 0 ;* Italic off stat = Set_Printer('FONT',font) stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_NONE) stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') IF WOStepCnt = 1 THEN PrintWO = ShipWONo END ELSE PrintWO = ShipWONo:'.':WOStep END font<1> = 'Courier New' font<2> = 10 font<4> = 1 ;* Bold on stat = Set_Printer('FONT',font) IF ProdOrdNo = '' THEN colData = 'This material was processed as Work Order Number: ':quote( PrintWO ):' and manufactured under process control recipe ':quote(Recipe):'.' END ELSE colData = 'This material was released as Production Order No: ':QUOTE(ProdOrdNo):', processed as Work Order Number: ':quote( PrintWO ) colData :=' and manufactured under process control recipe ':quote(Recipe):'.' END stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_NONE) stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') font<2> = 10 font<4> = 0 ;* Bold off stat = Set_Printer('FONT',font) colData = 'Pertinent test and/or inspection records are on file and available for review' IF PrintBackPage THEN colData := ' under run numbers specified in the following page(s) of this document.' END ELSE colData := '.' END stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_NONE) stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') stat = Set_Printer('TEXT') colHeading = 'Approved By:' ; colFormat = '<7200' colHeading<1,2> = 'Date:' ; colFormat<1,2> = '<2880' colData = '' colData<3,2> = OCONV(Date(),'D4,HL') colData<5,1> = 'Document Control' stat = Set_Printer('ADDTABLE',colFormat,colHeading,'','','',0,TB_BOTTOM) stat = Set_Printer('ADDTABLE',colFormat,'',colData,'','',1,TB_NONE) for k = 1 to 7 Void = set_printer( 'TEXT', '' ) next k Font<4> = 1 Void = set_printer( 'FONT', Font ) * PrintWO is set about twenty lines up TextOut = 'Quality Assurance Registration Number ':quote( PrintWO ) Void = set_printer( 'TEXT', TextOut ) Font<4> = 0 Void = set_printer( 'FONT', Font ) RETURN