|
midrange.com
< C EVAL DSTOCKNO = ILNSTK
add this line
C exsr prtheading
< C DOW NOT %EOF(BRCHMARGIN)
<...
<...
< C EXSR PRTDETAIL
delete this line
C* EVAL *IN99 = *ON
< C ENDIF
Ed
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Douglas W. Palme
Sent: Thursday, May 12, 2005 3:56 PM
To: rpg400-l@xxxxxxxxxxxx
Subject: Need some help with a report
I have been moving along in my feeble attempt to gain as much rpg
knowledge as I can get, however I have a report that I need to produce
that has been giving me fits for four days and if anyone can provide any
assistance I would appreciate it.
I will post the source below. I have a logical file which contains
branch
(location) id, customer number, stock numbers, and each record is
equivalent to one line item from our sales. It is keyed by ilninv#a
(location id), ilnsoldto (customer number) and ilnstk (stock number), it
also has a range restriction on it for line items related to this fiscal
year. I am attempting to print out one detail line with the sum of
sales and costs for each stock number and customer number, with a page
break when the location id changes.
So far, every time I run the report it spits out over a 1,000 pages and
has produced as many as 89,000 pages....it appears to keep printing the
same header file over and over again.....
Any help, pointers or suggestions would be appreciated.
Douglas
'***********************************************************************
***
'* ORIGINAL DATE: 05/11/2005
'* APPLICATION NAME: BRANCH MARGIN REPORT
'* PROGRAM NAME: BRCHMARRPT
'* DESCRIPTION: 1. READ FIRST REC 2. CREATE
HEADING
'* 3. READ RECORDS INTO TOTALS
'* 4. BREAK ON STK NO, CUST NO AND
THE
'* BRANCH LOCATION
'***********************************************************************
***
'* LOG OF MODIFICATIONS
'*
'* DATE PGMR DESCRIPTION
'*----------------------------------------------------------------------
---
'* / /
'***********************************************************************
***
'* FUNCTION OF INDICATORS
'*
'* IND FUNCTION
'*----------------------------------------------------------------------
---
'* 99 OFLIND INDICATOR
'* INLR LAST RECORD INDICATOR
'***********************************************************************
***
'* SUBROUTINE INDEX
'***********************************************************************
***
'* PRTHEADING - PRINT HEADING SUB ROUTINE
'* BRCHLOOKUP - BRANCH LOOKUP SUB ROUTINE
'***********************************************************************
***
'* FILES
'***********************************************************************
***
FCUSTMLF IF E K DISK
FBRCHMARGINIF E K DISK
FBRCHMARLSTO E PRINTER OFLIND(*IN99)
'***********************************************************************
***
'* STANDALONE VARIABLES
'***********************************************************************
***
DDBRANCH S 20A
DDBRANCHID S 2A
DDSTOCKNO S 20A
DDDESC S 24A
DDCUSTNO S 9S 0
DDTSALES S 12S 2
DDTCOST S 12S 2
DDMARGIN S 12S 2
DDPCT S 4S 3
'***********************************************************************
***
'* MAINLINE
'***********************************************************************
***
'* READ THE FIRST RECORD IN THE FILE AND WRITE DATA TO
VARIABLES
'***********************************************************************
***
C READ BRANCH
* COPY DATA TO HOLDING AREA
C EVAL DBRANCHID = ILNINV#A
C EVAL DCUSTNO = ILNSOLDTO
C EVAL DSTOCKNO = ILNSTK
C DOW NOT %EOF(BRCHMARGIN)
C IF ILNINV#A = DBRANCHID
C IF ILNSOLDTO = DCUSTNO
C IF ILNSTK = DSTOCKNO
C EVAL DTSALES = DTSALES + ILNEPRICE
C EVAL DTCOST = DTCOST + ILNEUAVCST
C ELSE
C EXSR PRTDETAIL
C ENDIF
C ELSE
C EXSR PRTDETAIL
C ENDIF
C ELSE
C EXSR PRTDETAIL
C EVAL *IN99 = *ON
C ENDIF
C READ BRANCH
C ENDDO
C EVAL *INLR = *ON
C RETURN
************************************************************************
**
'* PRINT HEADINGS SUB-ROUTINE
'***********************************************************************
***
C PRTHEADING BEGSR
C EXSR BRCHLOOKUP
C EVAL PRTBRANCH = DBRANCH
C WRITE HEADINGS
C EVAL *IN99 = *OFF
C ENDSR
'***********************************************************************
***
'* BRANCH LOOKUP SUB-ROUTINE
'***********************************************************************
***
C BRCHLOOKUP BEGSR
C SELECT
C WHEN DBRANCHID = 'D '
C EVAL DBRANCH = 'DECATUR'
C WHEN DBRANCHID = 'A '
C EVAL DBRANCH = 'ALL COMPANY'
C WHEN DBRANCHID = 'J '
C EVAL DBRANCH = 'JACKSONVILLE'
C WHEN DBRANCHID = 'Q '
C EVAL DBRANCH = 'QUINCY'
C WHEN DBRANCHID = 'B '
C EVAL DBRANCH = 'RIVER BEND'
C WHEN DBRANCHID = 'S '
C EVAL DBRANCH = 'SPRINGFIELD'
C WHEN DBRANCHID = 'M '
C EVAL DBRANCH = 'MATTOON'
C WHEN DBRANCHID = 'V '
C EVAL DBRANCH = 'MOUNT VERNON'
C WHEN DBRANCHID = 'N '
C EVAL DBRANCH = 'PONTIAC'
C WHEN DBRANCHID = 'L '
C EVAL DBRANCH = 'LITCHFIELD'
C ENDSL
C ENDSR
'***********************************************************************
***
'* PRINT DETAIL SUB-ROUTINE
'***********************************************************************
***
C PRTDETAIL BEGSR
'* WRITE DATA TO VARIABLES AND MAKE NECESSARY CALCULATIONS
C IF DTSALES = 0
C ELSE
C EVAL DMARGIN = DTSALES - DTCOST
C EVAL DPCT = DMARGIN / DTSALES
C EVAL PRTCUSTNO = DCUSTNO
C EVAL PRTBRANCH = DBRANCH
C EVAL PRTSTKNO = DSTOCKNO
C EVAL PRTDESC = DDESC
C EVAL PRTSALES = DTSALES
C EVAL PRTCOST = DTCOST
C EVAL PRTMARGIN = DMARGIN
C EVAL PRTPCT = DPCT
C WRITE DETAIL
C EVAL DTSALES = ILNEPRICE
C EVAL DTCOST = ILNEUAVCST
C EVAL DBRANCHID = ILNINV#A
C EVAL DCUSTNO = ILNSOLDTO
C EVAL DSTOCKNO = ILNSTK
C EVAL DMARGIN = 0
C EVAL DPCT = 0
C ENDIF
C IF *IN99 = *ON
C EXSR PRTHEADING
C EVAL *IN99 = *OFF
C ENDIF
C ENDSR
'***********************************************************************
***
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing
list To post a message email: RPG400-L@xxxxxxxxxxxx To subscribe,
unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives at
http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
