R2C - Translate RPG II Programs to COBOL

                 

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 is not a GSF product and is marketed and distributed 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:

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

  2. 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.

  3. Some pre-processing is required and some of it needs to be performed manually, things like completing the file layout definitions in order for the file layout to be perfectly aligned in COBOL.

  4. 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.

  5. 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, MOVEA, MOVEL, MULT, MVR, PARM, READ, READE, READP, RLABL, RLABL, SETLL, SETOF, SETON, SQRT, SUB, TAG, TESTN, ULABL, XFOOT, Z-ADD, Z-SUB, CABxx, CASxx,DOWxx, DOUxx, IFxx, ANDxx, ORxx, 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 '-RPG' to make them valid names in COBOL.

Running the R2C LCP

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.

//IBMUSERA  JOB (9999),JRPG2CBL,                         
//          CLASS=A,MSGCLASS=H,NOTIFY=&SYSUID,           
//          MSGLEVEL=(1,1),REGION=8M                      
//JOBLIB    DD  DISP=SHR,DSN=GSFSOFT.GSF-ENV.LOAD        
//RPG2CBL   EXEC PGM=LCPSTART                            
//SOURCE    DD DISP=SHR,DSN=IBMUSER.D.BRPGMOD            
//SYSPUNCH  DD DISP=SHR,DSN=IBMUSER.CBLMOD               
//RESER1    DD DISP=SHR,DSN=IBMUSER.ASMMOD(RESERVED)     
//SYSPRINT  DD SYSOUT=*                                  
//PROGDEF   DD SYSOUT=*                                  
//SYSLOG    DD SYSOUT=*                                  
//SYSDEBUG  DD SYSOUT=*                                  
//SYSIN     DD *                                         
*.SOURCE.DDNAME=SOURCE                                   
*.PROGDEF_LANG=CBL              DEFAULT: NONE            
*.LCP=RPG2CBL                   DEFAULT: NONE            
/*                                                       
//SELDD    DD *                                          
RPGPROG1
RPGPROG2
/*                                                 
 

Conversion Examples

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

Example

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 '***'
**
00050112
00075822
00100ZZZ
00125ZZZ
00150ZZZ

 Program Source Code generated by the R2C LCP.

In this example we have left part of the RPG code inbeded as comments for reference only, these comments are removed after testing and validation of the software functionality.


       IDENTIFICATION DIVISION.
      * R2C -  RPGII to COBOL Converter
      * Copyright ©  2017 - V3R1
      * TEST2 Was Converted to COBOL on 2017/12/18
        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 RANDOM
                   RECORD KEY IS ENTCON-KEY
                   STATUS IS WS-VSAM-STATUS.
           SELECT IOAREA-FILE   ASSIGN TO UT-S-IOAREA
                   ORGANIZATION IS SEQUENTIAL
                   ACCESS IS SEQUENTIAL.
           SELECT REPORT-FILE   ASSIGN TO UR-1403-S-REPORT.

       DATA DIVISION.
       FILE SECTION.
      *
      *  FD DEFINITIONS BASED ON FILE  SPECIFICATIONS
      *
       FD HOLDA-FILE
           BLOCK CONTAINS 1 RECORDS
           RECORDING MODE F
           RECORD CONTAINS   100 CHARACTERS
           DATA RECORD IS HOLDA-RECORD.
       01 HOLDA-RECORD PIC X(100).
       FD ENTCON-FILE
           RECORD CONTAINS    71 CHARACTERS
           DATA RECORD IS ENTCON-RECORD.
       01 ENTCON-RECORD.
           05  ENTCON-KEY PIC X(11).
           05  FILLER PIC X(060).
       FD IOAREA-FILE
           BLOCK CONTAINS 1 RECORDS
           RECORDING MODE F
           RECORD CONTAINS   100 CHARACTERS
           DATA RECORD IS IOAREA-RECORD.
       01 IOAREA-RECORD PIC X(100).
       FD REPORT-FILE
           BLOCK CONTAINS 1 RECORDS
           RECORDING MODE F
           RECORD CONTAINS   132 CHARACTERS
           DATA RECORD IS REPORT-RECORD.
       01 REPORT-RECORD PIC X(132).

       WORKING-STORAGE SECTION.

       01 INDICATORS VALUE ZEROES.
           05 FILLER PIC X.
                88 LR-ON            VALUE '1'.
                88 LR-OFF           VALUE '0'.
           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'.
       01  FEEDBACK-CODE.
           05  FC-SEVERITY    PIC S9(4) BINARY VALUE ZERO.
           05  FC-MESSAGE     PIC S9(4) BINARY VALUE ZERO.
           05  FILLER         PIC X(08).

       01  WORKING-FIELDS.
           05  WS-EDITED-9  PIC ZZZZZZZZ0-  VALUE ZERO.
           05  WS-EDITED-10 PIC ZZZZZZZZZ0- VALUE ZERO.
           05  WS-EDITED-11 PIC ZZZZZZZZZZ0- VALUE ZERO.
           05  WS-EDITED-15 PIC ZZZ.ZZZ.ZZZ,99- VALUE ZERO.
           05  WS-EDITED-18 PIC  ZZ.ZZZ.ZZZ.ZZZ,99- VALUE ZEROES.
           05  WS-EDITED-19 PIC ZZZ.ZZZ.ZZZ.ZZZ,99- VALUE ZEROES.
           05  WS-EDITED-C1 PIC Z.ZZZ.ZZZ.ZZZ.ZZZ.ZZZ,99 VALUE ZEROES.
           05  WS-EDITED-C2 PIC Z.ZZZ.ZZZ.ZZZ.ZZZ.ZZZ,ZZ VALUE ZEROES.
           05  WS-EDITED-C3 PIC ZZZZZZZZZZZZZZZZZ9 VALUE ZEROES.
           05  WS-EDITED-C4 PIC ZZZZZZZZZZZZZZZZZZ VALUE ZEROES.
           05  WS-EDITED-CA PIC Z.ZZZ.ZZZ.ZZZ.ZZZ.ZZZ,99CR VALUE ZEROES.
           05  WS-EDITED-CB PIC Z.ZZZ.ZZZ.ZZZ.ZZZ.ZZZ,ZZCR VALUE ZEROES.
           05  WS-EDITED-CC PIC ZZZZZZZZZZZZZZZZZ9CR VALUE ZEROES.
           05  WS-EDITED-CD PIC ZZZZZZZZZZZZZZZZZZCR VALUE ZEROES.
           05  WS-EDITED-CJ PIC Z.ZZZ.ZZZ.ZZZ.ZZZ.ZZZ,99- VALUE ZEROES.
           05  WS-EDITED-CK PIC Z.ZZZ.ZZZ.ZZZ.ZZZ.ZZZ,ZZ- VALUE ZEROES.
           05  WS-EDITED-CL PIC ZZZZZZZZZZZZZZZZZ9- VALUE ZEROES.
           05  WS-EDITED-CM PIC ZZZZZZZZZZZZZZZZZZ- VALUE ZEROES.
           05  WS-EDITED-CZ PIC ZZZZZZZZZZZZZZZZZZ VALUE ZEROES.
           05  WORK-NUMERIC   PIC S9(16)V9(2) VALUE ZERO.
           05  FILLER     REDEFINES WORK-NUMERIC.
               10  WORKFIELD          PIC X(18).
           05 WORK-NUMERIC-N PIC S9(18) PACKED-DECIMAL VALUE ZERO.
           05  FILLER      REDEFINES WORK-NUMERIC-N.
               10  WORKFIELDN         PIC X(10).
           05 WORK-NUMERIC-H PIC S9(18) PACKED-DECIMAL.
           05  FILLER      REDEFINES WORK-NUMERIC-H.
               10  WORKFIELDH         PIC X(10).
           05 WORK-NUMERIC-P PIC S9(16)V9(2) PACKED-DECIMAL VALUE ZERO.
           05  FILLER      REDEFINES WORK-NUMERIC-P.
               10  WORKFIELDP PIC X(10).
           05 WORK-NUMERIC-P1 PIC S9(9)V9(1) PACKED-DECIMAL VALUE ZERO.
           05  FILLER      REDEFINES WORK-NUMERIC-P1.
               10  WORKFIELDP1 PIC X(06).
           05  WORK-NUMERIC1  PIC S9(9)V9(2) VALUE ZERO.
           05  FILLER      REDEFINES WORK-NUMERIC1.
               10  WORKFIELD1 PIC X(11).
           05  WORK-NUMERIC2  PIC S9(18).
           05  FILLER      REDEFINES WORK-NUMERIC2.
               10  WORKFIELD2 PIC X(18).
           05  WORK-NUMERIC3  PIC S9(13).
           05  FILLER      REDEFINES WORK-NUMERIC3.
               10  WORKFIELD3 PIC X(13).
               05  WORK-FIELD1 PIC S9(11)V9(2) VALUE ZEROES.
               05  WORK-FIELD2 PIC S9(11)V9(2) VALUE ZEROES.
               05  WORK-FIELD3 PIC S9(11)V9(2) VALUE ZEROES.
           05  I                  PIC 9(02) VALUE ZERO.
           05  I2                 PIC 9(02) VALUE ZERO.
           05  FIRST-PASS         PIC 9(01) VALUE ZERO.
           05  FIRST-PAGE         PIC 9(01) VALUE ZERO.
           05  EXCEPT-FLAG        PIC 9(01) VALUE ZERO.
               88   EXCEPT    VALUE 1.
           05  REPORT-PAGE-CTR  PIC 9(3) VALUE ZEROES.
           05  REPORT-LINE-CTR  PIC 9(3) VALUE ZEROES.
           05  PAGES  PIC ZZ9.
           05  PAGE1  PIC ZZ9.
           05  PAGE2  PIC ZZ9.
           05  PAGE3  PIC ZZ9.
           05  PAGE4  PIC ZZ9.
           05  PAGE5  PIC ZZ9.
           05  PAGE6  PIC ZZ9.
           05  PAGE7  PIC ZZ9.
       01  WS-VSAM-STATUS          PIC XX VALUE SPACES.
           88 STATUS-OK VALUES '00' '97'.
       COPY VSAMCHK.
       01 HOLDA-WORK-FLDS.
         05 HOLDA-SWITCHES PIC X  VALUE '0'.
            88 HOLDA-EOF     VALUE '1'.

       01 ENTCON-WORK-FLDS.
         05 ENTCON-SWITCHES PIC X  VALUE '0'.
            88 ENTCON-EOF     VALUE '1'.

      *

      *  WORK FIELDS BASED ON INPUT SPECIFICATIONS
      *
       01 HOLDA-WORK.
           05 REC        PIC X(100) VALUE SPACES.
           05 CP         PIC X(1) VALUE SPACES.
           05 EDATE      PIC 9(6) VALUE ZEROES.
           05 ENTNUM     PIC X(8) VALUE SPACES.
           05 ENTRY7     PIC X(7) VALUE SPACES.
           05 HYPHEN     PIC X(1) VALUE SPACES.
           05 ENTN       PIC X(6) VALUE SPACES.
           05 ETYPE      PIC X(1) VALUE SPACES.
           05 ACCTCD     PIC 9(2) VALUE ZEROES.
           05 ACAMT      PIC 9(6)V9(2)  VALUE ZEROES.
           05 CCODE      PIC X(1) VALUE SPACES.
           05 CC         PIC 9(1) VALUE ZEROES.
       01 ENTCON-WORK.
           05 FILEN      PIC 9(9) VALUE ZEROES.
           05 ECTYPE     PIC X(1) VALUE SPACES.
       01 HOLDA-HOLD.
           05 REC-HOLD  PIC X(100) VALUE SPACES.
           05 CP-HOLD  PIC X(1) VALUE SPACES.
           05 EDATE-HOLD PIC 9(6) VALUE ZEROES.
           05 ENTNUM-HOLD  PIC X(8) VALUE SPACES.
           05 ENTRY7-HOLD  PIC X(7) VALUE SPACES.
           05 HYPHEN-HOLD  PIC X(1) VALUE SPACES.
           05 ENTN-HOLD  PIC X(6) VALUE SPACES.
           05 ETYPE-HOLD  PIC X(1) VALUE SPACES.
           05 ACCTCD-HOLD PIC 9(2) VALUE ZEROES.
           05 ACAMT-HOLD PIC 9(6)V9(2)  VALUE ZEROES.
           05 CCODE-HOLD  PIC X(1) VALUE SPACES.
           05 CC-HOLD PIC 9(1) VALUE ZEROES.
       01 ENTCON-HOLD.
           05 FILEN-HOLD PIC 9(9) VALUE ZEROES.
           05 ECTYPE-HOLD  PIC X(1) VALUE SPACES.
      *
      *  WORK FIELDS BASED ON EXTENSION SPECIFICATIONS
      *
      *
       01  BRK-AR.
           05  FILLER  PIC X(08) VALUE
           '00050112'.
           05  FILLER  PIC X(08) VALUE
           '00075822'.
           05  FILLER  PIC X(08) VALUE
           '00100ZZZ'.
           05  FILLER  PIC X(08) VALUE
           '00125ZZZ'.
           05  FILLER  PIC X(08) VALUE
           '00150ZZZ'.
      *

      *  WORK FIELDS BASED ON CALCULATION SPECIFICATIONS
      *

       01 FILLER.
           05 WS-CHAR-7.
              10 WS-PACKED-7 PIC S9(13).
           05 WS-CHAR-6.
              10 WS-NUM-6 PIC S9(6) DISPLAY.
           05 WS-CHAR-5.
              10 WS-PACKED-5 PIC S9(9).
           05 WS-CHAR-4.
              10 WS-PACKED-4 PIC S9(7).
           05 COUNTER     PIC S9(4).


       01  UDATE       PIC 9(6).
       01  FILLER REDEFINES UDATE.
           05  UMONTH     PIC  9(2).
           05  UDAY       PIC  9(2).
           05  UYEAR      PIC  9(2).

       01  UDATEY.
           05  UMONTHY    PIC  9(2).
           05  FILLER     PIC  X(1) VALUE '/'.
           05  UDAYY      PIC  9(2).
           05  FILLER     PIC  X(1) VALUE '/'.
           05  UYEARY     PIC  9(2).
       01  WDATE    PIC 9(8).
       01  FILLER REDEFINES WDATE.
           05  WMONTH     PIC  9(4).
           05  WDAY       PIC  9(2).
           05  WYEAR      PIC  9(2).
       01  UDATEW.
           05  UWYEAR     PIC  9(4).
           05  FILLER     PIC  X(1) VALUE '/'.
           05  UWMON      PIC  9(2).
           05  FILLER     PIC  X(1) VALUE '/'.
           05  UWDAY      PIC  9(2).

       01  WS-CURRENT-DATE-FIELDS.
           05  WS-CURRENT-DATE.
               10  WS-CURRENT-YEAR    PIC  9(4).
               10  WS-CURRENT-MONTH   PIC  9(2).
               10  WS-CURRENT-DAY     PIC  9(2).
               10  WS-CURRENT-TIME.
                   15  WS-CURRENT-HOUR    PIC  9(2).
                   15  WS-CURRENT-MINUTE  PIC  9(2).
                   15  WS-CURRENT-SECOND  PIC  9(2).
                   15  WS-CURRENT-MS      PIC  9(2).
                   15  WS-DIFF-FROM-GMT   PIC S9(4).

       01 C-CARD-FIELDS.
           05 LQDATE PIC 9(04) VALUE ZEROS.
           05 YEAR PIC 9(02) VALUE ZEROS.
           05 MONTH PIC 9(02) VALUE ZEROS.
           05 CYEAR PIC 9(04) VALUE ZEROS.
           05 ETEST PIC 9(06) VALUE ZEROS.
           05 ENTKEY PIC X(011) VALUE SPACES.

       PROCEDURE DIVISION.

       STARTER SECTION.

               MOVE 0 TO EXCEPT-FLAG.
             SET LR-OFF TO TRUE
             SET OF-OFF TO TRUE
             SET 01-OFF TO TRUE
             SET 02-OFF TO TRUE
             SET 03-OFF TO TRUE
             SET 04-OFF TO TRUE
             SET 05-OFF TO TRUE
             SET 06-OFF TO TRUE
             SET 07-OFF TO TRUE
             SET 08-OFF TO TRUE
             SET 09-OFF TO TRUE
             SET 1P-OFF TO TRUE
             SET 12-OFF TO TRUE
             SET 13-OFF TO TRUE
             SET 14-OFF TO TRUE
             SET 15-OFF TO TRUE
             SET 16-OFF TO TRUE
             SET 17-OFF TO TRUE
             SET 20-OFF TO TRUE
             SET 21-OFF TO TRUE
             SET 24-OFF TO TRUE
             SET 25-OFF TO TRUE
             SET 26-OFF TO TRUE
             SET 59-OFF TO TRUE
             SET 60-OFF TO TRUE
             SET 89-OFF TO TRUE
             SET 99-OFF TO TRUE

             MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-FIELDS.
             MOVE WS-CURRENT-DAY TO UDAY.
             MOVE WS-CURRENT-MONTH TO UMONTH.
             MOVE WS-CURRENT-YEAR (3:2) TO UYEAR

               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 MAINLINE THRU
                   MAINLINE-EXIT.

       STARTER-EXIT.
             EXIT.

       MAINLINE SECTION.


             PERFORM UNTIL LR-ON
               MOVE 0 TO EXCEPT-FLAG

             SET 01-OFF TO TRUE
             SET 21-OFF TO TRUE

               IF FIRST-PASS = 1
                 MOVE HOLDA-WORK TO HOLDA-HOLD
               END-IF
               IF FIRST-PASS = 0
                 MOVE 1 TO FIRST-PASS
               END-IF
               READ HOLDA-FILE INTO HOLDA-WORK
                 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-ROUTINE
                 NOT AT END
                     PERFORM INPUT-HOLDA
                        THRU INPUT-HOLDA-EXIT
               END-READ
                    PERFORM DETAIL-CALCULATIONS
                       THRU DETAIL-CALCULATIONS-EXIT
                 PERFORM IOAREA-OUTPUT
                    THRU IOAREA-OUTPUT-EXIT

                 PERFORM REPORT-OUTPUT
                    THRU REPORT-OUTPUT-EXIT

               IF FIRST-PAGE = 0
                 SET 1P-ON TO TRUE

                 MOVE 1 TO FIRST-PAGE
               END-IF
             END-PERFORM.

       MAINLINE-EXIT.
               EXIT.

       END-ROUTINE SECTION.
                 PERFORM IOAREA-OUTPUT
                    THRU IOAREA-OUTPUT-EXIT

                 PERFORM REPORT-OUTPUT
                    THRU REPORT-OUTPUT-EXIT

             CLOSE HOLDA-FILE
                   ENTCON-FILE
                   IOAREA-FILE
                   REPORT-FILE
             STOP RUN.
       END-ROUTINE-EXIT.
             EXIT.
       INPUT-HOLDA SECTION.

               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 03-OFF TO TRUE
             IF EDATE IS EQUAL TO SPACES
               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 05-OFF TO TRUE
             IF ACCTCD IS EQUAL TO SPACES
               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
             .
       INPUT-HOLDA-EXIT.
                 EXIT.
       INPUT-ENTCON SECTION.

               SET 21-ON TO TRUE
            .
       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.
     C*                    SETOF                     0709
                  SET 07-OFF TO TRUE
                  SET 09-OFF TO TRUE

     C*                    SETOF                     1314
                  SET 13-OFF TO TRUE
                  SET 14-OFF TO TRUE

     C*                    Z-ADD0         LQDATE  40
               MOVE ZEROES TO LQDATE

     C*  02                SETON                     07
             IF (02-ON)
                  SET 07-ON TO TRUE
             END-IF

     C*  03                SETON                     07
             IF (03-ON)
                  SET 07-ON TO TRUE
             END-IF

     C*  04                SETON                     07
             IF (04-ON)
                  SET 07-ON TO TRUE
             END-IF

     C*  05                SETON                     07
             IF (05-ON)
                  SET 07-ON TO TRUE
             END-IF

     C*  06                SETON                     07
             IF (06-ON)
                  SET 07-ON TO TRUE
             END-IF

     C*          CCODE     COMP '1'                      08
               SET 08-OFF TO TRUE
               IF CCODE      = '1'
                  SET 08-ON TO TRUE
               END-IF

     C* N08      CCODE     COMP '2'                      08
             IF (08-OFF)
               IF CCODE      = '2'
                  SET 08-ON TO TRUE
               END-IF
             END-IF

     C* N08                SETON                     0907
             IF (08-OFF)
                  SET 09-ON TO TRUE
                  SET 07-ON TO TRUE
             END-IF

     C*          ACCTCD    COMP 7                        12
               SET 12-OFF TO TRUE
               IF ACCTCD     = 7
                  SET 12-ON TO TRUE
               END-IF

     C* N12      ACCTCD    COMP 12                       12
             IF (12-OFF)
               IF ACCTCD     = 12
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12      ACCTCD    COMP 13                       12
             IF (12-OFF)
               IF ACCTCD     = 13
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12      ACCTCD    COMP 20                       12
             IF (12-OFF)
               IF ACCTCD     = 20
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12      ACCTCD    COMP 22                       12
             IF (12-OFF)
               IF ACCTCD     = 22
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12      ACCTCD    COMP 24                       12
             IF (12-OFF)
               IF ACCTCD     = 24
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12      ACCTCD    COMP 26                       12
             IF (12-OFF)
               IF ACCTCD     = 26
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12      ACCTCD    COMP 29                       12
             IF (12-OFF)
               IF ACCTCD     = 29
                  SET 12-ON TO TRUE
               END-IF
             END-IF

     C* N12                SETON                     1307
             IF (12-OFF)
                  SET 13-ON TO TRUE
                  SET 07-ON TO TRUE
             END-IF

     C*  07                GOTO END
             IF (07-ON)
               GO TO END-TAG
             END-IF

     C*                    MOVE EDATE     YEAR    20
               MOVE EDATE      TO YEAR

     C*                    MOVELEDATE     MONTH   20
               ADD  EDATE TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(013:2) TO MONTH

     C*          YEAR      COMP 75                   24  24
               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

     C*  24      YEAR      ADD  1900      CYEAR   40
             IF (24-ON)
                 COMPUTE CYEAR =
                         YEAR +
                         1900
                 END-COMPUTE
             END-IF

     C* N24      YEAR      ADD  2000      CYEAR
             IF (24-OFF)
                 COMPUTE CYEAR =
                         YEAR +
                         2000
                 END-COMPUTE
             END-IF

     C*                    SETOF                     26
                  SET 26-OFF TO TRUE

     C*          CYEAR     COMP 1986                     25
               SET 25-OFF TO TRUE
               IF CYEAR      = 1986
                  SET 25-ON TO TRUE
               END-IF

     C* N25                GOTO END86
             IF (25-OFF)
               GO TO END86-TAG
             END-IF

     C*          MONTH     COMP 10                   25  25
               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

     C* N25                GOTO END86
             IF (25-OFF)
               GO TO END86-TAG
             END-IF

     C*                    TESTN          ENTN       25
               IF ENTN IS NUMERIC
                  SET 25-ON TO TRUE
               ELSE
                  SET 25-OFF TO TRUE
               END-IF

     C* N25                GOTO END86
             IF (25-OFF)
               GO TO END86-TAG
             END-IF

     C*                    MOVE ENTN      ETEST   60
               MOVE ENTN       TO ETEST

     C*          CP        COMP '1'                      25BUFFALO
               SET 25-OFF TO TRUE
               IF CP         = '1'
                  SET 25-ON TO TRUE
               END-IF

     C* N25                GOTO ENDBUF
             IF (25-OFF)
               GO TO ENDBUF-TAG
             END-IF

     C*          ETEST     COMP 055000               26
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 055000
                  SET 26-ON TO TRUE
               END-IF

     C* N26                GOTO END
             IF (26-OFF)
               GO TO END-TAG
             END-IF

     C*          ETEST     COMP 100000                 2626
               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

     C*  26                GOTO END
             IF (26-ON)
               GO TO END-TAG
             END-IF

     C*          ETEST     COMP 308000               26
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 308000
                  SET 26-ON TO TRUE
               END-IF

     C*  26      ETEST     COMP 500000                 2626
             IF (26-ON)
               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

     C*                    GOTO END
               GO TO END-TAG

     C*          ENDBUF    TAG
             .
       ENDBUF-TAG.
                 CONTINUE

     C*          CP        COMP '4'                      25
               SET 25-OFF TO TRUE
               IF CP         = '4'
                  SET 25-ON TO TRUE
               END-IF

     C*  25      ETEST     COMP 200000               26     MICHIGAN
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 200000
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  26      ETEST     COMP 300000                 2626
             IF (26-ON)
               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

     C*  25                GOTO END
             IF (25-ON)
               GO TO END-TAG
             END-IF

     C*          CP        COMP '6'                      25
               SET 25-OFF TO TRUE
               IF CP         = '6'
                  SET 25-ON TO TRUE
               END-IF

     C*  25      ETEST     COMP 100000               26     CHMP-CJT
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 100000
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  26      ETEST     COMP 150050                 2626
             IF (26-ON)
               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

     C*  26                GOTO END
             IF (26-ON)
               GO TO END-TAG
             END-IF

     C*  25      ETEST     COMP 000001               26     CHMP-EDI
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 000001
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  26      ETEST     COMP 020030                 2626
             IF (26-ON)
               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

     C*  25                GOTO END
             IF (25-ON)
               GO TO END-TAG
             END-IF

     C*          CP        COMP '7'                      25
               SET 25-OFF TO TRUE
               IF CP         = '7'
                  SET 25-ON TO TRUE
               END-IF

     C*  25      ETEST     COMP 150050               26     ST.A-CJT
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 150050
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  26      ETEST     COMP 165000                 2626
             IF (26-ON)
               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

     C*  26                GOTO END
             IF (26-ON)
               GO TO END-TAG
             END-IF

     C*  25      ETEST     COMP 020030               26     ST.A-EDI
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 020030
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  26      ETEST     COMP 025000                 2626
             IF (26-ON)
               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

     C*  25                GOTO END
             IF (25-ON)
               GO TO END-TAG
             END-IF

     C*          CP        COMP '8'                      25
               SET 25-OFF TO TRUE
               IF CP         = '8'
                  SET 25-ON TO TRUE
               END-IF

     C*  25      ETEST     COMP 165000               26     OHIO
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETEST IS GREATER THAN 165000
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  26      ETEST     COMP 195000                 2626
             IF (26-ON)
               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

     C*                    GOTO END
               GO TO END-TAG

     C*          END86     TAG
             .
       END86-TAG.
                 CONTINUE

     C*          CYEAR     COMP 1976                   20
               SET 20-OFF TO TRUE
               IF CYEAR IS LESS THAN 1976
                  SET 20-ON TO TRUE
               END-IF

     C* N20      MONTH     COMP 9                    15
             IF (20-OFF)
               SET 15-OFF TO TRUE
               IF MONTH IS GREATER THAN 9
                  SET 15-ON TO TRUE
               END-IF
             END-IF

     C*  20      MONTH     COMP 6                    15
             IF (20-ON)
               SET 15-OFF TO TRUE
               IF MONTH IS GREATER THAN 6
                  SET 15-ON TO TRUE
               END-IF
             END-IF

     C*     15   CYEAR     ADD  1         CYEAR
             IF (15-ON)
                 COMPUTE CYEAR =
                         CYEAR +
                         1
                 END-COMPUTE
             END-IF

     C*     15   YEAR      ADD  1         YEAR
             IF (15-ON)
                 COMPUTE YEAR =
                         YEAR +
                         1
                 END-COMPUTE
             END-IF

     C*          END       TAG
             .
       END-TAG.
                 CONTINUE

     C*  07                SETON                     16
             IF (07-ON)
                  SET 16-ON TO TRUE
             END-IF

     C*  07                GOTO EOPROG
             IF (07-ON)
               GO TO EOPROG-TAG
             END-IF

     C*  26      CYEAR     ADD  1         CYEAR             FYEAR=87
             IF (26-ON)
                 COMPUTE CYEAR =
                         CYEAR +
                         1
                 END-COMPUTE
             END-IF

     C*  26      YEAR      ADD  1         YEAR              FYEAR=87
             IF (26-ON)
                 COMPUTE YEAR =
                         YEAR +
                         1
                 END-COMPUTE
             END-IF

     C*          CYEAR     COMP 1987                 17  17
               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

     C* N17                GOTO ENDNEW
             IF (17-OFF)
               GO TO ENDNEW-TAG
             END-IF

     C*          HYPHEN    COMP '-'                      25
               SET 25-OFF TO TRUE
               IF HYPHEN     = '-'
                  SET 25-ON TO TRUE
               END-IF

     C* N25                TESTN          ENTNUM     26      INVALID NEW
             IF (25-OFF)
               IF ENTNUM IS NUMERIC
                  SET 26-ON TO TRUE
               ELSE
                  SET 26-OFF TO TRUE
               END-IF
             END-IF

     C* N25N26             MOVE ' '       ETYPE              FORMAT ENTR
             IF (25-OFF
             AND 26-OFF)
               MOVE  ' '        TO ETYPE
             END-IF

     C* N25N26             GOTO ENDNEW                       NUMBER.
             IF (25-OFF
             AND 26-OFF)
               GO TO ENDNEW-TAG
             END-IF

     C*  25      ETYPE     COMP '0'                      26  D O   N O T
             IF (25-ON)
               SET 26-OFF TO TRUE
               IF ETYPE      = '0'
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  25N26   ETYPE     COMP '4'                      26  CHAIN TO
             IF (25-ON
             AND 26-OFF)
               SET 26-OFF TO TRUE
               IF ETYPE      = '4'
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  25N26   ETYPE     COMP '5'                      26  ENTCON FOR
             IF (25-ON
             AND 26-OFF)
               SET 26-OFF TO TRUE
               IF ETYPE      = '5'
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  25N26   ETYPE     COMP '8'                      26  THESE ENTRY
             IF (25-ON
             AND 26-OFF)
               SET 26-OFF TO TRUE
               IF ETYPE      = '8'
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  25N26   ETYPE     COMP '9'                      26  TYPES.
             IF (25-ON
             AND 26-OFF)
               SET 26-OFF TO TRUE
               IF ETYPE      = '9'
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  25N26   ETYPE     COMP 'X'                      26
             IF (25-ON
             AND 26-OFF)
               SET 26-OFF TO TRUE
               IF ETYPE      = 'X'
                  SET 26-ON TO TRUE
               END-IF
             END-IF

     C*  25 26             Z-ADD0         FILEN
             IF (25-ON
             AND 26-ON)
               MOVE ZEROES TO FILEN
             END-IF

     C*  25 26             GOTO ENDNEW
             IF (25-ON
             AND 26-ON)
               GO TO ENDNEW-TAG
             END-IF

     C*  25                MOVEL'   00'   ENTKEY 11
             IF (25-ON)
                 MOVE '   00'
                        TO ENTKEY    (1:5)
             END-IF

     C*                    MOVELBRK,CC    ENTKEY
                       MOVE BRK-AR(CC)(1:8)
                         TO ENTKEY(1:8)

     C*  25                MOVE ENTN      ENTKEY
             IF (25-ON)
                       MOVE ENTN TO ENTKEY(06:6)

             END-IF

     C* N25                MOVE ENTNUM    ENTKEY
             IF (25-OFF)
                       MOVE ENTNUM TO ENTKEY(04:8)

             END-IF

     C*          ENTKEY    CHAINENTCON               89
                 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
                      PERFORM CHECK-VSAM-STATUS
                       THRU CHECK-VSAM-STATUS-EXIT
                    NOT INVALID KEY
                      SET 89-OFF TO TRUE
                     PERFORM INPUT-ENTCON
                        THRU INPUT-ENTCON-EXIT
                  END-READ

     C* N89                MOVE ECTYPE    ETYPE
             IF (89-OFF)
               MOVE ECTYPE     TO ETYPE
             END-IF

     C*          ENDNEW    TAG
             .
       ENDNEW-TAG.
                 CONTINUE

     C*                    SETOF                     99
                  SET 99-OFF TO TRUE

     C*          ETYPE     COMP '1'                      59
               SET 59-OFF TO TRUE
               IF ETYPE      = '1'
                  SET 59-ON TO TRUE
               END-IF

     C* N59      ETYPE     COMP '2'                      59
             IF (59-OFF)
               IF ETYPE      = '2'
                  SET 59-ON TO TRUE
               END-IF
             END-IF

     C* N59                GOTO EOPROG
             IF (59-OFF)
               GO TO EOPROG-TAG
             END-IF

     C*          ACCTCD    COMP 07                       60
               SET 60-OFF TO TRUE
               IF ACCTCD     = 07
                  SET 60-ON TO TRUE
               END-IF

     C* N60      ACCTCD    COMP 12                       60
             IF (60-OFF)
               IF ACCTCD     = 12
                  SET 60-ON TO TRUE
               END-IF
             END-IF

     C* N60      ACCTCD    COMP 22                       60
             IF (60-OFF)
               IF ACCTCD     = 22
                  SET 60-ON TO TRUE
               END-IF
             END-IF

     C* N60      ACCTCD    COMP 26                       60
             IF (60-OFF)
               IF ACCTCD     = 26
                  SET 60-ON TO TRUE
               END-IF
             END-IF

     C* N60                GOTO EOPROG
             IF (60-OFF)
               GO TO EOPROG-TAG
             END-IF

     C*  60                SETON                     99
             IF (60-ON)
                  SET 99-ON TO TRUE
             END-IF

     C*          EOPROG    TAG
             .
       EOPROG-TAG.
                 CONTINUE


                .
       DETAIL-CALCULATIONS-EXIT.
             EXIT.
     O*OAREA  D        01N07

       IOAREA-OUTPUT SECTION.

             IF (01-ON
               AND 07-OFF)
     O*                        REC      100

               MOVE REC        TO IOAREA-RECORD(01:100)
     O*                        LQDATE    81P

               ADD  LQDATE     TO ZERO
                     GIVING WORK-NUMERIC-N
               MOVE WORKFIELDN(08:3) TO IOAREA-RECORD(079:3)
     O*                99N17   YEAR      38
             IF (99-ON
               AND 17-OFF)
               ADD  YEAR       TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(017:2) TO IOAREA-RECORD(037:2)
     O*                99N17   ENTN      45
             END-IF
             IF (99-ON
               AND 17-OFF)
               MOVE ENTN       TO IOAREA-RECORD(040:6)
     O*                99N17             46 ' '
             END-IF
             IF (99-ON
               AND 17-OFF)
               MOVE ' ' TO
                    IOAREA-RECORD(046:1)
     O*                99 17   ENTKEY    46
             END-IF
             IF (99-ON
               AND 17-ON)
               MOVE ENTKEY     TO IOAREA-RECORD(036:11)
             END-IF
     O*                        ACAMT     54

               ADD  ACAMT      TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(011:8) TO IOAREA-RECORD(047:8)
     O*                                  73 '0'

               MOVE '0' TO
                    IOAREA-RECORD(073:1)
     O*                        YEAR  X   56

               ADD  YEAR       TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(017:2) TO IOAREA-RECORD(055:2)
     O*                        ACCTCD    58

               ADD  ACCTCD     TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(017:2) TO IOAREA-RECORD(057:2)
     O*                99      CP        64
             IF (99-ON)
               MOVE CP         TO IOAREA-RECORD(064:1)
     O*                99      ETYPE     65
             END-IF
             IF (99-ON)
               MOVE ETYPE      TO IOAREA-RECORD(065:1)
             END-IF
     O*                        FILEN  B  70P

               ADD  FILEN      TO ZERO
                     GIVING WORK-NUMERIC-N
               MOVE WORKFIELDN(06:5) TO IOAREA-RECORD(066:5)
               INITIALIZE FILEN
     O*                99                74 '1'
             IF (99-ON)
               MOVE '1' TO
                    IOAREA-RECORD(074:1)
             END-IF
               WRITE   IOAREA-RECORD
               END-WRITE
               MOVE SPACES TO  IOAREA-RECORD
             END-IF

             .
       IOAREA-OUTPUT-EXIT.
             EXIT.

     O*EPORT  H  101   1P
       REPORT-OUTPUT SECTION.

             IF (1P-ON)
     O*      OR  101   OF
             OR (OF-ON)
     O*                                   7 'AC00201'

               MOVE 'AC00201' TO
                    REPORT-RECORD(01:7)
     O*                                  51 'SEPARATE ACCOUNT'

               MOVE 'SEPARATE ACCOUNT' TO
                    REPORT-RECORD(036:16)
     O*       H  1     1P
               WRITE   REPORT-RECORD
               END-WRITE
               MOVE SPACES TO  REPORT-RECORD
             END-IF

             IF (1P-ON)
     O*      OR  1     OF
             OR (OF-ON)
     O*                                  50 'ERROR LISTING'

               MOVE 'ERROR LISTING' TO
                    REPORT-RECORD(038:13)
     O*       H  2     1P
               WRITE   REPORT-RECORD
               END-WRITE
               MOVE SPACES TO  REPORT-RECORD
             END-IF

             IF (1P-ON)
     O*      OR  2     OF
             OR (OF-ON)
     O*                                  21 'XXX MISSING'

               MOVE 'XXX MISSING' TO
                    REPORT-RECORD(011:11)
     O*                        UDATE Y   47

               MOVE UDAY   TO UDAYY
               MOVE UMONTH TO UMONTHY
               MOVE UYEAR  TO UYEARY
               MOVE UDATEY TO
                    REPORT-RECORD(040:8)

     O*                                  73 '*** INCORRECT'

               MOVE '*** INCORRECT' TO
                    REPORT-RECORD(061:13)
     O*       H  2     1P
               WRITE   REPORT-RECORD
               END-WRITE
               MOVE SPACES TO  REPORT-RECORD
             END-IF

             IF (1P-ON)
     O*      OR  2     OF
             OR (OF-ON)
     O*                                  23 'CO CODE    LOCATION'

               MOVE 'CO CODE    LOCATION' TO
                    REPORT-RECORD(05:19)
     O*                                  39 'ACCOUNT CODE'

               MOVE 'ACCOUNT CODE' TO
                    REPORT-RECORD(028:12)
     O*                                  53 'ENTRY DATE'

               MOVE 'ENTRY DATE' TO
                    REPORT-RECORD(044:10)
     O*                                  69 'ENTRY NUMBER'

               MOVE 'ENTRY NUMBER' TO
                    REPORT-RECORD(058:12)
     O*                                  82 'AMOUNT'

               MOVE 'AMOUNT' TO
                    REPORT-RECORD(077:6)
               WRITE   REPORT-RECORD
                      AFTER ADVANCING PAGE
               END-WRITE
               MOVE SPACES TO  REPORT-RECORD
                    ADD 2 TO REPORT-LINE-CTR
                  IF  REPORT-LINE-CTR IS GREATER  THAN  60
                    SET OF-ON  TO TRUE
                  ELSE
                    SET OF-OFF TO TRUE
                  END-IF
                  MOVE ZEROES TO  REPORT-LINE-CTR
             END-IF

     O*       D  2     01 07
             IF (01-ON
               AND 07-ON)
     O*                        CCODE      8

               MOVE CCODE      TO REPORT-RECORD(08:1)
     O*                   06              9 'XXX'
             IF (06-ON)
               MOVE 'XXX' TO
                    REPORT-RECORD(07:3)
     O*                   09              9 '***'
             END-IF
             IF (09-ON)
               MOVE '***' TO
                    REPORT-RECORD(07:3)
     O*                        CP        19

               MOVE CP         TO REPORT-RECORD(019:1)
     O*                   02             20 'XXX'
             END-IF
             IF (02-ON)
               MOVE 'XXX' TO
                    REPORT-RECORD(018:3)
             END-IF
     O*                        ACCTCDX   34

               ADD  ACCTCD     TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(017:2) TO REPORT-RECORD(033:2)
     O*                   05             35 'XXX'
             IF (05-ON)
               MOVE 'XXX' TO
                    REPORT-RECORD(033:3)
     O*                   13             35 '***'
             END-IF
             IF (13-ON)
               MOVE '***' TO
                    REPORT-RECORD(033:3)
     O*                  N03   EDATE Y   52
             END-IF
             IF (03-OFF)
               ADD  EDATE      TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(013:6) TO REPORT-RECORD(047:6)
     O*                   03             49 'XXX'
             END-IF
             IF (03-ON)
               MOVE 'XXX' TO
                    REPORT-RECORD(047:3)
     O*                  N04   ENTNUM    67
             END-IF
             IF (04-OFF)
               MOVE ENTNUM     TO REPORT-RECORD(060:8)
     O*                   04             64 'XXX'
             END-IF
             IF (04-ON)
               MOVE 'XXX' TO
                    REPORT-RECORD(062:3)
     O*                        ACAMT J   83

               ADD  ACAMT      TO ZERO
                     GIVING WORK-NUMERIC2
               MOVE WORKFIELD2(011:8) TO REPORT-RECORD(076:8)
             END-IF
               WRITE   REPORT-RECORD
                   AFTER  ADVANCING 2 LINES
               END-WRITE
               MOVE SPACES TO  REPORT-RECORD
                    ADD 2 TO REPORT-LINE-CTR
                  IF  REPORT-LINE-CTR IS GREATER  THAN  60
                    SET OF-ON  TO TRUE
                  ELSE
                    SET OF-OFF TO TRUE
                  END-IF
                  MOVE ZEROES TO  REPORT-LINE-CTR
             END-IF

     O*       T  2     LRN16
             IF (LR-ON
               AND 16-OFF)
     O*                                  44 '*** NO ERRORS DETECTED'

               MOVE '*** NO ERRORS DETECTED' TO
                    REPORT-RECORD(023:22)
     O*                                  48 '***'

               MOVE '***' TO
                    REPORT-RECORD(046:3)
               WRITE   REPORT-RECORD
                   AFTER  ADVANCING 2 LINES
               END-WRITE
               MOVE SPACES TO  REPORT-RECORD
                    ADD 2 TO REPORT-LINE-CTR
                  IF  REPORT-LINE-CTR IS GREATER  THAN  60
                    SET OF-ON  TO TRUE
                  ELSE
                    SET OF-OFF TO TRUE
                  END-IF
                  MOVE ZEROES TO  REPORT-LINE-CTR
             END-IF
             .
       REPORT-OUTPUT-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