Skip Navigation Links.
Simple general ledger report example - RPGLE
Language(s):I-Series - RPGLE
Category(s):Reports

RPGLE Report Example Deomonstrates:1) Overflow record processing.2) Control breaks.3) Centering text on the page.

     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#

This article has been viewed 5340 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.