COMPILE SUBROUTINE Print_Ship_GL(Dummy) /* Print Billings_Ship Report 10/29/2005 - John C. Henry, J.C. Henry & Co., Inc. - Initial coding */ DECLARE SUBROUTINE Utility, ErrMsg, Set_Status, Set_Printer, RList DECLARE FUNCTION Set_Printer, Get_Printer, Msg, Get_Status, Printer_Select, obj_Install, Dialog_Box $INSERT OIPRINT_EQUATES $INSERT INVOICE_EQU $INSERT APPCOLORS $INSERT MSG_EQUATES EQU TAB$ TO \09\ EQU TARGET_ACTIVELIST$ TO 5 ErrorTitle = 'Error in stored procedure Print_Ship_GL' OPEN 'COC' TO ShipmentTable ELSE ErrorMsg = 'Unable to open "COC" table.' ErrMsg(ErrorTitle:@SVM:ErrorMsg) RETURN END OPEN 'DICT.COC' TO @DICT ELSE ErrorMsg = 'Unable to open "COC" table.' ErrMsg(ErrorTitle:@SVM:ErrorMsg) RETURN END DateRange = Dialog_Box('DIALOG_DATE_RANGE',@WINDOW,'') StartDt = DateRange<1> EndDt = DateRange<2> Set_Status(0) SelectSent = 'SELECT COC WITH SHIP_DT FROM ':QUOTE(StartDt):' TO ':QUOTE(EndDt):' BY GL_CODE BY CUST_NAME' RList(SelectSent,TARGET_ACTIVELIST$,'','','') IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END * Start of printing process FileName = 'Print Shipments by GL Code by Company Report' Title = 'Printing Shipments by GL Code by Company' TopMargin = 1.0 BottomMargin = 0.75 LeftMargin = 0.5 RightMargin = 0.5 Margins = LeftMargin:@FM:TopMargin:@FM:RightMargin:@FM:BottomMargin PageSetup = '0' ;* Landscape = 1 PrintSetup = '2' ;* Preview Normal PrintPath = Printer_Select() stat = Set_Printer('INIT',FileName,Title,Margins,PageSetup,PrintSetup,PrintPath) IF stat < 0 THEN GOTO OIPrintErr DateRange = 'With Ship Dates From ':StartDt:' Thru ':EndDt Header = "'D'":@VM:obj_Install('Get_Prop','CompTitle'):' Shipments by GL Code by Company Report':@VM:"Page 'P'" Header<-1> = "'T'":@VM:DateRange Header<-1> = '' ;* Blank line following heading font = 'Arial' font<2> = '10' font<4> = '1' ;* Bold stat = Set_Printer('FONTHEADFOOT',font) ; IF stat < 0 THEN GOTO OIPrintErr stat = Set_Printer('HEADER',Header) ; IF stat < 0 THEN GOTO OIPrintErr Footer = " 'D' 'T'":@VM:@VM:"Page: 'P'" stat = Set_Printer('FOOTER',Footer) ; IF stat < 0 THEN GOTO OIPrintErr @RECCOUNT= 0 FirstPass = 1 LastRecord = 0 FirstLine = 1 * Make Column Heading colHead = '' ; colFmt = '' colHead<1,1> = 'Cust' ; colFmt<1,1> = '^720' colHead<1,2> = 'Customer Name' ; colFmt<1,2> = '<6480' colHead<1,3> = 'GL Code' ; colFmt<1,3> = '>1080' colHead<1,4> = 'Ship Amount' ; colFmt<1,4> = '>1800' * Zero Accumulators For Each Break Ship_Amount.Cust_No.Total = 0 Ship_Amount.Cust_No.Count = 0 Ship_Amount.GL_Code.Total = 0 Ship_Amount.GL_Code.Count = 0 Ship_Amount.Grand.Total = 0 Ship_Amount.Grand.Count = 0 * Null Previous Break Buckets Prev.Cust_No = '' Prev.Cust_Name = '' Last.Cust_No.Break = 1 Prev.GL_Code = '' Last.GL_Code.Break = 1 * * * * * * * ReadRecord: * * * * * * * * Zero Break Flags To False Cust_No.Break = 0 GL_Code.Break = 0 READNEXT @ID, WhichValue ELSE LastRecord = 1 Cust_No.Break = 1 Cust_No = Prev.Cust_No Cust_Name = Prev.Cust_Name GL_Code.Break = 1 GL_Code = Prev.GL_Code END S.ATID = @ID IF FirstPass AND LastRecord THEN GOTO Bail END IF LastRecord THEN GOTO BREAKS READO @RECORD FROM ShipmentTable,@ID ELSE GOTO ReadRecord END @RECCOUNT += 1 * Calculate Value(s) For Column(s) S.ATID = { @ID} I.ATID = S.ATID S.Cust_No = {WO_CUST_NO} I.Cust_No = S.Cust_No S.GL_Code = {GL_CODE} I.GL_Code = S.GL_CODE S.Cust_Name = {CUST_CITY} SWAP '/' WITH ' - ' IN S.Cust_Name I.Cust_Name = S.Cust_Name S.Ship_Date = {SHIP_DT}<1,WhichValue> IF S.Ship_Date < ICONV(StartDt,'D') OR S.Ship_Date > ICONV(EndDt,'D') THEN GOTO ReadRecord ;* Limit multivalues to date range. * Initialize Multivalue Break Check Variables M.Ship_Amount = {ITEM_EXT_AMT}<1,WhichValue> ; P.Ship_Amount = 1 ; C.Ship_Amount = 7 S.Ship_Amount = M.Ship_Amount Previous.Mark.Level= 0 * Test For Control Break(s) IF (S.GL_Code NE Prev.GL_Code) OR GL_Code.Break THEN GL_Code = Prev.GL_Code Prev.GL_Code = S.GL_Code GL_Code.Break += 1 Cust_No.Break = 3 END IF (S.Cust_No NE Prev.Cust_No) OR Cust_No.Break THEN Cust_No = Prev.Cust_No Prev.Cust_No = S.Cust_No Cust_Name = Prev.Cust_Name Prev.Cust_Name = S.Cust_Name Cust_No.Break += 1 END IF FirstPass THEN FirstPass= 0 GOTO Detail END * * * * * * * BREAKS: * * * * * * * * Print Break Total(s) And Accumulate Total(s) IF Cust_No.Break THEN colData = Cust_No colData<1,2> = Cust_Name colData<1,3> = '' colData<1,4> = OCONV(Ship_Amount.Cust_No.Total ,"MD2,$") GOSUB PrintTable Ship_Amount.GL_Code.Total += Ship_Amount.Cust_No.Total ; Ship_Amount.Cust_No.Total = 0 Ship_Amount.GL_Code.Count += Ship_Amount.Cust_No.Count ; Ship_Amount.Cust_No.Count = 0 END IF GL_Code.Break THEN colData = @VM:@VM:@VM colData<2,1> = '' colData<2,2> = ' Account ':GL_Code:' Sub-Total:' colData<2,3> = GL_Code colData<2,4> = OCONV(Ship_Amount.GL_Code.Total ,"MD2,$") colData<3> = @VM:@VM:@VM GOSUB PrintTable Ship_Amount.Grand.Total+=Ship_Amount.GL_Code.Total ; Ship_Amount.GL_Code.Total = 0 Ship_Amount.Grand.Count+=Ship_Amount.GL_Code.Count ; Ship_Amount.GL_Code.Count = 0 END * Perform Last Record Output If Done IF LastRecord THEN colData = "" colData<1,1> = '' colData<1,2> = 'Report Totals:' colData<1,3> = '' colData<1,4> = OCONV(Ship_Amount.Grand.Total ,"MD2,$") GOSUB PrintTable status = Set_Printer('TEXT','') status = Set_Printer('TEXT',@RECCOUNT:' Records Processed') GOTO Bail END * * * * * * * DETAIL: * * * * * * * * Remove Appropriate Value FromMulti-Valued Column(s) New.Mark.Level = 0 IF C.Ship_Amount GE PREVIOUS.MARK.LEVEL THEN REMOVE I.Ship_Amount FROM M.Ship_Amount AT P.Ship_Amount SETTING C.Ship_Amount S.Ship_Amount=I.Ship_Amount END IF C.Ship_Amount GT New.Mark.Level THEN New.Mark.Level=C.Ship_Amount * Do Conversions If Any IF S.Cust_No NE "" THEN S.Cust_No = OCONV(S.Cust_No,"MD0") IF S.Ship_Amount NE "" THEN S.Ship_Amount=OCONV(S.Ship_Amount,"MD2,$") * Accumulate Total(s) IF NUM(I.Ship_Amount) AND I.Ship_Amount NE "" THEN Ship_Amount.Cust_No.Total += I.Ship_Amount Ship_Amount.Cust_No.Count += 1 I.Ship_Amount = '' END * Print Detail Line colData = "" colData<1,1> = S.Cust_No colData<1,2> = S.Cust_Name colData<1,3> = S.GL_Code colData<1,4> = S.Ship_Amount *GOSUB PrintTable IF New.Mark.Level THEN S.Cust_No = '' S.Cust_Name = '' S.Ship_Qty = '' S.Misc_Qty = '' S.Ship_Amount = '' Previous.Mark.Level = New.Mark.Level GOTO Detail END GOTO ReadRecord * * * * * * * Bail: * * * * * * * stat = Set_Printer('TERM',1) RETURN * * * * * * * OIPrintErr: * * * * * * * ErrMsg(ErrorTitle:@SVM:ErrorMsg) ErrMsg(ErrorTitle:@SVM:'Set_Printer returned errorcode ':stat) 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 > 9.00 OR FirstLine THEN IF NOT(FirstLine) THEN stat = Set_Printer('PAGEBREAK') END FirstLine = 0 font<2> = 10 font<4> = 1 ;* Bold stat = Set_Printer('FONT',font,'100') stat = Set_Printer('ADDTABLE',colFmt,colHead,'',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> = 10 font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL) END RETURN