F***************************************************************
F** - Source Member: RPTESXR
F***************************************************************
F** - RPG III 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**
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 OF PRINTER
E**
E** - Header literals
E**
E H 1 2 72
E**
E**
E** - Used to center the text
E**
E TXT 72 1
ITEXT DS
I 1 72 TXT
C**
C *LIKE DEFN ACT# VACT#
C *LIKE DEFN SACT# VSACT#
C**
C** - Initialize
C**
C EXSR INIT
C**
C** - Loop 'till eof
C**
C READ RPTEXF 90
C *IN90 DOWEQ'0'
C**
C** - New page if overflow
C**
C *INOF IFEQ '1'
C EXSR NEWPGE
C ENDIF
C**
C** - Detail rec
C**
C EXSR PUTDTL
C**
C** - Next record
C**
C READ RPTEXF 90
C**
C ENDDO
C**
C** - Finalize
C**
C EXSR FINIT
C**
C SETON LR
C***************************************************************
C** - INIT: Initialize, new page
C***************************************************************
C INIT BEGSR
C**
C TIME UTIME 60
C EXSR NEWPGE
C**
C ENDSR
C***************************************************************
C** - FINIT: Finalize, footer
C***************************************************************
C FINIT BEGSR
C**
C** - Put the last totals and grand total
C**
C SETON 4142
C EXCPTSACTTL
C EXCPTACTTL
C EXCPTFOOTER
C**
C ENDSR
C***************************************************************
C** - NEWPGE: Put a new page
C***************************************************************
C NEWPGE BEGSR
C**
C MOVEL'Y' PRTACT 1
C MOVEL*BLANKS HDR1 72
C MOVEL*BLANKS HDR2 72
C**
C** - Center HDR1 accross the page
C**
C MOVELH,1 @CNTR 72
C EXSR CENTER
C MOVEL@CNTR HDR1
C**
C** - Center HDR2 accross the page
C**
C MOVELH,2 @CNTR 72
C EXSR CENTER
C MOVEL@CNTR HDR2
C**
C EXCPTHEADER
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 ' ' CHEKR@CNTR L 30
C**
C** - Half of this subtracted from the max length will
C** - give us the position to cetner the string
C**
C 72 SUB L L
C L DIV 2 L
C MOVEA*BLANKS TXT
C MOVEA@CNTR TXT,L
C MOVEL*BLANKS @CNTR
C MOVEATXT @CNTR
C**
C ENDSR
C***************************************************************
C** - PUTDTL: Put a detail line
C***************************************************************
C PUTDTL BEGSR
C**
C** - Check for control breaks
C**
C SETOF 4142
C ACT# IFNE VACT#
C SETON 4142
C ELSE
C SACT# IFNE VSACT#
C SETON 42
C ENDIF SACT#<>VSACT#
C ENDIF ACT#<>VACT#
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 *IN42 IFEQ '1' SubAcct# BRK
C FSTTME IFEQ 'N' Skip first t
C EXCPTSACTTL
C ENDIF *IN42='1'
C ENDIF FSTTME='N'
C**
C** - Break on account# if a change - skip first time
C**
C *IN41 IFEQ '1' Acct# Break
C FSTTME IFEQ 'N' Skip first time
C EXCPTACTTL Out it goes
C ENDIF FSTTME='N'
C ENDIF *IN41='1'
C**
C** - Flag fist time flag
C**
C MOVEL'N' FSTTME 1
C**
C** - Save the save fields
C**
C Z-ADDACT# VACT#
C Z-ADDSACT# VSACT#
C**
C** - Sum the sums
C**
C ADD COST ATCOST 102
C ADD COST STCOST 102
C ADD COST GTCOST 112
C**
C** - If PRTACT='Y' print the account fields
C**
C PRTACT IFEQ 'Y'
C SETON 4142
C ENDIF PRTACT='Y'
C**
C EXCPTDETAIL
C**
C ADD 1 RECCNT 110
C**
C ENDSR
C**
OQPRINT E 1 1 HEADER
O HDR1 72
O UDATE Y 80
O**
O E 2 HEADER
O HDR2 72
O 75 'Page: '
O PAGE1 4 80
O**
O E 1 HEADER
O ' Account Number '
O ' '
O 'Sub Account Number'
O ' '
O 'Line Item/Description'
O**
O E 2 HEADER
O '----------------'
O ' '
O '------------------'
O ' '
O '------------------------'
O '-----'
O**
O EF 1 DETAIL
O 41 ACT# 13 ' - - '
O 42 SACT# 32 ' - - '
O LINE# 41 ' 0'
O DESC 67
O COST 80 ' , , . '
O**
O EF 1 SACTTL
O 32 '-----------'
O 50 '------------------'
O 70 '--------------------'
O 80 '----------'
O**
O EF 2 SACTTL
O VSACT# 32 ' - - '
O STCOST B 80 ' , , . '
O**
O EF 1 ACTTL
O ' ------------------'
O '--------------------'
O '--------------------'
O '--------------------'
O**
O EF 2 ACTTL
O VACT# 13 ' - - '
O ATCOST B 80 ' , , . '
O**
O E 1 FOOTER
O '--------------------'
O '--------------------'
O '--------------------'
O '--------------------'
O**
O E 1 FOOTER
O 65 'Grand total:'
O GTCOST B 80 ' , , . '
O**
O E 1 FOOTER
O '--------------------'
O '--------------------'
O '--------------------'
O '--------------------'
O**
O E 1 FOOTER
O ' '
O 'Records processed:'
O ' '
O RECCNT ' , , , 0'
** - Report headers
RPG III 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#