F***************************************************************
F** - Source Member: RPTESXR
F***************************************************************
F** - RPGLE Report Example using Internal Print File
F** - Jon Vote 09/2002
F** - www.idioma-software.com
F***************************************************************
F**
F** - Note there is a DDS file the follows this source member
F** - If you are copying this from the web, be sure to seperate
F** - the source members. You will find 6 blank lines between this
F** - member and the DDS member.
F**
F** - This code was written specifically for the pupose of this
F** - and as such is rather simplified in terms of content
F** - in favor of methodology.
F**
F** - This program demonstrates the following:
F**
F** 1) Overflow Record Processing.
F** 2) Control breaks.
F** 3) Centering text on the page.
F**
F** - Related source members:
F** - RPTEXR: RPG III Report Example.
F** RPTEXP: Pysical file used with RPTEXR
F**
F** - Report input file
F**
FRPTEXP IF E K disk
FQPRINT O F 80 printer oflind(*inof)
D**
D** - Header literals
D**
D H S 72 dim(2) ctdata perrcd(1)
D**
D**
D** - Used to center the text
D**
D Text DS
D TXT 1 72
D dim(72)
D**
D** - Program variables
D**
D FirstTime s 1
D PrintAccount s 1
C *Like define ACT# SaveAct#
C *Like define SACT# SaveSAct#
C**
C** - Initialize
C**
C exsr Initialize
C**
C** - Loop 'till eof
C**
C read RPTEXF 90
C dow *in90='0'
C**
C** - New page if overflow
C**
C if *inof='1'
C exsr NewPage
C endif
C**
C** - Detail rec
C**
C exsr PutDetail
C**
C** - Next record
C**
C READ RPTEXF 90
C**
C ENDDO
C**
C** - Finalize
C**
C exsr Finalize
C**
C seton LR
C***************************************************************
C** - Initialize: Initialize, new page
C***************************************************************
C Initialize begsr
C**
C time UTime 6 0
C exsr NewPage
C**
C endsr
C***************************************************************
C** - Finalize: Finalize, footer
C***************************************************************
C Finalize begsr
C**
C** - Put the last totals and grand total
C**
C seton 4142
C except SACTTL
C except ACTTL
C except FOOTER
C**
C endsr
C***************************************************************
C** - NewPage: Put a new page
C***************************************************************
C NewPage begsr
C**
C eval PrintAccount='Y'
C**
C** - Center HDR1 accross the page
C**
C eval @CNTR='RPGLE Report Example '
C + 'using Internal Print '
C + 'File'
C exsr Center
C eval HDR1=@CNTR
C**
C** - Center HDR2 accross the page
C**
C eval @CNTR='Jon Vote 09/2002 - www.idioma-'
C + 'software.com'
C exsr CENTER
C eval HDR2=@CNTR
C**
C except HEADER
C**
C endsr
C***************************************************************
C** - CENTER: Center the text
C***************************************************************
C CENTER begsr
C**
C** - This will get the length of the string
C**
C ' ' CHECKR @CNTR L 3 0
C**
C** - Half of this subtracted from the max length will
C** - give us the position to cetner the string
C**
C eval l=((72 - %len(TXT))/2)
C movea *BLANKS TXT
C movea @CNTR TXT(L)
C movea *BLANKS @CNTR
C movea TXT @CNTR
C**
C endsr
C***************************************************************
C** - PutDetail: Put a detail line
C***************************************************************
C PutDetail begsr
C**
C** - Check for control breaks
C**
C setoff 4142
C if ACT#<>SaveAct#
C seton 4142
C else
C if SACT#<>SaveSAct#
C seton 42
C endif SACT#<>SaveSAct#
C endif ACT#<>SaveAct#
C**
C** - We have an account break if 41 is on and a subaccount
C** - break if 42 is on.
C**
C** - Break on sub account if a change - skip first time
C**
C if *in42='1'
C if FirstTime='N'
C except SACTTL
C endif *IN42='1'
C endif FSTTME='N'
C**
C** - Break on account# if a change - skip first time
C**
C if *in41='1'
C if FirstTime='N'
C except ACTTL Out it goes
C endif FSTTME='N'
C endif *IN41='1'
C**
C** - Flag fist time flag
C**
C eval FirstTime='N'
C**
C** - Save the save fields
C**
C eval SaveAct#=ACT#
C eval SaveSAct#=SACT#
C**
C** - Sum the sums
C**
C add Cost ActTotCost 10 2
C add Cost SubActTotCost 10 2
C add Cost GrandTotCost 11 2
C**
C** - If PrintAccount='Y' print the account fields
C**
C if PrintAccount='Y'
C seton 4142
C endif PRTACT='Y'
C**
C except DETAIL
C**
C add 1 RecordCount 11 0
C**
C endsr
C**
OQPRINT E HEADER 1 1
O HDR1 72
O UDATE Y 80
O**
O E HEADER 2
O HDR2 72
O 75 'Page: '
O PAGE1 4 80
O**
O E HEADER 1
O ' Account Number '
O ' '
O 'Sub Account Number'
O ' '
O 'Line Item/Description'
O**
O E HEADER 2
O '----------------'
O ' '
O '------------------'
O ' '
O '------------------------'
O '-----'
O**
O EF DETAIL 1
O 41 ACT# 13 ' - - '
O 42 SACT# 32 ' - - '
O LINE# 41 ' 0'
O DESC 67
O COST 80 ' , , . '
O**
O EF SACTTL 1
O 32 '-----------'
O 50 '------------------'
O 70 '--------------------'
O 80 '----------'
O**
O EF SACTTL 2
O SaveSAct# 32 ' - - '
O SubActTotCost B 80 ' , , . '
O**
O EF ACTTL 1
O ' ------------------'
O '--------------------'
O '--------------------'
O '--------------------'
O**
O EF ACTTL 2
O SaveAct# 13 ' - - '
O ActTotCost B 80 ' , , . '
O**
O E FOOTER 1
O '--------------------'
O '--------------------'
O '--------------------'
O '--------------------'
O**
O E FOOTER 1
O 65 'Grand total:'
O GrandTotCost B 80 ' , , . '
O**
O E FOOTER 1
O '--------------------'
O '--------------------'
O '--------------------'
O '--------------------'
O**
O E FOOTER 1
O ' '
O 'Records processed:'
O ' '
O RecordCount ' , , , 0'
** - Report headers
RPGLE Report Example using Internal Print File
Jon Vote 09/2002 - www.idioma-software.com
A**************************************************************
A** - Source member RPTEXP: File used with Report Example
A**************************************************************
A**
A** - Jon Vote
A** - 09/2002
A**
A** - Related source members:
A** - RPTEXR: Simple Name List Program
A**
A** - This file is used for the Report Example
A** - only and is not meant to demonstrate a properly
A** - normalized database!!
A**
A UNIQUE
A R RPTEXF TEXT('NAME LIST')
A**
A ACT# 9S 0 TEXT('Account Number')
A SACT# 9S 0 TEXT('Sub Account Number')
A LINE# 3S 0 TEXT('Line Item Number')
A DESC 25 TEXT('Line Item Description')
A COST 9S 2 TEXT('Cost')
A**
A** - This key is being defined here to simplify the example.
A** - Normally you should not key a physical file.
A**
A K ACT#
A K SACT#
A K LINE#