R2C - Translate RPG II Programs to COBOL Conversion Services

                 

Overview

The R2C software is designed to convert RPG II source programs automatically to high-quality COBOL programs, using the Automatic Mass Processing technology that has formed the basis of our software for over 20 years. R2C Conversion services are provided by LOGOS Computer Services LTD which is a UK registered company, the developer of this software tool is Carlos Aguilera Sr.

The software mass converts both VSE and MVS RPG II programs to IBM Enterprise COBOL (or the equivalent). As well as the source material, the customer has to supply certain information that is not explicitly specified in RPG II. This includes all  /COPY copybooks, some information needed to create File Descriptions (fixed/variable format, record-length, layouts, etc...)  also table layout definitions will need to be provided.

R2C  converts both VSE and MVS RPG II programs to IBM Enterprise COBOL (or the equivalent). At present, the software used to perform the conversion is run on our Labs as part of a complete conversion service. We do not supply it as an “end-user” product, for two principal reasons:

 Most RPG II programs are on VSE sites, but the R2C software itself runs only under MVS.

Although the syntax conversion from RPG II to COBOL is fully automatic, there may be cases where the program logic has to be modified in order to convert the program correctly. This is a manual process which needs to be done by someone with the experience to recognize such cases.

R2C converts all the program code accordingly, however the run time tables will need to be created by hand, these are the tables after the ** at the end of the program to correct COBOL tables and added to the converted COBOL program.

All copybooks need to be expanded within the RPG II source prior to translation, we have utilities that handle this function.

R2C currently supports the following RPG II verbs: ADD, BEGSR, BITON, BITOFF, CALL, CHAIN, COMP, DIV, ENDSR, EXIT, EXSR, GOTO, LOKUP, MOVE, MOVEL, MULT, MVR, PARM, READ,   RLABL, SETLL, SETOF, SETON, SQRT, SUB, TAG, TESTN, ULABL, XFOOT, Z-ADD, Z-SUB,  AND, OR, ELSE, END.

DSPLY is supported for compatability but this is a function not allowed in most MVS shops as it is a pseaudo conversational type code with the system operator via console, but it is easy modifiable to send displays to SYSOUT and  accept responses from SYSIN. Additional verbs will be supported in the future, as needed.

R2C automatically changes all invalid characters in RPG II field names are taking care by substituting '@' by 'A', '$' by 'D', '#' by 'N' and '_' by 'U'.

R2C automatically changes any names that are reserved words in COBOL and appends a suffix of '-R2C' to make them valid names in COBOL.

NOTE: Auto Report and Sorts (S Cards) are not supported.onversion Services

R2C is a mass-processing tool which can process the entire content of an RPG II  PDS library in a single run. Member lists can be specified by the user to select or ignore certain RPG II members. We do not rent or license the tool, what we offer is a conversion service in which you provide the RPGII source to us, we can do the translation of the code in our site and transfer the converted code to you for testing and implementation.

Conversion Examples

The following example demonstrate the capabilities of the R2C LCP for converting RPG II source statements to COBOL.

