Simple general ledger report example.
Language(s):I-Series - RPG
Category(s):Reports

This report example shows:1) Overflow record processing.2) Control breaks.3) Centering text accross the page.

     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#

This article has been viewed 6538 times.
The examples on this page are presented "as is". They may be used in code as long as credit is given to the original author. Contents of this page may not be reproduced or published in any other manner what so ever without written permission from Idioma Software Inc.