COMPILE SUBROUTINE Print_ReadyToShip_EpiPRO( Dummy ) /* Print Ready to Ship for EpiPRO Routine 06/28/2006 - John C. Henry, J.C. Henry, Inc. - Initial coding */ DECLARE SUBROUTINE Reduce,MSG,Utility,ErrMsg, Set_Status, Btree.Extract, RList, Make.List DECLARE FUNCTION Set_Printer,Get_Printer,Msg, Get_Status, Dialog_Box, obj_Install DECLARE FUNCTION FieldCount,Get_Status,Set_Status,Set_FSError,Printer_Select $INSERT OIPRINT_EQUATES $INSERT RDS_EQU $INSERT APPCOLORS EQU CRLF TO \0D0A\ ;* CHAR(13):CHAR(10) for multiline messages EQU TAB TO CHAR(9) ;* TAB character ErrorTitle = 'Error in Store Procedure Print_ReadyToShip_EpiPRO' OPEN 'WM_OUT' TO WMOTable ELSE ErrorMsg = 'Unable to Open "WM_OUT" table!' Set_Status(1,ErrorTitle:@SVM:ErrorMsg) RETURN END OPEN 'DICT.WM_OUT' TO @DICT ELSE ErrorMsg = 'Unable to Open "DICT.WM_OUT" table!' Set_Status(1,ErrorTitle:@SVM:ErrorMsg) RETURN END Results = Dialog_Box( 'RDS_SRPT2', @WINDOW, '' ) IF Results = 'CANCEL' OR Results = '' THEN RETURN StartDt = Results[1,'*'] EndDt = Results[COL2()+1,'*'] SelectSent = 'SELECT WM_OUT WITH CURR_STATUS = "RTS" ' HeaderDateLine = '' BEGIN CASE CASE EndDt = '' AND StartDt NE '' SelectSent := ' AND WITH PROMISE_SHIP_DT GE ':QUOTE(StartDt) HeaderDateLine = 'Final Commit Dates from ':StartDt:' through ':OCONV(Date(),'D4/') CASE StartDt = '' AND EndDT NE '' SelectSent := ' AND WITH PROMISE_SHIP_DT LE ':QUOTE(EndDt) HeaderDateLine = 'Final Commit Dates Through ':EndDt CASE EndDt NE '' AND StartDt NE '' SelectSent := 'AND WITH PROMISE_SHIP_DT FROM ':QUOTE(StartDt):' TO ':QUOTE(EndDt) HeaderDateLine = 'Final Commit Dates from ':StartDt:' through ':EndDt CASE 1 HeaderDateLine = 'With all Final Commit Dates' END CASE SelectSent := ' BY CUST_NAME BY WO_NO ' Set_Status(0) EQU TARGET_ACTIVELIST$ TO 5 RList(SelectSent, TARGET_ACTIVELIST$, "", "", "") IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END **START PRINTING PROCESS** FileName = 'Print Ready To Ship' Title = 'Printing Ready To Ship':@VM:'Report' TopMargin = 1.0 BottomMargin = 1.0 LeftMargin = 0.5 RightMargin = 0.5 Margins = LeftMargin:@FM:TopMargin:@FM:RightMargin:@FM:BottomMargin PageSetup = '1' ;* Portrait PrintSetup = '2' ;* Preview Normal PrintPath = Printer_Select('',1) ;* Get Default printer path stat = Set_Printer("INIT",FileName,Title,Margins,PageSetup,PrintSetup,PrintPath) IF stat < 0 THEN GOTO OIPrint_Err Header = @VM:obj_Install('Get_Prop','CompTitle'):' Ready To Ship Report' Header<2> = @VM:HeaderDateLine Header<3> = '' font = 'Arial' font<2> = '10' font<4> = 1 ;* Bold stat = Set_Printer("FONTHEADFOOT", font) stat = Set_Printer("HEADER",Header) footer = " 'D' 'T'":@VM:@VM:" Page: 'P'" colfooter = " " stat = Set_Printer("FOOTER",footer,colfooter) @RECCOUNT = 0 FirstPass = 1 LastRecord = 0 ReadErr = 0 FirstLine = 1 * * * * * * * READRECORD: * * * * * * * READNEXT @ID ELSE LastRecord = 1 END IF FirstPass AND LastRecord THEN GOTO Bail END READO @RECORD FROM WMOTable,@ID ELSE stat = Set_Printer('TEXT', 'Unable to read record ':QUOTE(@ID):' from WM_OUT table.') GOTO READRECORD END @RECCOUNT += 1 CustName = {CUST_NAME} WMOCassNo = {WMO_NO} CustShipDt = OCONV({CUST_SHIP_DT},'D4/') FinalCommDt = OCONV({PROMISE_SHIP_DT},'D4/') ShipPartial = OCONV({SHIP_PARTIAL},'B') HoldStatus = OCONV({HOLD},'B') CurrStatus = {CURR_STATUS} WONo = WMOCassNo[1,'.'] CassNo = WMOCassNo[-1,'B.'] CurrLoc = XLATE('WO_MAT',WONo:'*':CassNo,'CURR_LOCATION','X') IF CurrStatus NE 'RTS' THEN GOTO READRECORD colHeader = 'Customer' ; colFmt = '<+3780' colHeader<1,2> = 'WMO No' ; colFmt<1,2> = '<+1080' colHeader<1,3> = 'Cust Ship':CRLF:'Date' ; colFmt<1,3> = '^+1080' colHeader<1,4> = 'Final':CRLF:'Commit':CRLF:'Date' ; colFmt<1,4> = '^+1080' colHeader<1,5> = 'Ship':CRLF:'Partial' ; colFmt<1,5> = '^+990' colHeader<1,6> = 'Hold' ; colFmt<1,6> = '^+990' colHeader<1,7> = 'Curr Loc' ; colFmt<1,7> = '<+1440' colData = CustName colData<1,2> = WMOCassNo colData<1,3> = CustShipDt colData<1,4> = FinalCommDt colData<1,5> = ShipPartial colData<1,6> = HoldStatus colData<1,7> = CurrLoc fontSpacing = 150 GOSUB PrintTable IF LastRecord THEN GOTO Bail END * * * * * * * DETAIL: * * * * * * * GOTO READRECORD * * * * * * Bail: * * * * * * stat = Set_Printer("TERM",1) ;* Terminiate this printing session IF stat < 0 THEN GOTO OIPrint_Err Utility('CURSOR','A') RETURN * * * * * * * OIPrint_Err: * * * * * * * *Set Error for OIPrint function and return to calling procedure Msg('',stat) Error_Msg = 'Set_Printer Returned Error Status: ':QUOTE(stat) IF Get_Status(errCode) THEN Stat = Set_Status(-1,'STPROC',ErrorTitle:@SVM:Error_Msg) END ELSE Stat = Set_Status(1,'STPROC',ErrorTitle:@SVM:Error_Msg) END stat = Set_Printer('TERM',1) RETURN * * * * * * PrintTable: * * * * * * stat = Set_Printer('CALCTABLE',colFmt:@FM:colData) TableSize = Get_Printer('CALCTABLE') TableHeight = TableSize<2> Test = Get_Printer('POS')<2> IF Get_Printer('POS')<2> + TableHeight > 6.50 OR FirstLine THEN IF NOT(FirstLine) THEN stat = Set_Printer('PAGEBREAK') END FirstLine = 0 font<2> = 8 font<4> = 1 ;* Bold stat = Set_Printer('FONT',font,'100') stat = Set_Printer('ADDTABLE',colFmt,colHeader,'',LTGREY$,'',0,TB_ALL) font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7) END ELSE font<2> = 8 font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL) END RETURN