Original RPG II Source Code

 

     H                                   S
     FHOLDA   IP  F     100
     FENTCON  IC  F      71R11A        KSDS          INFDS DSVSAM
     FIOAREA  O   F     100
     FREPORT  O   F     132     OF    LPRINTER
     E                    BRK     1   5  3               BROKER CODES
     LREPORT    6 1 6012
     IHOLDA   AA  01
     I                                        1 100 REC
     I                                       11  11 CP              02
     I                                       18  230EDATE           03
     I                                       24  31 ENTNUM
     I                                       24  30 ENTRY7
     I                                       25  25 HYPHEN
     I                                       26  31 ENT#            04
     I                                       24  24 ETYPE
     I                                       56  570ACCTCD          05
     I                                       58  652ACAMT
     I                                       82  82 CCODE           06
     I                                       82  820CC
     IENTCON  BB  21
     I                                       13  210FILE#
     I                                       51  51 ECTYPE
     C*                                                     SECTION  1
     C                     SETOF                     0709
     C                     SETOF                     1314
     C*                                                     SECTION  2
     C                     Z-ADD0         LQDATE  40
     C   02                SETON                     07
     C   03                SETON                     07
     C   04                SETON                     07
     C   05                SETON                     07
     C   06                SETON                     07
     C*                                                     SECTION  3
     C           CCODE     COMP '1'                      08
     C  N08      CCODE     COMP '2'                      08
     C  N08                SETON                     0907
     C*                                                     SECTION  5
     C           ACCTCD    COMP 7                        12
     C  N12      ACCTCD    COMP 12                       12
     C  N12      ACCTCD    COMP 13                       12
     C  N12      ACCTCD    COMP 20                       12
     C  N12      ACCTCD    COMP 22                       12
     C  N12      ACCTCD    COMP 24                       12
     C  N12      ACCTCD    COMP 26                       12
     C  N12      ACCTCD    COMP 29                       12
     C  N12                SETON                     1307
     C   07                GOTO END
     C*                                                     SECTION  7
     C                     MOVE EDATE     YEAR    20
     C                     MOVELEDATE     MONTH   20
     C           YEAR      COMP 75                   24  24
     C   24      YEAR      ADD  1900      CYEAR   40
     C  N24      YEAR      ADD  2000      CYEAR
     C******************************************************************
     C* BECAUSE OF NEW ENTRY NUMBER, FISCAL YEAR IN 1986 IS NOT BASED
     C* STRICTLY ON ENTRY DATE.  ANY ENTRIES FROM OCTOBER - DECEMBER
     C* 1986 WILL BE CHECKED BY LOCATION AGAINST THE RANGE OF NEW ENTRY
     C* NUBERS THAT WERE ASSIGNED AT THAT TIME.
     C*                                            
     C                     SETOF                     26
     C           CYEAR     COMP 1986                     25
     C  N25                GOTO END86
     C           MONTH     COMP 10                   25  25
     C  N25                GOTO END86
     C                     TESTN          ENT#       25
     C  N25                GOTO END86
     C                     MOVE ENT#      ETEST   60
     C           CP        COMP '1'                      25BUFFALO
     C  N25                GOTO ENDBUF
     C           ETEST     COMP 055000               26
     C  N26                GOTO END
     C           ETEST     COMP 100000                 2626
     C   26                GOTO END
     C           ETEST     COMP 308000               26
     C   26      ETEST     COMP 500000                 2626
     C                     GOTO END
     C           ENDBUF    TAG
     C           CP        COMP '4'                      25
     C   25      ETEST     COMP 200000               26     MICHIGAN
     C   26      ETEST     COMP 300000                 2626
     C   25                GOTO END
     C           CP        COMP '6'                      25
     C   25      ETEST     COMP 100000               26     CHMP-CJT
     C   26      ETEST     COMP 150050                 2626
     C   26                GOTO END
     C   25      ETEST     COMP 000001               26     CHMP-EDI
     C   26      ETEST     COMP 020030                 2626
     C   25                GOTO END
     C           CP        COMP '7'                      25
     C   25      ETEST     COMP 150050               26     ST.A-CJT
     C   26      ETEST     COMP 165000                 2626
     C   26                GOTO END
     C   25      ETEST     COMP 020030               26     ST.A-EDI
     C   26      ETEST     COMP 025000                 2626
     C   25                GOTO END
     C           CP        COMP '8'                      25
     C   25      ETEST     COMP 165000               26     OHIO
     C   26      ETEST     COMP 195000                 2626
     C                     GOTO END
     C*************************************************************
     C           END86     TAG
     C           CYEAR     COMP 1976                   20
     C  N20      MONTH     COMP 9                    15
     C   20      MONTH     COMP 6                    15
     C      15   CYEAR     ADD  1         CYEAR
     C      15   YEAR      ADD  1         YEAR
     C*                                                     SECTION  8
     C           END       TAG
     C   07                SETON                     16
     C   07                GOTO EOPROG
     C   26      CYEAR     ADD  1         CYEAR             FYEAR=87
     C   26      YEAR      ADD  1         YEAR              FYEAR=87
     C*******************************************************************
     C* FOR NEW-FORMAT ENTRIES (COMPUTED FY  86), CHAIN TO ENTCON TO
     C* RETRIEVE FILE# AND ENTRY TYPE.                      SECTION  9
     C*******************************************************************
     C           CYEAR     COMP 1987                 17  17
     C  N17                GOTO ENDNEW
     C           HYPHEN    COMP '-'                      25
     C  N25                TESTN          ENTNUM     26      INVALID NEW-
     C  N25N26             MOVE ' '       ETYPE              FORMAT ENTRY
     C  N25N26             GOTO ENDNEW                       NUMBER.
     C   25      ETYPE     COMP '0'                      26  D O   N O T
     C   25N26   ETYPE     COMP '4'                      26  CHAIN TO
     C   25N26   ETYPE     COMP '5'                      26  ENTCON FOR
     C   25N26   ETYPE     COMP '8'                      26  THESE ENTRY
     C   25N26   ETYPE     COMP '9'                      26  TYPES.
     C   25N26   ETYPE     COMP 'X'                      26
     C   25 26             Z-ADD0         FILE#
     C   25 26             GOTO ENDNEW
     C   25                MOVEL'   00'   ENTKEY 11
     C                     MOVELBRK,CC    ENTKEY
     C   25                MOVE ENT#      ENTKEY
     C  N25                MOVE ENTNUM    ENTKEY
     C           ENTKEY    CHAINENTCON               89
     C  N89                MOVE ECTYPE    ETYPE
     C           ENDNEW    TAG
     C*                                                     SECTION 10
     C                     SETOF                     99
     C           ETYPE     COMP '1'                      59
     C  N59      ETYPE     COMP '2'                      59
     C  N59                GOTO EOPROG
     C           ACCTCD    COMP 07                       60
     C  N60      ACCTCD    COMP 12                       60
     C  N60      ACCTCD    COMP 22                       60
     C  N60      ACCTCD    COMP 26                       60
     C  N60                GOTO EOPROG
     C   60                SETON                     99
     C*
     C           EOPROG    TAG
     C*
     C*  SECTION   DESCRIPTION
     C*
     C*     1    RESET INDICATORS
     C*     2    MISSING FIELDS TESTS
     C*     3    COMPANY CODE EDIT
     C*     4    LOCATION CODE EDIT - REMOVED 01/96
     C*     5    ACCOUNT CODE EDIT
     C*     7    ADD 1 TO YEAR TO GET FISCAL YEAR IF AFTER JUNE
     C*     8    SETON AT LEAST ONE ERROR INDICATOR
     C*     9    PROCESSING FOR NEW FORMAT ENTRY NUMBERS
     C*    10    DETERMINE WHICH RECORDS TO MATCH TO LIQUID
     C*
     OIOAREA  D        01N07
     O                         REC      100
     O                         LQDATE    81P
     O                 99N17   YEAR      38
     O                 99N17   ENT#      45
     O                 99N17             46 ' '
     O                 99 17   ENTKEY    46
     O                         ACAMT     54
     O                                   73 '0'
     O                         YEAR  X   56
     O                         ACCTCD    58
     O                 99      CP        64
     O                 99      ETYPE     65
     O                         FILE#  B  70P
     O                 99                74 '1'
     OREPORT  H  101   1P
     O       OR  101   OF
     O                                    7 'AC00201'
     O                                   51 'SEPARATE ACCOUNT'
     O        H  1     1P
     O       OR  1     OF
     O                                   50 'ERROR LISTING'
     O        H  2     1P
     O       OR  2     OF
     O                                   21 'XXX MISSING'
     O                         UDATE Y   47
     O                                   73 '*** INCORRECT'
     O        H  2     1P
     O       OR  2     OF
     O                                   23 'CO CODE    LOCATION'
     O                                   39 'ACCOUNT CODE'
     O                                   53 'ENTRY DATE'
     O                                   69 'ENTRY NUMBER'
     O                                   82 'AMOUNT'
     O        D  2     01 07
     O                         CCODE      8
     O                    06              9 'XXX'
     O                    09              9 '***'
     O                         CP        19
     O                    02             20 'XXX'
     O                         ACCTCDX   34
     O                    05             35 'XXX'
     O                    13             35 '***'
     O                   N03   EDATE Y   52
     O                    03             49 'XXX'
     O                   N04   ENTNUM    67
     O                    04             64 'XXX'
     O                         ACAMT J   83
     O        T  2     LRN16
     O                                   44 '*** NO ERRORS DETECTED'
     O                                   48 '***'
