COMPILE SUBROUTINE Print_Gross_Margin(Dummy) /* Print Gross Margin Report 10/13/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 $INSERT OIPRINT_EQUATES $INSERT SCHEDULE_EQU $INSERT APPCOLORS $INSERT MSG_EQUATES EQU TAB$ TO \09\ EQU TARGET_ACTIVELIST$ TO 5 ErrorTitle = 'Error in stored procedure Print_Gross_Margin' OPEN 'SCHEDULE' TO ScheduleTable ELSE ErrorMsg = 'Unable to open "SCHEDULE" table.' ErrMsg(ErrorTitle:@SVM:ErrorMsg) RETURN END OPEN 'DICT.SCHEDULE' TO @DICT ELSE ErrorMsg = 'Unable to open "SCHEDULE" table.' ErrMsg(ErrorTitle:@SVM:ErrorMsg) RETURN END Def = "" Def = "Enter Beginning Ship Date:" Def = "RCE" Def = "?" * * * * * * * GetStartDt: * * * * * * * StartDtIn = Msg(@window, Def) IF StartDtIn = CHAR(27) THEN RETURN ;* Canceled StartDt = ICONV(StartDtIn,'D') IF StartDt = '' THEN ErrMsg('Invalid Date Entered: ':QUOTE(StartDtIn)) GOTO GetStartDt END * * * * * * * GetEndDt: * * * * * * * Def = "Enter Ending Ship Date:" EndDtIn = MSG(@WINDOW,Def) IF EndDtIn = CHAR(27) THEN RETURN ;* Canceled EndDt = ICONV(EndDtIn,'D') IF EndDt = '' THEN ErrMsg('Invalid Date Entered: ':QUOTE(EndDtIn)) GOTO GetEndDt END Set_Status(0) SelectSent = 'SELECT SCHEDULE WITH SHIP_DATE FROM ':QUOTE(OCONV(StartDt,'D4/')):' TO ':QUOTE(OCONV(EndDt,'D4/')) RList(SelectSent,TARGET_ACTIVELIST$,'','','') IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END * Start of printing process FileName = 'Print Gross Margin Report' Title = 'Printing Gross Margin Report':@VM:'Schedules' 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 ':OCONV(StartDt,'D4/'):' Thru ':OCONV(EndDt,'D4/') Header = @VM:obj_Install('Get_Prop','CompTitle'):' Gross Margins Report' Header<-1> = @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 = 'Cust No' ; colFmt = '^720' colHead<1,2> = 'Customer Name' ; colFmt<1,2> = '<4320' colHead<1,3> = 'PSN' ; colFmt<1,3> = '^720' colHead<1,4> = 'Ship Qty' ; colFmt<1,4> = '>1440' colHead<1,5> = 'Ship Amount' ; colFmt<1,5> = '>1440' colHead<1,6> = 'Std Cost' ; colFmt<1,6> = '>1440' colHead<1,7> = 'Gross':CRLF$:'Margin' ; colFmt<1,7> = '^720' * Zero Accumulators For Each Break Ship_Qty.Cust_No.Total = 0 Ship_Qty.Cust_No.Count = 0 Ship_Qty.Prod_Spec_ID.Total = 0 Ship_Qty.Prod_Spec_ID.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.Prod_Spec_ID.Total = 0 Ship_Amount.Prod_Spec_ID.Count = 0 Ship_Amount.Grand.Total = 0 Ship_Amount.Grand.Count = 0 Std_Cost.Cust_No.Total = 0 Std_Cost.Cust_No.Count = 0 Std_Cost.Prod_Spec_ID.Total = 0 Std_Cost.Prod_Spec_ID.Count = 0 Std_Cost.Grand.Total = 0 Std_Cost.Grand.Count = 0 Gross_Margin.Cust_No.Total = 0 Gross_Margin.Cust_No.Count = 0 Gross_Margin.Prod_Spec_ID.Total = 0 Gross_Margin.Prod_Spec_ID.Count = 0 Gross_Margin.Grand.Total = 0 Gross_Margin.Grand.Count = 0 * Null Previous Break Buckets Prev.Cust_No='' Last.Cust_No.Break = 1 Prev.Prod_Spec_ID='' Last.Prod_Spec_ID.Break = 1 * * * * * * * ReadRecord: * * * * * * * * Zero Break Flags To False Cust_No.Break = 0 Prod_Spec_ID.Break = 0 READNEXT @ID, WhichValue ELSE LastRecord = 1 Cust_No.Break = 1 Cust_No = Prev.Cust_No Prod_Spec_ID.Break = 1 Prod_Spec_ID = Prev.Prod_Spec_ID END S.ATID = @ID IF FirstPass AND LastRecord THEN GOTO Bail END IF LastRecord THEN GOTO BREAKS READO @RECORD FROM ScheduleTable,@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_NAME} I.Cust_Name = S.Cust_Name S.Prod_Spec_ID = {PROD_SPEC_ID} I.Prod_Spec_ID = S.Prod_Spec_ID S.Ship_Date = {SHIP_DATE}<1,WhichValue> IF S.Ship_Date < StartDt OR S.Ship_Date > EndDt THEN GOTO ReadRecord ;* Limit multivalues to date range. * Initialize Multivalue Break Check Variables M.Ship_Qty = {SHIP_QTY}<1,WhichValue> ; P.Ship_Qty = 1 ; C.Ship_Qty = 7 S.Ship_Qty = M.Ship_Qty M.Ship_Amount = {SHIP_AMOUNT}<1,WhichValue> ; P.Ship_Amount = 1 ; C.Ship_Amount = 7 S.Ship_Amount = M.Ship_Amount M.Std_Cost = {STD_COST}<1,WhichValue> ; P.Std_Cost = 1 ; C.Std_Cost =7 S.Std_Cost = M.Std_Cost M.Gross_Margin = {GROSS_MARGIN}<1,WhichValue> ; P.Gross_Margin = 1 ; C.Gross_Margin = 7 S.Gross_Margin = M.Gross_Margin 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_No.Break += 1 Prod_Spec_ID.Break = 3 END IF (S.Prod_Spec_ID NE Prev.Prod_Spec_ID) OR Prod_Spec_ID.Break THEN Prod_Spec_ID = Prev.Prod_Spec_ID Prev.Prod_Spec_ID = S.Prod_Spec_ID Prod_Spec_ID.Break += 1 END IF FirstPass THEN FirstPass= 0 GOTO Detail END * * * * * * * BREAKS: * * * * * * * * Print Break Total(s) And Accumulate Total(s) IF Prod_Spec_ID.Break THEN colData = "" colData<1,2> = TAB$:TAB$:'PSN SubTotal:' colData<1,3> = '* * *' colData<1,4> = OCONV(Ship_Qty.Prod_Spec_ID.Total ,"MD0,") colData<1,5> = OCONV(Ship_Amount.Prod_Spec_ID.Total ,"MD2,$") colData<1,6> = OCONV(Std_Cost.Prod_Spec_ID.Total ,"MD2,$Z") IF Ship_Amount.Prod_Spec_ID.Total EQ 0 OR Std_Cost.Prod_Spec_ID.Total = 0 THEN colData<1,7> = '' END ELSE IntPercent = INT(((Ship_Amount.Prod_Spec_ID.Total - Std_Cost.Prod_Spec_ID.Total)/Ship_Amount.Prod_Spec_ID.Total * 100)) colData<1,7> = OCONV(IntPercent,"MD0S%") END GOSUB PrintTable Ship_Qty.Cust_No.Total += Ship_Qty.Prod_Spec_ID.Total ; Ship_Qty.Prod_Spec_ID.Total = 0 Ship_Qty.Cust_No.Count += Ship_Qty.Prod_Spec_ID.Count ; Ship_Qty.Prod_Spec_ID.Count = 0 Ship_Amount.Cust_No.Total += Ship_Amount.Prod_Spec_ID.Total ; Ship_Amount.Prod_Spec_ID.Total = 0 Ship_Amount.Cust_No.Count += Ship_Amount.Prod_Spec_ID.Count ; Ship_Amount.Prod_Spec_ID.Count = 0 Std_Cost.Cust_No.Total += Std_Cost.Prod_Spec_ID.Total ; Std_Cost.Prod_Spec_ID.Total = 0 Std_Cost.Cust_No.Count += Std_Cost.Prod_Spec_ID.Count ; Std_Cost.Prod_Spec_ID.Count = 0 Gross_Margin.Cust_No.Total += Gross_Margin.Prod_Spec_ID.Total ; Gross_Margin.Prod_Spec_ID.Total = 0 Gross_Margin.Cust_No.Count += Gross_Margin.Prod_Spec_ID.Count ; Gross_Margin.Prod_Spec_ID.Count = 0 END IF Cust_No.Break THEN colData = "" colData<1,1> = '* * *' colData<1,2> = TAB$:'Cust SubTotal:' colData<1,4> = OCONV(Ship_Qty.Cust_No.Total ,"MD0,") colData<1,5> = OCONV(Ship_Amount.Cust_No.Total ,"MD2,$") colData<1,6> = OCONV(Std_Cost.Cust_No.Total ,"MD2,$Z") IF Ship_Amount.Cust_No.Total EQ 0 OR Std_Cost.Cust_No.Total = 0 THEN colData<1,7> = '' END ELSE IntPercent = INT(((Ship_Amount.Cust_No.Total - Std_Cost.Cust_No.Total)/Ship_Amount.Cust_No.Total * 100)) colData<1,7> = OCONV(IntPercent,"MD0S%") END GOSUB PrintTable stat = Set_Printer('TEXT','') 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 Std_Cost.Grand.Total+=Std_Cost.Cust_No.Total ; Std_Cost.Cust_No.Total = 0 Std_Cost.Grand.Count+=Std_Cost.Cust_No.Count ; Std_Cost.Cust_No.Count = 0 Gross_Margin.Grand.Total+=Gross_Margin.Cust_No.Total ; Gross_Margin.Cust_No.Total = 0 Gross_Margin.Grand.Count+=Gross_Margin.Cust_No.Count ; Gross_Margin.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> = '' colData<1,4> = OCONV(Ship_Qty.Grand.Total ,"MD0,") colData<1,5> = OCONV(Ship_Amount.Grand.Total ,"MD2,$") colData<1,6> = OCONV(Std_Cost.Grand.Total ,"MD2,$Z") IF Ship_Amount.Grand.Total EQ 0 OR Std_Cost.Grand.Total = 0 THEN colData<1,7> = '' END ELSE IntPercent = INT(((Ship_Amount.Grand.Total - Std_Cost.Grand.Total)/Ship_Amount.Grand.Total * 100)) colData<1,7> = OCONV(IntPercent,"MD0S%") END 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 IF C.Std_Cost GE PREVIOUS.MARK.LEVEL THEN REMOVE I.Std_Cost FROM M.Std_Cost AT P.Std_Cost SETTING C.Std_Cost S.Std_Cost=I.Std_Cost END IF C.Std_Cost GT New.Mark.Level THEN New.Mark.Level=C.Std_Cost IF C.Gross_Margin GE PREVIOUS.MARK.LEVEL THEN REMOVE I.Gross_Margin FROM M.Gross_Margin AT P.Gross_Margin SETTING C.Gross_Margin S.Gross_Margin=I.Gross_Margin END IF C.Gross_Margin GT New.Mark.Level THEN New.Mark.Level=C.Gross_Margin * Do Conversions If Any IF S.Cust_No NE "" THEN S.Cust_No = OCONV(S.Cust_No,"MD0") IF S.Prod_Spec_ID NE "" THEN S.Prod_Spec_ID=OCONV(S.Prod_Spec_ID,"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,$") IF S.Std_Cost NE "" THEN S.Std_Cost=OCONV(S.Std_Cost,"MD2,$Z") IF S.Gross_Margin NE "" THEN S.Gross_Margin=OCONV(S.Gross_Margin,"MD0S%") * Accumulate Total(s) IF NUM(I.Ship_Qty) AND I.Ship_Qty NE "" THEN Ship_Qty.Prod_Spec_ID.Total += I.Ship_Qty Ship_Qty.Prod_Spec_ID.Count += 1 I.Ship_Qty = '' END IF NUM(I.Ship_Amount) AND I.Ship_Amount NE "" THEN Ship_Amount.Prod_Spec_ID.Total += I.Ship_Amount Ship_Amount.Prod_Spec_ID.Count += 1 I.Ship_Amount = '' END IF NUM(I.Std_Cost) AND I.Std_Cost NE "" THEN Std_Cost.Prod_Spec_ID.Total += I.Std_Cost Std_Cost.Prod_Spec_ID.Count += 1 I.Std_Cost = '' END IF NUM(I.Gross_Margin) AND I.Gross_Margin NE "" THEN Gross_Margin.Prod_Spec_ID.Total += I.Gross_Margin Gross_Margin.Prod_Spec_ID.Count += 1 I.Gross_Margin = '' END * Print Detail Line colData = "" colData<1,1> = S.Cust_No colData<1,2> = S.Cust_Name colData<1,3> = S.Prod_Spec_ID colData<1,4> = S.Ship_Qty colData<1,5> = S.Ship_Amount colData<1,6> = S.Std_Cost colData<1,7> = S.Gross_Margin GOSUB PrintTable IF New.Mark.Level THEN S.Cust_No = '' S.Cust_Name = '' S.Prod_Spec_ID = '' S.Ship_Qty = '' S.Ship_Amount = '' S.Std_Cost = '' S.Gross_Margin = '' 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> = 8 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> = 8 font<4> = 0 stat = Set_Printer('FONT',font,fontSpacing) stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL) END RETURN