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