**
050
075
100
125
150

Program Source Code generated by R2C

In this example shows the final product of the conversion to COBOL


       Identification Division.

      *--------------------------------------------------------------*
      * R2C - RPG II converted to Cobol on 2018/12/15                *
      *--------------------------------------------------------------*

       Program-Id. TEST1.

       Environment Division.
       Configuration Section.
       Special-Names.
           Decimal-point is comma.

       Input-Output Section.
       File-Control.
           Select Holda-file    assign to Ut-s-holda
                                organization is sequential
                                access is sequential.
           Select Entcon-file   assign to Entcon
                                organization is indexed
                                access is dynamic
                                record key is Entcon-key
                                status is Entcon-status.
           Select Ioarea-file   assign to Ut-s-ioarea
                                organization is sequential
                                access is sequential.
           Select Report-file   assign to Sys020-ur-3203-report.

       Data Division.
       File Section.

      *--------------------------------------------------------------
      *    FILE DESCRIPTIONS
      *--------------------------------------------------------------

       FD  Holda-file
           block contains 1 records
           recording mode F.
       01  Holda-record                  Pic X(100).

       FD  Entcon-file.
       01  Entcon-record.
           05  Entcon-key                Pic X(11).
           05  Filler                    Pic X(60).

       FD  Ioarea-file
           block contains 1 records
           recording mode F.
       01  Ioarea-record                 Pic X(100).

       FD  Report-file
           block contains 1 records
           recording mode F.
       01  Report-output-record.
           05  Report-record-control     Pic X.
           05  Report-record             Pic X(132).

       Working-Storage Section.

      *----------------------------------------------------------------
      *    Input record descriptions
      *----------------------------------------------------------------

       01  Holda-work                    Pic X(100).
       01  Rec redefines Holda-work.
           05  Filler-1-10               Pic X(10).
           05  Cp                        Pic X(1).
           05  Filler-12-17              Pic X(6).
           05  Edate                     Pic S9(6).
           05  Entnum.
               10  Entry7.
                   15 Etype              Pic X(1).
                   15 Hyphen             Pic X(1).
                   15 Filler-26-30       Pic X(5).
               10  Filler-31             Pic X(1).
           05  Filler-32-55              Pic X(24).
           05  Acctcd                    Pic S9(2).
           05  Acamt                     Pic S9(6)V9(2).
           05  Filler-66-81              Pic X(16).
           05  Ccode                     Pic X(1).
           05  Cc redefines Ccode        Pic S9(1).
           05  Filler-83-100             Pic X(18).
       01  Overlap-field redefines Holda-work.
           05  Filler                    Pic X(25).
           05  Entn                      Pic X(6).

       01  Entcon-work                   Pic X(71).
       01  Filler redefines Entcon-work.
           05  Filler-1-12               Pic X(12).
           05  Filen                     Pic S9(9).
           05  Filler-22-50              Pic X(29).
           05  Ectype                    Pic X(1).
           05  Filler-52-71              Pic X(20).

      *----------------------------------------------------------------
      *    Input record save-areas
      *----------------------------------------------------------------

       01  Holda-hold                    Pic X(100).
       01  Rec-hold redefines Holda-hold.
           05  Filler-1-10               Pic X(10).
           05  Cp-hold                   Pic X(1).
           05  Filler-12-17              Pic X(6).
           05  Edate-hold                Pic S9(6).
           05  Entnum-hold.
               10  Entry7-hold.
                   15 Etype-hold         Pic X(1).
                   15 Hyphen-hold        Pic X(1).
                   15 Filler-26-30       Pic X(5).
               10  Filler-31             Pic X(1).
           05  Filler-32-55              Pic X(24).
           05  Acctcd-hold               Pic S9(2).
           05  Acamt-hold                Pic S9(6)V9(2).
           05  Filler-66-81              Pic X(16).
           05  Ccode-hold                Pic X(1).
           05  Cc-hold redefines Ccode-hold
                                         Pic S9(1).
           05  Filler-83-100             Pic X(18).
       01  Overlap-field redefines Holda-hold.
           05  Filler                    Pic X(25).
           05  Entn-hold                 Pic X(6).

       01  Entcon-hold                   Pic X(71).
       01  Filler redefines Entcon-hold.
           05  Filler-1-12               Pic X(12).
           05  Filen-hold                Pic S9(9).
           05  Filler-22-50              Pic X(29).
           05  Ectype-hold               Pic X(1).
           05  Filler-52-71              Pic X(20).

      *----------------------------------------------------------------
      *    End-of-file flags
      *----------------------------------------------------------------

       01  Eof-flags.
           05  Holda-eof-flag            Pic X   value '0'.
               88 Holda-eof              value '1'.
           05  Entcon-eof-flag           Pic X   value '0'.
               88 Entcon-eof             value '1'.

      *----------------------------------------------------------------
      *    File-status flags
      *----------------------------------------------------------------

       01  Status-flags                  value spaces.
           05  Entcon-status             Pic XX.

      *----------------------------------------------------------------
      *    Tables and arrays
      *----------------------------------------------------------------

       01  Brk-array-re.
           05  Filler  Pic X(08) value '050'.
           05  Filler  Pic X(08) value '075'.
           05  Filler  Pic X(08) value '100'.
           05  Filler  Pic X(08) value '125'.
           05  Filler  Pic X(08) value '150'.

       01  Brk-array    redefines Brk-array-re.
           05  Brk-values                occurs 5 times
                                         indexed by Brk-index.
               10  Brk-ar                Pic X(3).

      *----------------------------------------------------------------
      *    R2C standard Working-storage fields
      *----------------------------------------------------------------

           Copy R2CNUMWK.

           Copy R2CDATE.

           Copy R2CFLDS.

           Copy VSAMERRD.

       01  Indicators                    value zeroes.
           05  Filler                    Pic X.
               88  Of-on                 value '1'.
               88  Of-off                value '0'.
           05  Filler                    Pic X.
               88  01-on                 value '1'.
               88  01-off                value '0'.
           05  Filler                    Pic X.
               88  02-on                 value '1'.
               88  02-off                value '0'.
           05  Filler                    Pic X.
               88  03-on                 value '1'.
               88  03-off                value '0'.
           05  Filler                    Pic X.
               88  04-on                 value '1'.
               88  04-off                value '0'.
           05  Filler                    Pic X.
               88  05-on                 value '1'.
               88  05-off                value '0'.
           05  Filler                    Pic X.
               88  06-on                 value '1'.
               88  06-off                value '0'.
           05  Filler                    Pic X.
               88  07-on                 value '1'.
               88  07-off                value '0'.
           05  Filler                    Pic X.
               88  08-on                 value '1'.
               88  08-off                value '0'.
           05  Filler                    Pic X.
               88  09-on                 value '1'.
               88  09-off                value '0'.
           05  Filler                    Pic X.
               88  1p-on                 value '1'.
               88  1p-off                value '0'.
           05  Filler                    Pic X.
               88  12-on                 value '1'.
               88  12-off                value '0'.
           05  Filler                    Pic X.
               88  13-on                 value '1'.
               88  13-off                value '0'.
           05  Filler                    Pic X.
               88  14-on                 value '1'.
               88  14-off                value '0'.
           05  Filler                    Pic X.
               88  15-on                 value '1'.
               88  15-off                value '0'.
           05  Filler                    Pic X.
               88  16-on                 value '1'.
               88  16-off                value '0'.
           05  Filler                    Pic X.
               88  17-on                 value '1'.
               88  17-off                value '0'.
           05  Filler                    Pic X.
               88  20-on                 value '1'.
               88  20-off                value '0'.
           05  Filler                    Pic X.
               88  21-on                 value '1'.
               88  21-off                value '0'.
           05  Filler                    Pic X.
               88  24-on                 value '1'.
               88  24-off                value '0'.
           05  Filler                    Pic X.
               88  25-on                 value '1'.
               88  25-off                value '0'.
           05  Filler                    Pic X.
               88  26-on                 value '1'.
               88  26-off                value '0'.
           05  Filler                    Pic X.
               88  59-on                 value '1'.
               88  59-off                value '0'.
           05  Filler                    Pic X.
               88  60-on                 value '1'.
               88  60-off                value '0'.
           05  Filler                    Pic X.
               88  89-on                 value '1'.
               88  89-off                value '0'.
           05  Filler                    Pic X.
               88  99-on                 value '1'.
               88  99-off                value '0'.
           05  Filler                    Pic X.
               88  L1-on                 value '1'.
               88  L1-off                value '0'.
           05  Filler                    Pic X.
               88  L2-on                 value '1'.
               88  L2-off                value '0'.
           05  Filler                    Pic X.
               88  L3-on                 value '1'.
               88  L3-off                value '0'.
           05  Filler                    Pic X.
               88  L4-on                 value '1'.
               88  L4-off                value '0'.
           05  Filler                    Pic X.
               88  L5-on                 value '1'.
               88  L5-off                value '0'.
           05  Filler                    Pic X.
               88  L6-on                 value '1'.
               88  L6-off                value '0'.
           05  Filler                    Pic X.
               88  L7-on                 value '1'.
               88  L7-off                value '0'.
           05  Filler                    Pic X.
               88  L8-on                 value '1'.
               88  L8-off                value '0'.
           05  Filler                    Pic X.
               88  L9-on                 value '1'.
               88  L9-off                value '0'.
           05  Filler                    Pic X.
               88  Lr-on                 value '1'.
               88  Lr-off                value '0'.

       01  Counters.
           05  Report-page-ctr           Pic 9(3)         value zero.
           05  Report-line-ctr           Pic 9(3)         value zero.

      *--------------------------------------------------------------
      *    Work fields for calculations
      *--------------------------------------------------------------

       01  Calculation-fields.
           05  Lqdate                 Pic S9(4)      value zero.
           05  Year                   Pic S9(2)      value zero.
           05  Month                  Pic S9(2)      value zero.
           05  Cyear                  Pic S9(4)      value zero.
           05  Etest                  Pic S9(6)      value zero.
           05  Entkey                 Pic X(11)       value spaces.

       Procedure Division.

       Initial-process Section.

           Move zeroes to Indicators.

           Set 1p-on to true

           Move function Current-date to Ws-current-date-fields.
           Move Ws-current-year (3:2) to Uyear
           Move Ws-current-month to Umonth.
           Move Ws-current-day to Uday.

           Move Uday to Udayy
           Move Umonth to Umonthy
           Move Uyear to Uyeary

           Open input  Holda-file
                input  Entcon-file
                output Ioarea-file
                output Report-file

           Perform Main-process
               until Lr-on.

       Initial-process-exit.
           Exit.

       Main-process Section.

           Set 01-off to true
           Set 21-off to true

           Read Holda-file
             at end
               Set Lr-on to true
               Set L1-on to true
               Set L2-on to true
               Set L3-on to true
               Set L4-on to true
               Set L5-on to true
               Set L6-on to true
               Set L7-on to true
               Set L8-on to true
               Set L9-on to true
               Perform End-process
             not at end
               Perform Input-holda
           end-read

           Perform Detail-calculations

           If First-pass = 0
              Move 1 to First-pass
           end-if

           Perform Ioarea-output

           Perform Report-output

           If First-page = 0
              Set 1p-off to true

              Move 1 to First-page
           end-if.

       Main-process-exit.
           Exit.

       End-process Section.

           Perform Report-total
           Close Holda-file
                 Entcon-file
                 Ioarea-file
                 Report-file
           Goback.
       End-process-exit.
           Exit.

       Input-holda Section.

           Move Holda-record to Holda-work
           Set 01-on to true
           Set 02-off to true
           If Cp is equal to spaces
              Set 02-on to true
           end-if
           Set 03-off to true
           If Edate is equal to zero
              Set 03-on to true
           end-if
           Set 04-off to true
           If Entn is equal to spaces
              Set 04-on to true
           end-if
           Set 05-off to true
           If Acctcd is equal to zero
              Set 05-on to true
           end-if
           Set 06-off to true
           If Ccode is equal to spaces
              Set 06-on to true
           end-if
           Perform Report-total
           If (01-on)
              Move spaces to Holda-hold
              Move Holda-work to Holda-hold
           end-if.
       Input-holda-exit.
           Exit.

       Input-entcon Section.

           Move Entcon-record to Entcon-work
           Set 21-on to true
           If (21-on)
              Move spaces to Entcon-hold
              Move Entcon-work to Entcon-hold
           end-if.
       Input-entcon-exit.
           Exit.

       Check-vsam-status Section.

           Search all Status-value
              when Status-entry-one(Status-index)
                 =  Ws-vsam-status
              Display Status-entry-two(Status-index)
              upon Sysout
           end-search.
       Check-vsam-status-exit.
           Exit.

       Detail-calculations Section.

           Set 07-off to true
           Set 09-off to true
           Set 13-off to true
           Set 14-off to true
           Move zeroes to Lqdate
           If (02-on)
              Set 07-on to true
           end-if
           If (03-on)
              Set 07-on to true
           end-if
           If (04-on)
              Set 07-on to true
           end-if
           If (05-on)
              Set 07-on to true
           end-if
           If (06-on)
              Set 07-on to true
           end-if
           Set 08-off to true
           If Ccode-hold = '1'
              Set 08-on to true
           end-if
           If (08-off)
              Set 08-off to true
              If Ccode-hold = '2'
                 Set 08-on to true
              end-if
           end-if
           If (08-off)
              Set 09-on to true
              Set 07-on to true
           end-if
           Set 12-off to true
           If Acctcd-hold = 7
              Set 12-on to true
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 12
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 13
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 20
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 22
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 24
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 26
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 12-off to true
              If Acctcd-hold = 29
                 Set 12-on to true
              end-if
           end-if
           If (12-off)
              Set 13-on to true
              Set 07-on to true
           end-if
           If (07-on)
              go to End-tag
           end-if
           Move Edate-hold to Year
           Move Edate-hold to Work-numeric2
           Move Workfield2(13:2) to Month
           Set 24-off to true
           If Year is greater than 75
              Set 24-on to true
           end-if
           If Year = 75
              Set 24-on to true
           end-if
           If (24-on)
              Compute Cyear = Year + 1900
           end-if
           If (24-off)
              Compute Cyear = Year + 2000
           end-if
           Set 26-off to true
           Set 25-off to true
           If Cyear = 1986
              Set 25-on to true
           end-if
           If (25-off)
              go to End86-tag
           end-if
           Set 25-off to true
           If Month is greater than 10
              Set 25-on to true
           end-if
           If Month = 10
              Set 25-on to true
           end-if
           If (25-off)
              go to End86-tag
           end-if
           If Entn-hold is numeric
              Set 25-on to true
           else
              Set 25-off to true
           end-if
           If (25-off)
              go to End86-tag
           end-if
           Move Entn-hold to Etest
           Set 25-off to true
           If Cp-hold = '1'
              Set 25-on to true
           end-if
           If (25-off)
              go to Endbuf-tag
           end-if
           Set 26-off to true
           If Etest is greater than 055000
              Set 26-on to true
           end-if
           If (26-off)
              go to End-tag
           end-if
           Set 26-off to true
           If Etest is less than 100000
              Set 26-on to true
           end-if
           If Etest = 100000
              Set 26-on to true
           end-if
           If (26-on)
              go to End-tag
           end-if
           Set 26-off to true
           If Etest is greater than 308000
              Set 26-on to true
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 500000
                 Set 26-on to true
              end-if
              If Etest = 500000
                 Set 26-on to true
              end-if
           end-if
           go to End-tag.
       Endbuf-tag.
           Continue
           Set 25-off to true
           If Cp-hold = '4'
              Set 25-on to true
           end-if
           If (25-on)
              Set 26-off to true
              If Etest is greater than 200000
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 300000
                 Set 26-on to true
              end-if
              If Etest = 300000
                 Set 26-on to true
              end-if
           end-if
           If (25-on)
              go to End-tag
           end-if
           Set 25-off to true
           If Cp-hold = '6'
              Set 25-on to true
           end-if
           If (25-on)
              Set 26-off to true
              If Etest is greater than 100000
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 150050
                 Set 26-on to true
              end-if
              If Etest = 150050
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              go to End-tag
           end-if
           If (25-on)
              Set 26-off to true
              If Etest is greater than 000001
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 020030
                 Set 26-on to true
              end-if
              If Etest = 020030
                 Set 26-on to true
              end-if
           end-if
           If (25-on)
              go to End-tag
           end-if
           Set 25-off to true
           If Cp-hold = '7'
              Set 25-on to true
           end-if
           If (25-on)
              Set 26-off to true
              If Etest is greater than 150050
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 165000
                 Set 26-on to true
              end-if
              If Etest = 165000
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              go to End-tag
           end-if
           If (25-on)
              Set 26-off to true
              If Etest is greater than 020030
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 025000
                 Set 26-on to true
              end-if
              If Etest = 025000
                 Set 26-on to true
              end-if
           end-if
           If (25-on)
              go to End-tag
           end-if
           Set 25-off to true
           If Cp-hold = '8'
              Set 25-on to true
           end-if
           If (25-on)
              Set 26-off to true
              If Etest is greater than 165000
                 Set 26-on to true
              end-if
           end-if
           If (26-on)
              Set 26-off to true
              If Etest is less than 195000
                 Set 26-on to true
              end-if
              If Etest = 195000
                 Set 26-on to true
              end-if
           end-if
           go to End-tag.
       End86-tag.
           Continue
           Set 20-off to true
           If Cyear is less than 1976
              Set 20-on to true
           end-if
           If (20-off)
              Set 15-off to true
              If Month is greater than 9
                 Set 15-on to true
              end-if
           end-if
           If (20-on)
              Set 15-off to true
              If Month is greater than 6
                 Set 15-on to true
              end-if
           end-if
           If (15-on)
              Compute Cyear = Cyear + 1
           end-if
           If (15-on)
              Compute Year = Year + 1
           end-if.
       End-tag.
           Continue
           If (07-on)
              Set 16-on to true
           end-if
           If (07-on)
              go to Eoprog-tag
           end-if
           If (26-on)
              Compute Cyear = Cyear + 1
           end-if
           If (26-on)
              Compute Year = Year + 1
           end-if
           Set 17-off to true
           If Cyear is greater than 1987
              Set 17-on to true
           end-if
           If Cyear = 1987
              Set 17-on to true
           end-if
           If (17-off)
              go to Endnew-tag
           end-if
           Set 25-off to true
           If Hyphen-hold = '-'
              Set 25-on to true
           end-if
           If (25-off)
              If Entnum-hold is numeric
                 Set 26-on to true
              else
                 Set 26-off to true
              end-if
           end-if
           If (25-off and 26-off)
              Move ' ' to Etype-hold
           end-if
           If (25-off and 26-off)
              go to Endnew-tag
           end-if
           If (25-on)
              Set 26-off to true
              If Etype-hold = '0'
                 Set 26-on to true
              end-if
           end-if
           If (25-on and 26-off)
              Set 26-off to true
              If Etype-hold = '4'
                 Set 26-on to true
              end-if
           end-if
           If (25-on and 26-off)
              Set 26-off to true
              If Etype-hold = '5'
                 Set 26-on to true
              end-if
           end-if
           If (25-on and 26-off)
              Set 26-off to true
              If Etype-hold = '8'
                 Set 26-on to true
              end-if
           end-if
           If (25-on and 26-off)
              Set 26-off to true
              If Etype-hold = '9'
                 Set 26-on to true
              end-if
           end-if
           If (25-on and 26-off)
              Set 26-off to true
              If Etype-hold = 'X'
                 Set 26-on to true
              end-if
           end-if
           If (25-on and 26-on)
              Move zeroes to Filen-hold
           end-if
           If (25-on and 26-on)
              go to Endnew-tag
           end-if
           If (25-on)
              Move '   00' to Entkey  (1:5)
           end-if
           Move Brk-ar(Cc) to Entkey(1:11)
           If (25-on)
              Move Entn-hold to Entkey(6:6)
           end-if
           If (25-off)
              Move Entnum-hold to Entkey(4:8)
           end-if
           Set 89-off to true
           Move Entkey to Entcon-key
              Read  Entcon-file
                 into Entcon-work
                 key is Entcon-key
                 invalid key Set 89-on to true
                   Move Entcon-status to Ws-vsam-status
                   Perform Check-vsam-status
                 not invalid key
                   Set 89-off to true
                   Perform Input-entcon
              end-read
           If (89-off)
              Move Ectype-hold to Etype-hold
           end-if.
       Endnew-tag.
           Continue
           Set 99-off to true
           Set 59-off to true
           If Etype-hold = '1'
              Set 59-on to true
           end-if
           If (59-off)
              Set 59-off to true
              If Etype-hold = '2'
                 Set 59-on to true
              end-if
           end-if
           If (59-off)
              go to Eoprog-tag
           end-if
           Set 60-off to true
           If Acctcd-hold = 07
              Set 60-on to true
           end-if
           If (60-off)
              Set 60-off to true
              If Acctcd-hold = 12
                 Set 60-on to true
              end-if
           end-if
           If (60-off)
              Set 60-off to true
              If Acctcd-hold = 22
                 Set 60-on to true
              end-if
           end-if
           If (60-off)
              Set 60-off to true
              If Acctcd-hold = 26
                 Set 60-on to true
              end-if
           end-if
           If (60-off)
              go to Eoprog-tag
           end-if
           If (60-on)
              Set 99-on to true
           end-if.
       Eoprog-tag.
           Continue.

       Detail-calculations-exit.
           Exit.

       Ioarea-output Section.

           Move spaces to Ioarea-record.

           If (01-on and 07-off)
              Move Rec-hold to Ioarea-record(1:100)
              Move Lqdate to Work-numeric-n
              Move Workfieldn(8:3) to Ioarea-record(79:3)
              If (99-on and 17-off)
                 Move Year to Work-numeric4
                 Move Workfield4(17:2) to Ioarea-record(37:2)
              end-if
              If (99-on and 17-off)
                 Move Entn-hold to Ioarea-record(40:6)
              end-if
              If (99-on and 17-off)
                 Move ' ' to Ioarea-record(46:1)
              end-if
              If (99-on and 17-on)
                 Move Entkey to Ioarea-record(36:11)
              end-if
              Move Acamt-hold to Work-numeric2
              Move Workfield2(11:8) to Ioarea-record(47:8)
              Move '0' to Ioarea-record(73:1)
              Move Year to Work-numeric4
              Move Workfield4(17:2) to Ioarea-record(55:2)
              Move Acctcd-hold to Work-numeric4
              Move Workfield4(17:2) to Ioarea-record(57:2)
              If (99-on)
                 Move Cp-hold to Ioarea-record(64:1)
              end-if
              If (99-on)
                 Move Etype-hold to Ioarea-record(65:1)
              end-if
              Move Filen-hold to Work-numeric-n
              Move Workfieldn(6:5) to Ioarea-record(66:5)
              Initialize Filen-hold
              If (99-on)
                 Move '1' to Ioarea-record(74:1)
              end-if
              Write Ioarea-record
           end-if.

       Ioarea-output-exit.
           Exit.

       Report-output Section.

           Move spaces to Report-record.

           If (1p-on) or (Of-on)
              Move 'AC00201' to Report-record(1:7)
              Move 'SEPARATE ACCOUNT' to Report-record(36:16)
              Write Report-output-record after advancing 1 lines
              Add 1 to Report-line-ctr
              Move spaces to Report-output-record
              If Report-line-ctr is greater than 60
                 Set Of-on  to true
                 Move zero to Report-line-ctr
              else
                 Set Of-off to true
              end-if
           end-if

           If (1p-on) or (Of-on)
              Move 'ERROR LISTING' to Report-record(38:13)
              Write Report-output-record after advancing 1 lines
              Add 1 to Report-line-ctr
              Move spaces to Report-output-record
              If Report-line-ctr is greater than 60
                 Set Of-on  to true
                 Move zero to Report-line-ctr
              else
                 Set Of-off to true
              end-if
           end-if

           If (1p-on) or (Of-on)
              Move 'XXX MISSING' to Report-record(11:11)
              Move Uday to Udayy
              Move Umonth to Umonthy
              Move Uyear to Uyeary

              Move Udatey to Report-record(40:8)
              Move '*** INCORRECT' to Report-record(61:13)
              Write Report-output-record after advancing 2 lines
              Add 2 to Report-line-ctr
              Move spaces to Report-output-record
              If Report-line-ctr is greater than 60
                 Set Of-on  to true
                 Move zero to Report-line-ctr
              else
                 Set Of-off to true
              end-if
           end-if

           If (1p-on) or (Of-on)
              Move 'CO CODE    LOCATION' to Report-record(5:19)
              Move 'ACCOUNT CODE' to Report-record(28:12)
              Move 'ENTRY DATE' to Report-record(44:10)
              Move 'ENTRY NUMBER' to Report-record(58:12)
              Move 'AMOUNT' to Report-record(77:6)
              Write Report-output-record after advancing 2 lines
              Add 2 to Report-line-ctr
              Move spaces to Report-output-record
              If Report-line-ctr is greater than 60
                 Set Of-on  to true
                 Move zero to Report-line-ctr
              else
                 Set Of-off to true
              end-if
           end-if

           If (01-on and 07-on)
              Move Ccode-hold to Report-record(8:1)
              If (06-on)
                 Move 'XXX' to Report-record(7:3)
              end-if
              If (09-on)
                 Move '***' to Report-record(7:3)
              end-if
              Move Cp-hold to Report-record(19:1)
              If (02-on)
                 Move 'XXX' to Report-record(18:3)
              end-if
              Move Acctcd-hold to Work-numeric4
              Move Workfield4(17:2) to Report-record(33:2)
              If (05-on)
                 Move 'XXX' to Report-record(33:3)
              end-if
              If (13-on)
                 Move '***' to Report-record(33:3)
              end-if
              If (03-off)
                 Move Edate-hold (1:2) to Udayy
                 Move Edate-hold (3:2) to Umonthy
                 Move Edate-hold (5:2) to Uyeary

                 Move Udatey to Report-record(45:8)
              end-if
              If (03-on)
                 Move 'XXX' to Report-record(47:3)
              end-if
              If (04-off)
                 Move Entnum-hold to Report-record(60:8)
              end-if
              If (04-on)
                 Move 'XXX' to Report-record(62:3)
              end-if
              Move Acamt-hold to Ws-edited-cj
              Move Ws-edited-cj(14:12) to Report-record(72:12)
              Write Report-output-record after advancing 2 lines
              Add 2 to Report-line-ctr
              Move spaces to Report-output-record
              If Report-line-ctr is greater than 60
                 Set Of-on  to true
                 Move zero to Report-line-ctr
              else
                 Set Of-off to true
              end-if
           end-if.

       Report-output-exit.
           Exit.

       Report-total Section.

           If (Lr-on and 16-off)
              Move '*** NO ERRORS DETECTED' to Report-record(23:22)
              Move '***' to Report-record(46:3)
              Write Report-output-record after advancing 2 lines
              Add 2 to Report-line-ctr
              Move spaces to Report-output-record
              If Report-line-ctr is greater than 60
                 Set Of-on  to true
                 Move zero to Report-line-ctr
              else
                 Set Of-off to true
              end-if
           end-if.

       Report-total-exit.
           Exit.

 

	

Search key-words: IBM legacy mainframe mainframes main-frame mvs/esa os/390 z/os os390 zos vse dos/vs dos/vse vse/esa z/vse zvse RPG II Answer:report RPGII RPG II convert conversion translate translation VSE MVS z/OS z/VSE source code statements programming language needed