COBOL Program - Benchmark Test Case
CBL
IDENTIFICATION DIVISION.
PROGRAM-ID. MSTRTRAN.
***********************************************************
* Test transaction processing.
***********************************************************
*———————————————————-
*- Maintenance comments:
*- 2/27/2021; <initial version>
*———————————————————-
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBMMVS.
OBJECT-COMPUTER. IBMMVS.
SPECIAL-NAMES.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MASTRIN ASSIGN TO MASTRIN FILE STATUS IS IMSTAT.
SELECT TRANSIN ASSIGN TO TRANSIN FILE STATUS IS ITSTAT.
SELECT MSTROUT ASSIGN TO MSTROUT FILE STATUS IS OMSTAT.
SELECT TRANOUT ASSIGN TO TRANOUT FILE STATUS IS OTSTAT.
***********************************************************
DATA DIVISION.
*—————
FILE SECTION.
FD MASTRIN
RECORD CONTAINS 0 CHARACTERS
BLOCK CONTAINS 0 CHARACTERS
RECORDING MODE F.
* 1…5…10….5…20….5…30
* Ex: “1033633 3893.10 .”
01 MASTR-INP-RCD.
05 INP-MSTR.
10 MASTER-ACCT-NMBR PIC X(10).
10 ACCOUNT-BALANCE PIC X(17).
10 OUT-BAL REDEFINES ACCOUNT-BALANCE PIC Z(13)9.99.
10 EOL PIC X(1).
* 1…5…10….5…20….5…30….5…40.
* Ex: “7320429 1 2020-08-01371.58 .’
FD TRANSIN
RECORD CONTAINS 0 CHARACTERS
BLOCK CONTAINS 0 CHARACTERS
RECORDING MODE IS F.
01 TRANS-INP-RCD.
05 INP-TRAN.
10 TRANS-ACCT-NMBR PIC X(10).
10 TRANS-ID PIC 9(2).
10 TRANS-DATE PIC X(10).
10 TRANS-AMT PIC X(17).
10 REJECT-IND PIC X(1).
10 EOL PIC X(1).
FD MSTROUT
RECORD CONTAINS 28 CHARACTERS
BLOCK CONTAINS 0 CHARACTERS
RECORDING MODE F.
01 MASTR-OUT-RCD PIC X(28).
FD TRANOUT
RECORD CONTAINS 41 CHARACTERS
BLOCK CONTAINS 0 CHARACTERS
RECORDING MODE IS F.
01 TRANS-OUT-RCD PIC X(41).
*—————
WORKING-STORAGE SECTION.
01 WS-START PIC X(42)
VALUE ‘*** Start of working storage; MSTRTRAN ***’.
*———————————————————*
* (SET WS-PROGRAM ID TO PROGRAM-ID) *
*———————————————————*
01 WS-PROGRAM-ID PIC X(08) VALUE ‘MSTRTRAN’.
01 WS-PROG-STAT PIC X(20) VALUE ‘*** INITIAL ***’.
01 WS-SIMOSTAT PIC X(08) VALUE ‘SIMOSTAT’.
01 WS-ABEND PIC X(08) VALUE ‘CEE3ABD’.
01 WS-DYNAM-PROGRAM-ID PIC X(08) VALUE SPACES.
01 WS-BUFFER PIC X(80) VALUE SPACES.
COPY PASSSTAT.
*–01 DEBUG-FLAG PIC X(01) VALUE ‘Y’. /* DEBUG */
01 DEBUG-FLAG PIC X(01) VALUE SPACE.
88 DEBUG-ON VALUE ‘Y’.
01 ERR-DESC.
03 IO-STATEMENT PIC X(8) VALUE SPACES.
88 READING-FILE-FLAG VALUE ‘reading ‘.
88 WRITING-FILE-FLAG VALUE ‘writing ‘.
88 OPEN-FILE-FLAG VALUE ‘opening ‘.
88 CLOSE-FILE-FLAG VALUE ‘closing ‘.
03 IO-FILE-DES PIC X(7) VALUE SPACES.
88 INPMSTR-FILE-FLAG VALUE ‘INPMST ‘.
88 INPTRAN-FILE-FLAG VALUE ‘INPTRN ‘.
88 OUTMSTR-FILE-FLAG VALUE ‘OUTMST ‘.
88 OUTTRAN-FILE-FLAG VALUE ‘OUTTRN ‘.
01 ABDCODE PIC S9(9) BINARY.
01 CLN-UP PIC S9(9) BINARY.
*———————————————————*
* WORK VARIABLES *
*———————————————————*
01 ACCT-BAL PIC 9(13)V99 COMP VALUE 0.
01 DISPLAY-AN PIC Z(13)9.99.
01 MASTR-ACCTNMBR PIC 9(10) COMP VALUE 0.
01 TRANS-AMOUNT PIC 9(13)V99 COMP VALUE 0.
01 TRANS-ACCTNMBR PIC 9(10) COMP VALUE 0.
01 TRANS-DEFER-FLAG PIC X(01) VALUE SPACE.
88 TRANS-PENDING VALUE ‘T’.
01 COUNT-MASTR-RCDS PIC 9(9) VALUE ZEROES.
01 COUNT-TRANS-RCDS PIC 9(9) VALUE ZEROES.
01 WS-WORK-VARS.
03 ABO-FLAG PIC X VALUE ‘N’.
88 ABO-FLAG-SET VALUE ‘Y’.
03 EOMF-FLAG PIC X(1) VALUE SPACE.
88 EOMF-FLAG-FALSE VALUE SPACE.
88 EOMF-FLAG-TRUE VALUE ‘T’.
03 EOTF-FLAG PIC X(1) VALUE SPACE.
88 EOTF-FLAG-FALSE VALUE SPACE.
88 EOTF-FLAG-TRUE VALUE ‘T’.
03 ERR-FLAG PIC 9(4) VALUE ZERO.
88 ERR-FLAG-CLEAR VALUE ZERO.
03 IMSTAT PIC X(2).
88 IMSTAT-ZEROES VALUE ’00’.
03 ITSTAT PIC X(2).
03 OMSTAT PIC X(2).
03 OTSTAT PIC X(2).
03 WS-I PIC 9(4) COMP VALUE ZERO.
03 WS-J PIC 9(4) COMP VALUE ZERO.
01 WS-END PIC X(42)
VALUE ‘*** End of working storage; MSTRTRAN ***’.
***********************************************************
PROCEDURE DIVISION.
MAINLINE.
*PERFORM 0000-INIT-READ-FILES.
PERFORM 9000-OPEN-FILES THRU 9000-OPEN-FILES-EXIT.
*PERFORM 0010-PROCCES-FILES UNTIL EOF MASTER OR EOF TRANS.
IF ERR-FLAG-CLEAR
PERFORM 5000-PROCESS-INPUT THRU 5000-PROCESS-INPUT-EXIT
END-IF.
*PERFORM 0020-CLOSE-FILES.
PERFORM 9700-CLOSE-FILES THRU 9700-CLOSE-FILES-EXIT.
GOBACK.
*—————————-
*0010-PROCESS-FILES.
*– IF MAST-ACCT-NUMBER = TRANS-ACCT-NUMBER
*– PERFORM 0030-PROCESS-ACCOUNT THRU
*– 0030-PROCESS-ACCOUNT-EXIT UNTIL
*– MAST-ACCT-NUMBER > TRANS-ACCT-NUMBER.
*– IF MAST-ACCT-NUMBER > TRANS-ACCT-NUMBER
*– READ NEXT TRANS-RECORD.
*– IF TRANS-ACCT-NUMBER > MAST-ACCT-NUMBER
*– READ NEXT MASTER-RECORD.
*0010-PROCESS-FILES-EXIT.
*– EXIT.
*0030-PROCESS-ACCOUNT.
*– IF BALANCE-AMOUNT >= TRANS-AMT
*– OUT-BALANCE-AMOUNT = BALANCE-AMOUNT – TRANS-AMT
*– OUT-TRANS-AMT = 0
*– ELSE
*– OUT-BALANCE-AMOUNT = BALANCE-AMOUNT
*– OUT-TRANS-AMT = TRANS-AMT
*– OUT-REJECT-IND = ‘Y’
*– END-IF.
*0030-PROCESS-ACCOUNT-EXIT.
*– EXIT.
***********************************************************
* Process Input Data- *
***********************************************************
5000-PROCESS-INPUT.
MOVE ‘Processing Input Rcds…’ to WS-PROG-STAT.
* Master File Read Loop (until EOF/EOD)-
PERFORM UNTIL EOMF-FLAG-TRUE
MOVE ‘Reading Master Rcd…’ to WS-PROG-STAT
PERFORM 6000-READ-MASTER-RCD
THRU 6000-READ-MASTER-RCD-EXIT
IF DEBUG-ON
IF TRANS-ACCTNMBR GREATER THAN MASTR-ACCTNMBR
DISPLAY ‘!! Looping Master to Trans Rcd(s)…’
ELSE DISPLAY ‘!! Processing Trans Rcd(s)…’
END-IF
END-IF
* No “Perform while…”; Suggested “TEST AFTER” doesn’t work-
*– PERFORM WITH TEST AFTER UNTIL EOTF-FLAG-TRUE OR
PERFORM UNTIL EOTF-FLAG-TRUE OR
TRANS-ACCTNMBR GREATER THAN MASTR-ACCTNMBR
* Process current Tran if read-ahead last Tx loop-
IF (NOT TRANS-PENDING) AND
TRANS-ACCTNMBR LESS OR EQUAL MASTR-ACCTNMBR
MOVE ‘Reading XAction Rcd…’ to WS-PROG-STAT
PERFORM 6100-READ-TRANS-RCD
THRU 6100-READ-TRANS-RCD-EXIT
ELSE MOVE SPACE TO TRANS-DEFER-FLAG
IF DEBUG-ON DISPLAY ‘** Process Deferred Trans Rcd…’
END-IF
END-IF
IF TRANS-ACCTNMBR EQUAL MASTR-ACCTNMBR
IF DEBUG-ON DISPLAY ‘!! A/N Match!!!’ END-IF
IF TRANS-AMOUNT GREATER THAN ACCT-BAL
MOVE ‘Y’ TO REJECT-IND
ELSE
SUBTRACT TRANS-AMOUNT FROM ACCT-BAL
*?? STRING ACCT-BAL INTO ACCOUNT-BALANCE (??)
*– MOVE ACCT-BAL TO OUT-BAL /* Right-justified */
*++ Attempt to mimic original input (left just balances)
MOVE ACCT-BAL TO DISPLAY-AN
INITIALIZE WS-I
INSPECT DISPLAY-AN TALLYING WS-I FOR LEADING SPACE
MOVE DISPLAY-AN(WS-I + 1 🙂 TO ACCOUNT-BALANCE
*+-
MOVE ‘0.00’ TO TRANS-AMT
END-IF
END-IF
IF TRANS-ACCTNMBR LESS OR EQUAL MASTR-ACCTNMBR
ADD +1 TO COUNT-TRANS-RCDS
PERFORM 7100-WRITE-TRANS-RCD
THRU 7100-WRITE-TRANS-RCD-EXIT
ELSE SET TRANS-PENDING TO TRUE
IF DEBUG-ON DISPLAY ‘** Write Trans Rcd Deferred…’
END-IF
END-IF
END-PERFORM
ADD +1 TO COUNT-MASTR-RCDS
PERFORM 7000-WRITE-MASTR-RCD
THRU 7000-WRITE-MASTR-RCD-EXIT
IF DEBUG-ON AND COUNT-MASTR-RCDS > 10
GO TO 5000-PROCESS-INPUT-EXIT
END-IF
END-PERFORM.
5000-PROCESS-INPUT-EXIT. EXIT.
***********************************************************
* Read Master Record- *
***********************************************************
6000-READ-MASTER-RCD.
MOVE ‘Reading Master Rcd…’ to WS-PROG-STAT.
READ MASTRIN AT END MOVE ‘T’ TO EOMF-FLAG END-READ.
IF EOMF-FLAG-FALSE AND IMSTAT NOT EQUAL ’00’
MOVE IMSTAT TO FSPA-STATUS-CODE-02
SET READING-FILE-FLAG TO TRUE
SET INPMSTR-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
ELSE
COMPUTE MASTR-ACCTNMBR = FUNCTION NUMVAL(MASTER-ACCT-NMBR)
COMPUTE ACCT-BAL = FUNCTION NUMVAL(ACCOUNT-BALANCE)
END-IF.
IF DEBUG-ON
DISPLAY ‘Mrcd@’, COUNT-MASTR-RCDS, ‘- AN: “‘,
MASTER-ACCT-NMBR, ‘” Bal: “‘, ACCOUNT-BALANCE, ‘”‘
DISPLAY ‘ -Xlated: “‘, MASTR-ACCTNMBR, ‘” , “‘,
ACCT-BAL, ‘”‘
END-IF.
6000-READ-MASTER-RCD-EXIT. EXIT.
***********************************************************
* Read Transacton Record- *
***********************************************************
6100-READ-TRANS-RCD.
MOVE ‘Reading XAction Rcd…’ to WS-PROG-STAT.
READ TRANSIN AT END MOVE ‘T’ TO EOTF-FLAG END-READ.
IF EOTF-FLAG-FALSE AND ITSTAT NOT EQUAL ’00’
MOVE ITSTAT TO FSPA-STATUS-CODE-02
SET READING-FILE-FLAG TO TRUE
SET INPTRAN-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
ELSE
COMPUTE TRANS-ACCTNMBR = FUNCTION NUMVAL(TRANS-ACCT-NMBR)
COMPUTE TRANS-AMOUNT = FUNCTION NUMVAL(TRANS-AMT)
END-IF.
IF DEBUG-ON
DISPLAY ‘Trcd@’, COUNT-TRANS-RCDS, ‘- AN: “‘,
TRANS-ACCT-NMBR, ‘” Amt: “‘, TRANS-AMT, ‘”‘
DISPLAY ‘ -Xlated: “‘, TRANS-ACCTNMBR, ‘” , “‘,
TRANS-AMOUNT, ‘”‘
END-IF.
6100-READ-TRANS-RCD-EXIT. EXIT.
***********************************************************
* Write Master Record- *
***********************************************************
7000-WRITE-MASTR-RCD.
MOVE ‘Writing Master Rcd…’ to WS-PROG-STAT.
MOVE MASTR-INP-RCD TO MASTR-OUT-RCD.
IF DEBUG-ON
DISPLAY ‘ >>Output MSTR: “‘, MASTR-OUT-RCD, ‘”‘
END-IF.
WRITE MASTR-OUT-RCD.
IF OMSTAT NOT EQUAL ZEROS
MOVE OMSTAT TO FSPA-STATUS-CODE-02
SET WRITING-FILE-FLAG TO TRUE
SET OUTMSTR-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
COMPUTE WS-I = FUNCTION MOD (COUNT-MASTR-RCDS 100000).
IF WS-I EQUAL ZERO
DISPLAY ‘* ‘, COUNT-MASTR-RCDS, ‘ MST Rcds Processed…’
END-IF.
7000-WRITE-MASTR-RCD-EXIT. EXIT.
***********************************************************
* Write Transacton Record- *
***********************************************************
7100-WRITE-TRANS-RCD.
MOVE ‘Writing XAction Rcd…’ to WS-PROG-STAT.
MOVE TRANS-INP-RCD TO TRANS-OUT-RCD.
IF DEBUG-ON
DISPLAY ‘ >>Output TRAN: “‘, TRANS-OUT-RCD, ‘”‘
END-IF.
WRITE TRANS-OUT-RCD.
IF OTSTAT NOT EQUAL ’00’
MOVE OTSTAT TO FSPA-STATUS-CODE-02
SET READING-FILE-FLAG TO TRUE
SET OUTTRAN-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
COMPUTE WS-I = FUNCTION MOD (COUNT-TRANS-RCDS 100000).
IF WS-I EQUAL ZERO
DISPLAY ‘* ‘, COUNT-TRANS-RCDS, ‘ TRN Rcds Processed…’
END-IF.
7100-WRITE-TRANS-RCD-EXIT. EXIT.
***********************************************************
* OPEN FILES- *
***********************************************************
9000-OPEN-FILES.
OPEN INPUT MASTRIN.
IF IMSTAT NOT EQUAL ZEROS
MOVE IMSTAT TO FSPA-STATUS-CODE-02
SET OPEN-FILE-FLAG TO TRUE
SET INPMSTR-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
OPEN INPUT TRANSIN.
IF ITSTAT NOT EQUAL ZEROS
MOVE ITSTAT TO FSPA-STATUS-CODE-02
SET OPEN-FILE-FLAG TO TRUE
SET INPTRAN-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
OPEN OUTPUT MSTROUT.
IF OMSTAT NOT EQUAL ZEROS
MOVE OMSTAT TO FSPA-STATUS-CODE-02
SET OPEN-FILE-FLAG TO TRUE
SET OUTMSTR-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
OPEN OUTPUT TRANOUT.
IF OTSTAT NOT EQUAL ZEROS
MOVE OTSTAT TO FSPA-STATUS-CODE-02
SET OPEN-FILE-FLAG TO TRUE
SET OUTTRAN-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
9000-OPEN-FILES-EXIT. EXIT.
***********************************************************
* CLOSE FILES- *
***********************************************************
9700-CLOSE-FILES.
CLOSE MASTRIN.
IF IMSTAT NOT EQUAL ZEROS
MOVE IMSTAT TO FSPA-STATUS-CODE-02
SET CLOSE-FILE-FLAG TO TRUE
SET INPMSTR-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
CLOSE TRANSIN.
IF ITSTAT NOT EQUAL ZEROS
MOVE ITSTAT TO FSPA-STATUS-CODE-02
SET CLOSE-FILE-FLAG TO TRUE
SET INPTRAN-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
CLOSE MSTROUT.
IF OMSTAT NOT EQUAL ZEROS
MOVE OMSTAT TO FSPA-STATUS-CODE-02
SET CLOSE-FILE-FLAG TO TRUE
SET OUTMSTR-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
CLOSE TRANOUT.
IF OMSTAT NOT EQUAL ZEROS
MOVE OTSTAT TO FSPA-STATUS-CODE-02
SET CLOSE-FILE-FLAG TO TRUE
SET OUTTRAN-FILE-FLAG TO TRUE
PERFORM 9900-RPT-FILE-ERROR
THRU 9900-RPT-FILE-ERROR-EXIT
END-IF.
9700-CLOSE-FILES-EXIT. EXIT.
***********************************************************
* FILE ERROR Routine *
***********************************************************
9900-RPT-FILE-ERROR.
MOVE WS-SIMOSTAT TO WS-DYNAM-PROGRAM-ID.
CALL WS-DYNAM-PROGRAM-ID USING
FILE-STATUS-PASS-AREA.
DISPLAY ‘Error ‘ ERR-DESC ‘file!’.
DISPLAY ‘2 byte status code is :’ FSPA-STATUS-CODE-02.
DISPLAY ‘4 byte status code is :’ FSPA-STATUS-CODE-04.
DISPLAY ‘Error text is :’ FSPA-TEXT-MESSAGE.
MOVE 0 TO CLN-UP.
MOVE 777 TO ABDCODE.
MOVE WS-ABEND TO WS-DYNAM-PROGRAM-ID.
CALL WS-DYNAM-PROGRAM-ID USING ABDCODE CLN-UP.
9900-RPT-FILE-ERROR-EXIT. EXIT.
//*******************************************************//
// END PROGRAM //
//*******************************************************//
Â