Skip to content

Instantly share code, notes, and snippets.

@sandeep-sparrow

sandeep-sparrow/EXTERM.cbl

Created October 21, 2020 06:51
Show Gist options
  • Save sandeep-sparrow/147766151d7a634bd9d6bd9d51eecac6 to your computer and use it in GitHub Desktop.
Save sandeep-sparrow/147766151d7a634bd9d6bd9d51eecac6 to your computer and use it in GitHub Desktop.
Download ZIP
A Main Program that opens a sequential file and calls a subprogram each time it need a record. share the same file between the two program by making the file external with a shared file status.
Raw
Readme.txt
Main program EXTERM calls subroutine EXTERS which shares an external file to read records sequentially and return it back to main program
from the LINKAGE SECTION.
EXTERM opens a customer file in I-O mode and calls EXTERS to read records and set flag RECORD-FOUND to "Y" if record found with the input
customer id accepted in calling program.
validate the input, call the sub routine (read, return with flag set respectively), display output
Raw
EXTERM.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. EXTERM.
AUTHOR. SANDEEP.
DATE-WRITTEN. 21-10-2020.
************************************************************
* DATA DIVISION
************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*SOURCE-COMPUTER. IBM-390 WITH DEBUGGING MODE.
SOURCE-COMPUTER. IBM-390.
OBJECT-COMPUTER. IBM-390.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUSTOMER
ASSIGN TO CUSTOMER
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS MYSTATUS.
DATA DIVISION.
FILE SECTION.
FD CUSTOMER IS EXTERNAL
RECORDING MODE IS F
RECORD CONTAINS 30 CHARACTERS
BLOCK CONTAINS 0 RECORDS.
01 CU-ACC-REC.
05 CU-CUSTOMER-ID PIC 9(04).
05 CU-ACCOUNT-NO PIC 9(06).
05 CU-ACCOUNT-BAL PIC 9(08).
05 CU-OPENING-DATE PIC X(10).
05 CU-ACCOUNT-TYPE PIC X(01).
05 CU-ACCOUNT-STATUS PIC X(01).
************************************************************
* WORKING STORAGE SECTION TO DECLARE DATA ITEMS *
************************************************************
WORKING-STORAGE SECTION.
01 WS-INPUT PIC X(04).
01 MYSTATUS PIC X(02) EXTERNAL.
01 WS-ACC-REC.
05 WS-CUSTOMER-ID PIC 9(04).
05 WS-ACCOUNT-NO PIC 9(06).
05 WS-ACCOUNT-BAL PIC 9(08).
05 WS-OPENING-DATE PIC X(10).
05 WS-ACCOUNT-TYPE PIC X(01).
05 WS-ACCOUNT-STATUS PIC X(01).
*SWITCH
01 SWITCH.
05 ACCOUNT-FOUND-SW PIC X VALUE SPACE.
88 ACCOUNT-FOUND VALUE 'Y'.
05 VALID-INPUT-SW PIC X VALUE SPACE.
88 VALID-INPUT VALUE 'Y'.
*
COPY STATUS.
************************************************************
* PROCEDURE BIVISION *
************************************************************
PROCEDURE DIVISION.
A000-MAIN-PARA.
DISPLAY 'WELCOME TO MALAD BANK'
ACCEPT WS-INPUT
DISPLAY 'ENTERED CUSTOMER ID:' WS-INPUT
IF WS-INPUT IS NOT NUMERIC THEN
MOVE 'N' TO VALID-INPUT-SW
ELSE
SET VALID-INPUT TO TRUE
END-IF
IF VALID-INPUT
PERFORM B000-OPEN-PARA THRU B000-EXIT
PERFORM C000-CALL-SUBROUTINE THRU C000-EXIT
IF ACCOUNT-FOUND
DISPLAY "YOU ACCOUNT DETAILS ARE --->"
DISPLAY "CUSTOMER ID : " WS-CUSTOMER-ID
DISPLAY "ACCOUNT NO : " WS-ACCOUNT-NO
DISPLAY "ACCOUNT BAL : " WS-ACCOUNT-BAL
DISPLAY "OPENING DATE : " WS-OPENING-DATE
DISPLAY "ACCOUNT TYPE : " WS-ACCOUNT-TYPE
DISPLAY "ACCOUNT STATUS: " WS-ACCOUNT-STATUS
DISPLAY "END OF REPORT --->"
END-IF
PERFORM D000-CLOSE-PARA THRU D000-EXIT
ELSE
DISPLAY 'INVALID CUSTOMER ID'
END-IF
IF NOT ACCOUNT-FOUND THEN
DISPLAY 'CUSTOMER ID NOT FOUND, PLEASE TRY AGAIN!'
END-IF
.
A000-EXIT.
EXIT
.
STOP RUN.
B000-OPEN-PARA.
OPEN I-O CUSTOMER
MOVE MYSTATUS TO STS-STATUS
D DISPLAY "STS-STATUS:" STS-STATUS
IF STS-STATUS NOT = 0 THEN
GO TO Z000-ERRORHANDLING
END-IF
.
B000-EXIT.
EXIT.
C000-CALL-SUBROUTINE.
CALL 'EXTERS' USING WS-ACC-REC,
WS-INPUT,
ACCOUNT-FOUND-SW.
C000-EXIT.
EXIT.
D000-CLOSE-PARA.
CLOSE CUSTOMER
MOVE MYSTATUS TO STS-STATUS
D DISPLAY "STS-STATUS:" STS-STATUS
IF STS-STATUS NOT = 0 THEN
GO TO Z000-ERRORHANDLING
END-IF
.
D000-EXIT.
EXIT.
Z000-ERRORHANDLING.
CALL 'ERRPGM' USING WS-ERRPARM
STOP RUN
.
Raw
EXTERS.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. EXTERS.
AUTHOR. SANDEEP.
DATE-WRITTEN. 21-10-2020.
************************************************************
* DATA DIVISION
************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
*SOURCE-COMPUTER. IBM-390 WITH DEBUGGING MODE.
SOURCE-COMPUTER. IBM-390.
OBJECT-COMPUTER. IBM-390.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUSTOMER
ASSIGN TO CUSTOMER
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS MYSTATUS.
DATA DIVISION.
FILE SECTION.
FD CUSTOMER IS EXTERNAL
RECORDING MODE IS F
RECORD CONTAINS 30 CHARACTERS
BLOCK CONTAINS 0 RECORDS.
01 CU-ACC-REC.
05 CU-CUSTOMER-ID PIC 9(04).
05 CU-ACCOUNT-NO PIC 9(06).
05 CU-ACCOUNT-BAL PIC 9(08).
05 CU-OPENING-DATE PIC X(10).
05 CU-ACCOUNT-TYPE PIC X(01).
05 CU-ACCOUNT-STATUS PIC X(01).
************************************************************
* WORKING STORAGE SECTION TO DECLARE DATA ITEMS *
************************************************************
WORKING-STORAGE SECTION.
01 MYSTATUS PIC X(02) EXTERNAL.
COPY STATUS.
LINKAGE SECTION.
01 LS-ACC-REC PIC X(30).
01 LS-INPUT PIC 9(04).
01 LS-ACCOUNT-FOUND PIC X(01).
*
PROCEDURE DIVISION USING LS-ACC-REC,
LS-INPUT,
LS-ACCOUNT-FOUND.
PERFORM A000-READ-PARA THRU A000-EXIT
EXIT PROGRAM.
A000-READ-PARA.
D DISPLAY "INPUT FROM CALLING PROGRAM: " LS-INPUT
PERFORM UNTIL STS-EOF OR LS-ACCOUNT-FOUND = 'Y'
READ CUSTOMER
MOVE MYSTATUS TO STS-STATUS
D DISPLAY "STS-STATUS:" STS-STATUS
IF STS-STATUS = 0 THEN
MOVE CU-ACC-REC TO LS-ACC-REC
IF CU-CUSTOMER-ID = LS-INPUT
MOVE 'Y' TO LS-ACCOUNT-FOUND
END-IF
ELSE
IF STS-STATUS NOT = 10 THEN
GO TO Z000-ERRORHANDLING
END-IF
END-IF
END-PERFORM
.
A000-EXIT.
EXIT.
Z000-ERRORHANDLING.
CALL 'ERRPGM' USING WS-ERRPARM
STOP RUN
.
Raw
output.txt
1.
PROGRAM TO READ BANK ACCOUNT FILE
YOU HAVE ENTERED: 1003
YOU ACCOUNT DETAILS ARE --->
CUSTOMER ID : 1003
ACCOUNT NO : 100027
ACCOUNT BAL : 00064000
OPENING DATE : 2020-10-19
ACCOUNT TYPE : S
ACCOUNT STATUS: A
END OF RECORD --->
2.
ROGRAM TO READ BANK ACCOUNT FILE
OU HAVE ENTERED: 1103
USTOMER ID NOT FOUND, PLEASE TRY AGAIN!
3.
PROGRAM TO READ BANK ACCOUNT FILE
YOU HAVE ENTERED: 1XX3
INVALID CUSTOMER ID
CUSTOMER ID NOT FOUND, PLEASE TRY AGAIN!
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment