COMPILE SUBROUTINE Print_Billings(Dummy) /* Print Billings Report 07/29/2004 - 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_Billings' OPEN 'INVOICE' TO InvoiceTable ELSE ErrorMsg = 'Unable to open "INVOICE" table.' ErrMsg(ErrorTitle:@SVM:ErrorMsg) RETURN END OPEN 'DICT.INVOICE' TO @DICT ELSE ErrorMsg = 'Unable to open "INVOICE" 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 INVOICE WITH SHIP_DATE FROM ':QUOTE(StartDt):' TO ':QUOTE(EndDt):' BY CUST_NAME' RList(SelectSent,TARGET_ACTIVELIST$,'','','') IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END * Start of printing process FileName = 'Print Billings by Company Report' Title = 'Printing Billings 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'):' Billings 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> = 'Ship Qty' ; colFmt<1,3> = '>1800' colHead<1,4> = 'Ship Amount' ; colFmt<1,4> = '>1800' * Zero Accumulators For Each Break Ship_Qty.Cust_No.Total = 0 Ship_Qty.Cust_No.Count = 0 Ship_Qty.Grand.Total = 0 Ship_Qty.Grand.Count = 0 Ship_Amount.Cust_No.Total = 0 Ship_Amount.Cust_No.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 * * * * * * * ReadRecord: * * * * * * * * Zero Break Flags To False Cust_No.Break = 0 READNEXT @ID, WhichValue ELSE LastRecord = 1 Cust_No.Break = 1 Cust_No = Prev.Cust_No Cust_Name = Prev.Cust_Name END S.ATID = @ID IF FirstPass AND LastRecord THEN GOTO Bail END IF LastRecord THEN GOTO BREAKS READO @RECORD FROM InvoiceTable,@ID ELSE GOTO ReadRecord END @RECCOUNT += 1 * Calculate Value(s) For Column(s) S.ATID = { @ID} I.ATID = S.ATID S.Cust_No = {CUST_NO} I.Cust_No = S.Cust_No S.Cust_Name = {CUST_CITY} SWAP '/' WITH ' - ' IN S.Cust_Name I.Cust_Name = S.Cust_Name S.Ship_Date = {SHIP_DATE}<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_Qty = {TOTAL_SHIP_QUANTITY}<1,WhichValue> ; P.Ship_Qty = 1 ; C.Ship_Qty = 7 S.Ship_Qty = M.Ship_Qty M.Ship_Amount = {TOTAL_SHIP_AMOUNT}<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.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> = OCONV(Ship_Qty.Cust_No.Total ,"MD0,") colData<1,4> = OCONV(Ship_Amount.Cust_No.Total ,"MD2,$") GOSUB PrintTable Ship_Qty.Grand.Total+=Ship_Qty.Cust_No.Total ; Ship_Qty.Cust_No.Total = 0 Ship_Qty.Grand.Count+=Ship_Qty.Cust_No.Count ; Ship_Qty.Cust_No.Count = 0 Ship_Amount.Grand.Total+=Ship_Amount.Cust_No.Total ; Ship_Amount.Cust_No.Total = 0 Ship_Amount.Grand.Count+=Ship_Amount.Cust_No.Count ; Ship_Amount.Cust_No.Count = 0 END * Perform Last Record Output If Done IF LastRecord THEN colData = "" colData<1,1> = '' colData<1,2> = 'Report Totals:' colData<1,3> = OCONV(Ship_Qty.Grand.Total ,"MD0,") 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_Qty GE PREVIOUS.MARK.LEVEL THEN REMOVE I.Ship_Qty FROM M.Ship_Qty AT P.Ship_Qty SETTING C.Ship_Qty S.Ship_Qty=I.Ship_Qty END IF C.Ship_Qty GT New.Mark.Level THEN New.Mark.Level = C.Ship_Qty 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_Qty NE "" THEN S.Ship_Qty=OCONV(S.Ship_Qty,"MD0") IF S.Ship_Amount NE "" THEN S.Ship_Amount=OCONV(S.Ship_Amount,"MD2,$") * Accumulate Total(s) IF NUM(I.Ship_Qty) AND I.Ship_Qty NE "" THEN Ship_Qty.Cust_No.Total += I.Ship_Qty Ship_Qty.Cust_No.Count += 1 I.Ship_Qty = '' END 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.Ship_Qty colData<1,4> = S.Ship_Amount *GOSUB PrintTable IF New.Mark.Level THEN S.Cust_No = '' S.Cust_Name = '' S.Ship_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