Skip to content

Instantly share code, notes, and snippets.

@sandeep-sparrow

sandeep-sparrow/DB2PGM6.cbl

Created June 27, 2020 13:54
Show Gist options
  • Save sandeep-sparrow/00e7829f68bbfa3d7b7a2811169483d3 to your computer and use it in GitHub Desktop.
Save sandeep-sparrow/00e7829f68bbfa3d7b7a2811169483d3 to your computer and use it in GitHub Desktop.
Download ZIP
This COBOL program demonstrate a simple application which performs DB2 Database changes, as per transaction code from VSAM file. (Thanks Murach's & Uday Sir aka Captain)
Raw
DB2PGM6.cbl
******************************************************************
* Author: SANDEEP PRAJAPATI
* Date: 23-06-2020
* Purpose: INTERACTIVE COBOL DB2 PROGRAM
******************************************************************
IDENTIFICATION DIVISION.
*
PROGRAM-ID. DB2PGM6.
*
ENVIRONMENT DIVISION.
*
INPUT-OUTPUT SECTION.
*
FILE-CONTROL.
*
SELECT CUSTRAN ASSIGN TO AS-DISK1
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS CUST-TRANS1-WS.
*
SELECT BADTRAN ASSIGN TO SP-DISK2
FILE STATUS IS BAD-TRANS-WS.
*
DATA DIVISION.
*
FILE SECTION.
*
FD CUSTRAN
RECORD CONTAINS 405 CHARACTERS.
*
01 CUSTOMER-TRN-RECORD.
05 CTR-TRN-CODE PIC X(01).
05 CTR-TRN-DATA.
10 CTR-CUSTOMER-NUMBER PIC X(06).
10 CTR-CUSTOMER-DETAILS PIC X(398).
*
FD BADTRAN
RECORDING MODE F
RECORD CONTAINS 405 CHARACTERS.
*
01 BAD-TRANSACTION-REC.
05 BTR-DATA PIC X(405).
*
WORKING-STORAGE SECTION.
*
*DCLGENS
*
EXEC SQL INCLUDE CUSTOMER END-EXEC.
EXEC SQL INCLUDE SQLCA END-EXEC.
*
*FILE STATUS
*
01 FILE-STATUS-WS.
05 CUST-TRANS1-WS PIC X(02) VALUE SPACES.
05 BAD-TRANS-WS PIC X(02) VALUE SPACES.
*
*SWITCHES
*
01 SWITCHES.
05 END-OF-RECORD-SW PIC X(01) VALUE 'N'.
88 END-OF-RECORD VALUE 'Y'.
05 DUPLICATE-CUSTOMER-SW PIC X(01) VALUE 'N'.
88 DUPLICATE-CUSTOMER VALUE 'Y'.
05 RECORD-NOT-FOUND-SW PIC X(01) VALUE 'N'.
88 RECORD-NOT-FOUND VALUE 'Y'.
*
*COUNTERS
*
01 COUNTERS.
05 READ-COUNT PIC 9(02).
05 INSERT-COUNT PIC 9(02).
05 UPDATE-COUNT PIC 9(02).
05 DELETE-COUNT PIC 9(02).
05 WRITE-COUNT PIC 9(02).
*
PROCEDURE DIVISION.
*
000-PROCESS-DATABASE.
*
DISPLAY "*** ***"
DISPLAY "CUSTOMER-DATABASE-UPDATE"
DISPLAY "*** ***"
*
PERFORM 100-OPEN-FILES
*
PERFORM 210-READ-CUST-TRANS1-FILE
*
PERFORM 200-PROCESS-FILE-DATA
UNTIL END-OF-RECORD
*
PERFORM 400-CLOSE-FILES
*
PERFORM 500-DISPLAY-REPORT
*
DISPLAY "END OF SESSION, GOODBYE!"
*
STOP RUN.
*
100-OPEN-FILES.
*
OPEN INPUT CUSTRAN
OPEN OUTPUT BADTRAN.
*
200-PROCESS-FILE-DATA.
*
DISPLAY 'CUSTOMER CODE : ' CTR-TRN-CODE
DISPLAY 'CUSTOMER NO : ' CUSTNO
*
EVALUATE CTR-TRN-CODE
WHEN 'A'
PERFORM 310-INSERT-CUSTOMER-DATA
WHEN 'D'
PERFORM 320-DELETE-CUSTOMER-DATA
WHEN 'R'
PERFORM 330-UPDATE-CUSTOMER-DATA
WHEN OTHER
PERFORM 340-WRITE-BAD-TRANS
END-EVALUATE
*
PERFORM 210-READ-CUST-TRANS1-FILE.
*
210-READ-CUST-TRANS1-FILE.
*
READ CUSTRAN
*
EVALUATE CUST-TRANS1-WS
WHEN '00'
MOVE CTR-TRN-DATA TO CUST-ROW
ADD 1 TO READ-COUNT
WHEN '10'
MOVE 'Y' TO END-OF-RECORD-SW
END-EVALUATE.
*
310-INSERT-CUSTOMER-DATA.
*
EXEC SQL
INSERT INTO CUST(CUSTNO,
FNAME,
LNAME,
ADDR,
CITY,
STATE,
ZIPCODE,
HOMEPH,
WORKPH,
NOTES)
VALUES(:CUSTNO,
:FNAME,
:LNAME,
:ADDR,
:CITY,
:STATE,
:ZIPCODE,
:HOMEPH,
:WORKPH,
:NOTES)
END-EXEC
*
DISPLAY 'INSERT SQLCODE : ' SQLCODE
DISPLAY 'CUSTOMER NUMBER: ' CUSTNO
*
EVALUATE SQLCODE
WHEN 0
DISPLAY 'RECORD INSERTED.'
ADD 1 TO INSERT-COUNT
WHEN -803
MOVE 'Y' TO DUPLICATE-CUSTOMER-SW
END-EVALUATE.
*
IF DUPLICATE-CUSTOMER
DISPLAY '------>'
DISPLAY 'CANNOT INSERT DUPLICATE RECORD'
DISPLAY 'RECORD IS MOVED TO BAD TRANS FILE'
DISPLAY '------>'
PERFORM 340-WRITE-BAD-TRANS
END-IF.
*
320-DELETE-CUSTOMER-DATA.
*
MOVE 'N' TO RECORD-NOT-FOUND-SW
*
EXEC SQL
DELETE FROM CUST
WHERE CUSTNO = :CUSTNO
END-EXEC
*
DISPLAY 'SQLCODE : ' SQLCODE
DISPLAY 'CUSTOMER NUMBER: ' CUSTNO
*
IF SQLCODE IS EQUAL 0
DISPLAY 'RECORD DELETED.'
ADD 1 TO DELETE-COUNT
END-IF
*
IF SQLCODE IS EQUAL 100
MOVE 'Y' TO RECORD-NOT-FOUND-SW
END-IF
*
IF RECORD-NOT-FOUND
DISPLAY '------>'
DISPLAY 'RECORD NOT PRESENT, CANNOT PERFORM DELETION'
DISPLAY 'RECORD IS MOVED TO BAD TRANS FILE'
DISPLAY '------>'
PERFORM 340-WRITE-BAD-TRANS
END-IF.
*
330-UPDATE-CUSTOMER-DATA.
*
MOVE 'N' TO RECORD-NOT-FOUND-SW
*
EXEC SQL
UPDATE CUST
SET CUSTNO = :CUSTNO,
FNAME = :FNAME,
LNAME = :LNAME,
ADDR = :ADDR,
CITY = :CITY,
STATE = :STATE,
ZIPCODE = :ZIPCODE,
HOMEPH = :HOMEPH,
WORKPH = :WORKPH,
NOTES = :NOTES
WHERE CUSTNO = :CUSTNO
END-EXEC
*
DISPLAY 'UPDATE SQLCODE: ' SQLCODE
DISPLAY 'CUSTOMER-NUMBER:' CUSTNO
*
IF SQLCODE IS EQUAL 0
DISPLAY 'RECORD UPDATED.'
ADD 1 TO UPDATE-COUNT
END-IF
*
IF SQLCODE IS EQUAL 100
MOVE 'Y' TO RECORD-NOT-FOUND-SW
END-IF.
*
IF RECORD-NOT-FOUND
DISPLAY '------>'
DISPLAY 'RECORD NOT PRESENT, CANNOT PERFORM UPDATION'
DISPLAY 'RECORD IS MOVED TO BAD TRANS FILE'
DISPLAY '------>'
PERFORM 340-WRITE-BAD-TRANS
END-IF.
*
340-WRITE-BAD-TRANS.
*
MOVE CUSTOMER-TRN-RECORD TO BAD-TRANSACTION-REC
*
WRITE BAD-TRANSACTION-REC
*
IF BAD-TRANS-WS IS EQUAL '00'
ADD 1 TO WRITE-COUNT
END-IF.
*
400-CLOSE-FILES.
*
CLOSE CUSTRAN
CLOSE BADTRAN.
*
500-DISPLAY-REPORT.
*
DISPLAY "*** ***"
DISPLAY 'CUSTOMER DATABASE MODIFIED SUCCESSFULLY'
DISPLAY 'NO OF RECORDS READ : ' READ-COUNT
DISPLAY 'NO OF RECORDS INSERTED: ' INSERT-COUNT
DISPLAY 'NO OF RECORDS DELETED : ' DELETE-COUNT
DISPLAY 'NO OF RECORDS UPDATED : ' UPDATE-COUNT
DISPLAY 'NO OF RECORDS WRITTEN : ' WRITE-COUNT
DISPLAY "*** ***".
*
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment