[USflag] The American Programmer [USflag]


Home
Books on Mainframe Programming
Mainframe Manuals and Tutorials
System Abend codes, Sqlcodes, VSAM/QSAM codes
Everything about the IBM AS/400 Midrange Computer
Everything about CICS
Everything about COBOL
Everything about DB2 and SQL
  DB2/SQL Singleton Select embedded in a COBOL program
  DB2/SQL Add Change Delete program
  DB2/SQL program to read table with cursor
  DB2/SQL load table program
  DB2/SQL program to read a table randomly
  DB2/SQL bare bones skeleton program
  DB2/SQL program to insert a row into a table
  DB2/SQL program to update a row
  DB2/SQL program for handling variable length column
  DB2/SQL program for handling column with null indicator
  Embedded SQL. Short tutorial.
  Examples of DCLGEN. Short tutorial.
  Examples of SQL Joins. Short tutorial.
  Examples of DB2 View. Short tutorial.
  Just Enough SQL/QMF/SPUFI To Be Dangerous
  Sample tables STAFF, ORG, EMP and DEPT
  QMF Procedures Written in REXX
  Using REXX Subroutines with the QMF Calc panel
  Using QMF to Execute Your SQL
  QMF Cheat Sheet. Edit codes. QMF Commands, Text Variables, Usage Codes
  Executing SQL in a batch job
  Using Spufi to Execute Your SQL
  Books on DB2 and SQL
  DB2 and SQL, Structured Query Language manuals
  SQLCODES and Their Causes
Everything about IMS
Everything about Java and JavaScript
Everything about JCL and JES
Everything about REXX
Everything about zOS, VSAM, Tivoli, Assembler
Everything about TSO, ISPF, Spufi
Site Map and Site Search

           Home   > DB2 and SQL   > INSERT UPDATE and DELETE into DB2 table

Description of the example tables STAFF, ORG, EMP and DEPT

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'DB2ACD1'.
000300*  SAMPLE COBOL PROGRAM
000400* RANDOM UPDATE
000600* BASED ON A REGULAR FILE READ SEQUENTIALLY (MEMBER TRANSACD)
000700*   ADD, CHANGE, DELETE BASED ON THE TRANS CODE
000800*   IN THE REGULAR FILE
000900 ENVIRONMENT DIVISION.
001000 CONFIGURATION SECTION.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300     SELECT TRANS-FILE  ASSIGN TRANSACD.
001400 DATA DIVISION.
001500 FILE SECTION.
001600 FD  TRANS-FILE
001700     RECORDING MODE IS F
001800     RECORD CONTAINS 80 CHARACTERS.
001900
002000 01  TRANS-RECORD.
002100     05  TRANS-CODE           PIC X(01).
002200         88  ADD-TRANS        VALUE 'A'.
002300         88  CHANGE-TRANS     VALUE 'C'.
002400         88  DELETE-TRANS     VALUE 'D'.
002500     05  FILLER               PIC X(01).
002600     05  TRANS-TEMPID         PIC 9(04).
002700     05  FILLER               PIC X(01).
002800     05  TRANS-NAME           PIC X(09).
002900     05  FILLER               PIC X(01).
003000     05  TRANS-ADDRESS        PIC X(17).
003100     05  FILLER               PIC X(01).
003200     05  TRANS-EDLEVEL        PIC 9(04).
003300     05  FILLER               PIC X(01).
003400     05  TRANS-COMMENTS       PIC X(29).
003500     05  FILLER               PIC X(01).
003600
003700 WORKING-STORAGE SECTION.
003800 01  SWITCHES.
003900      05  FILE-AT-END     PIC X  VALUE 'N'.
004000
004100 01  COUNTERS-AND-ACCUMULATORS.
004200      05  TRANS-RECORD-COUNT  PIC S9(7) PACKED-DECIMAL VALUE ZERO.
004300      05  TRANS-ADD-COUNT     PIC S9(7) PACKED-DECIMAL VALUE ZERO.
004400      05  TRANS-CHANGE-COUNT  PIC S9(7) PACKED-DECIMAL VALUE ZERO.
004500      05  TRANS-DELETE-COUNT  PIC S9(7) PACKED-DECIMAL VALUE ZERO.
004600
004700 01  DISPLAY-SQLCODE       PIC Z(8)9-.
004800
004900 01  ERR-MESS-DATA.
005000     05  ERR-MESS-LEN      PIC S9(4)   BINARY VALUE +960.
005100     05  ERR-MESS-TEXT     PIC X(120) OCCURS 8 TIMES
005200         INDEXED BY ERR-INDEX.
005300 01  ERR-TEXT-LEN          PIC S9(9) BINARY VALUE +120.
005400
005600*
005800     EXEC SQL
005900            INCLUDE SQLCA
006000     END-EXEC.
006100
006200     EXEC SQL
006300            INCLUDE APPLICAN
006400     END-EXEC.
006500
006600 PROCEDURE DIVISION.
006700     DISPLAY 'STARTING  PROGRAM DB2ACD1'
006800
006900     PERFORM INITIALIZATION
007000     PERFORM PROCESS-ALL
007100         UNTIL FILE-AT-END = 'Y'
007200     PERFORM TERMINATION.
007300*    EXEC SQL
007400*    DO A ROLLBACK IF YOU WANT
007500*        ROLLBACK
007600*    END-EXEC
007700
007800*    DISPLAY 'ROLLBACK DONE AT NORMAL END OF PROGRAM'
007900
008000     GOBACK.
008100
008200 INITIALIZATION.
008500     OPEN INPUT TRANS-FILE
008600     PERFORM READ-PAR.
008700
008800 PROCESS-ALL.
009000     PERFORM PROCESS-TRANS
009100     PERFORM READ-PAR.
009200
009300 TERMINATION.
09600     CLOSE TRANS-FILE.
009700
009800 READ-PAR.
010300     READ TRANS-FILE
010400         AT END MOVE 'Y' TO FILE-AT-END
010500     END-READ.
010600
010700 PROCESS-TRANS.
011100     DISPLAY SPACE
011200     EVALUATE TRUE
011300      WHEN ADD-TRANS PERFORM PROCESS-ADD-TRANS
011400      WHEN CHANGE-TRANS PERFORM PROCESS-CHANGE-TRANS
011500      WHEN DELETE-TRANS PERFORM PROCESS-DELETE-TRANS
011600      WHEN OTHER PERFORM PROCESS-UNKNOWN-TRANS
011700     END-EVALUATE.
011800
011900 PROCESS-ADD-TRANS.
012400     PERFORM MOVE-FIELDS-TO-DCLGEN
012500     PERFORM SQL-FOR-ADD
012600     EVALUATE TRUE
012700        WHEN SQLCODE = 0 DISPLAY 'SUCCESSFUL ADD'
012800*                             DISPLAY TRANS-RECORD
012900        WHEN SQLCODE = -803
013000             DISPLAY 'CANNOT ADD '
013100*            DISPLAY TRANS-RECORD
013200             DISPLAY 'DUPLICATE -803'
013300        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
013400             PERFORM WARNING-PARAGRAPH
013500        WHEN SQLCODE < 0 GO TO ERROR-EXIT
013600     END-EVALUATE.
013700
013800 PROCESS-CHANGE-TRANS.
014300     PERFORM MOVE-FIELDS-TO-DCLGEN
014400     PERFORM SQL-FOR-CHANGE
014500     EVALUATE TRUE
014600        WHEN SQLCODE = 0
014700             DISPLAY 'SUCCESSFUL CHANGE'
014800*            DISPLAY TRANS-RECORD
014900        WHEN SQLCODE = -803
015000             DISPLAY 'CANNOT CHANGE'
015100*            DISPLAY TRANS-RECORD
015200             DISPLAY 'DUPLICATE -803'
015300        WHEN SQLCODE = -530
015400             DISPLAY 'CANNOT CHANGE'
015500*            DISPLAY TRANS-RECORD
015600             DISPLAY 'RI - 530'
015700        WHEN SQLCODE = -532
015800             DISPLAY 'CANNOT CHANGE'
015900*            DISPLAY TRANS-RECORD
016000             DISPLAY 'RI - 532'
016100        WHEN SQLCODE = +100
016200             DISPLAY 'CANT CHANGE '
016300*            DISPLAY TRANS-RECORD
016400             DISPLAY 'NOTFOUND'
016500        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
016600             PERFORM WARNING-PARAGRAPH
016700        WHEN SQLCODE < 0 GO TO ERROR-EXIT
016800     END-EVALUATE.
016900
017000 PROCESS-DELETE-TRANS.
017500     MOVE TRANS-TEMPID    TO TEMPID
017600     PERFORM SQL-FOR-DELETE
017700     EVALUATE TRUE
017800        WHEN SQLCODE = 0 DISPLAY 'SUCCESSFUL DELETE'
017900*                             DISPLAY TRANS-RECORD
018000        WHEN SQLCODE = +100
018100             DISPLAY 'CANT DELETE '
018200*            DISPLAY TRANS-RECORD
018300             DISPLAY 'NOTFOUND'
018400        WHEN SQLCODE = -530
018500             DISPLAY 'CANNOT DELETE'
018600*            DISPLAY TRANS-RECORD
018700             DISPLAY 'RI - 530'
018800        WHEN SQLCODE = -532
018900             DISPLAY 'CANNOT DELETE'
019000*            DISPLAY TRANS-RECORD
019100             DISPLAY 'RI - 532'
019200        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
019300             PERFORM WARNING-PARAGRAPH
019400        WHEN SQLCODE < 0 GO TO ERROR-EXIT
019500     END-EVALUATE.
019600
019700 PROCESS-UNKNOWN-TRANS.
019800     DISPLAY 'TRANSACTION CODE ' TRANS-CODE ' IS UNKNOWN'
019900     DISPLAY 'ON RECORD # ' TRANS-RECORD-COUNT.
020000
020100 SQL-FOR-ADD.
020600     PERFORM ADD-DISPLAY
020700     EXEC SQL
020800     INSERT INTO APPLICANT
020900       (TEMPID, NAME, ADDRESS, EDLEVEL, COMMENTS)
021000       VALUES
021100       (:TEMPID, :NAME-X, :ADDRESS-X, :EDLEVEL, :COMMENTS)
021200     END-EXEC.
021300
021400 SQL-FOR-CHANGE.
022200     PERFORM CHANGE-DISPLAY
022300     EXEC SQL
022400     UPDATE APPLICANT
022500       SET
022600          NAME      = :NAME-X,
022700          ADDRESS   = :ADDRESS-X,
022800          EDLEVEL   = :EDLEVEL,
022900          COMMENTS  = :COMMENTS
023000        WHERE TEMPID = :TEMPID
023100     END-EXEC.
023200
023300 SQL-FOR-DELETE.
023900     PERFORM DELETE-DISPLAY
024000     EXEC SQL
024100     DELETE FROM APPLICANT
024200        WHERE TEMPID = :TEMPID
024300     END-EXEC.
024400
024500 MOVE-FIELDS-TO-DCLGEN.
025100*
025200       MOVE TRANS-TEMPID    TO TEMPID
025300       MOVE 9               TO NAME-LEN
025400       MOVE TRANS-NAME      TO NAME-TEXT
025500       MOVE 17              TO ADDRESS-LEN
025600       MOVE TRANS-ADDRESS   TO ADDRESS-TEXT
025700       MOVE TRANS-EDLEVEL   TO EDLEVEL
025800       MOVE 29              TO COMMENTS-LEN
025900       MOVE TRANS-COMMENTS  TO COMMENTS-TEXT.
026000
026100 ERROR-EXIT.

026900     MOVE SQLCODE TO DISPLAY-SQLCODE.
027000     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE

           EVALUATE TRUE
             WHEN SQLCODE = 0
      *           DISPLAY 'SUCCESSFUL EXECUTION'
                  CONTINUE
             WHEN SQLCODE = +100
      *           DISPLAY 'NOT FOUND'
                  CONTINUE
             WHEN SQLCODE = -180
                  DISPLAY 'BAD DATA IN DATE/TIME/TIMESTAMP'
             WHEN SQLCODE = -181
                  DISPLAY 'BAD DATA IN DATE/TIME/TIMESTAMP'
             WHEN SQLCODE = -305
                  DISPLAY 'NO NULL INDICATOR'
             WHEN SQLCODE = -311
                  DISPLAY 'LENGTH OF VARIABLE WRONG'
             WHEN SQLCODE = -501
                  DISPLAY 'CURSOR NOT OPEN ON FETCH'
             WHEN SQLCODE = -530
                  DISPLAY 'RI INS/UPD'
             WHEN SQLCODE = -532
                  DISPLAY 'RI DELETE'
             WHEN SQLCODE = -803
                  DISPLAY 'DUP ROW '
             WHEN SQLCODE = -805
                  DISPLAY 'DBRM NOT FOUND IN PLAN'
             WHEN SQLCODE = -811
                  DISPLAY 'MORE THAN 1 ROW ON SELECT INTO '
             WHEN SQLCODE = -818
                  DISPLAY 'TIMESTAMP MISMATCH, LOAD MOD/PLAN'
             WHEN SQLCODE = -904
                  DISPLAY 'UNAVAIL RESOURCE'
             WHEN SQLCODE = -911
                  DISPLAY 'DEADLOCK/TIMEOUT, ROLLBACK DONE'
             WHEN SQLCODE = -913
                  DISPLAY 'DEADLOCK/TIMEOUT VICTIM, NO ROLLBACK'
             WHEN OTHER
                  DISPLAY 'SEVERE SQL ERROR'
             END-EVALUATE
                                                             030100
030200     CALL 'DSNTIAR' USING SQLCA ERR-MESS-DATA ERR-TEXT-LEN
030300
030400     PERFORM ERROR-EXIT-PRINT-ERROR
030500           VARYING ERR-INDEX FROM 1 BY 1 UNTIL ERR-INDEX > 8
030600
030700*    IN REAL LIFE YOU WOULD CALL AN ABORT ROUTINE
030800     EXEC SQL
030900         ROLLBACK
031000     END-EXEC
031100
031200     DISPLAY 'ROLLBACK DONE'
031300
031400     GOBACK.
031500
031600 ERROR-EXIT-PRINT-ERROR.
031700     IF ERR-MESS-TEXT(ERR-INDEX) NOT = SPACES
031800     THEN DISPLAY  ERR-MESS-TEXT(ERR-INDEX).
031900
032000 WARNING-PARAGRAPH.
032100     MOVE SQLCODE TO DISPLAY-SQLCODE.
032200     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE
032300     IF SQLWARN1 = 'W'
032400        THEN DISPLAY 'CHARACTER DATA TRUNCATED'
032500             'SQLWARN1 = W'
032600     END-IF
032700
032800     IF SQLWARN2 = 'W'
032900        THEN DISPLAY 'A FUNCTION HANDLED A NULL BY IGNORING IT'
033000             'SQLWARN2 = W'
033100     END-IF
033200
033300     IF SQLWARN3 = 'W'
033400        THEN DISPLAY 'THE NUMBER OF HOST VARIABLES IS LESS  '
033500             'THAN THE NUMBER OF COLUMNS SELECTED  '
033600             'SQLWARN3 = W'
033700     END-IF
033800
033900     IF SQLWARN4 = 'W'
034000        THEN DISPLAY 'A DYNAMIC SQL UPDATE/DELETE DOES NOT  '
034100             'CONTAIN A WHERE CLAUSE  '
034200             'SQLWARN4 = W'
034300     END-IF
034400
034500     IF SQLWARN5 = 'W'
034600        THEN DISPLAY 'DYNAMIC SQL DOES NOT CONTAIN VALID SQL'
034700             'SQLWARN5 = W'
034800     END-IF
034900
035000     IF SQLWARN6 = 'W'
035100        THEN DISPLAY 'DATE/TIMESTAMP ARITHMETIC '
035200             'PRODUCES AN INVALID DATE EX: NOV 31'
035300             'IT IS CHANGED TO LAST DAY OF MONTH EX: NOV 30'
035400             'SQLWARN6 = W'
035500     END-IF
035600
035700     IF SQLWARN7 = 'W'
035800        THEN DISPLAY 'CHARACTER DATA TRUNCATED '
035900             'POSSIBLE LOW ORDER TRUNCATION      '
036000             'SQLWARN7 = W'
036100     END-IF
036200
036300     IF SQLWARN8 = 'W'
036400        THEN DISPLAY 'A CHARACTER COULD NOT BE CONVERTED '
036500             'SQLWARN8 = W'
036600     END-IF
036700
036800     IF SQLWARN9 = 'W'
036900        THEN DISPLAY 'ARITHMETIC DATA ERRORS FOUND'
037000             'WHILE DOING A COUNT(DISTINCT)      '
037100             'SQLWARN9 = W'
037200     END-IF
037300
037400     IF SQLWARNA = 'W'
037500        THEN DISPLAY 'CHARACTER CONVERSION ERROR'
037600             'IN SQLCA OR SQLDA. THE CODE WILL BE INVALID'
037700             'SQLWARNA = W'
037800     END-IF.
037900
038000 ADD-DISPLAY.
038100     DISPLAY 'ADDING'        SPACE
038200     DISPLAY 'TEMPID'        SPACE
038300             TEMPID
038400     DISPLAY 'NAME-X'        SPACE
038500             NAME-X
038600     DISPLAY 'ADDRESS-X'     SPACE
038700             ADDRESS-X
038800     DISPLAY 'EDLEVEL'       SPACE
038900             EDLEVEL
039000     DISPLAY 'COMMENTS'      SPACE
039100             COMMENTS.
039200
039300 CHANGE-DISPLAY.
039400     DISPLAY 'CHANGING'      SPACE
039500     DISPLAY 'TEMPID'        SPACE
039600             TEMPID
039700     DISPLAY 'NAME-X'        SPACE
039800             NAME-X
039900     DISPLAY 'ADDRESS-X'     SPACE
040000             ADDRESS-X
040100     DISPLAY 'EDLEVEL'       SPACE
040200             EDLEVEL
040300     DISPLAY 'COMMENTS'      SPACE
040400             COMMENTS.
040500
040600 DELETE-DISPLAY.
040700     DISPLAY 'DELETING'
040800      'TEMPID  ' SPACE TEMPID.
040900



Top of Page




















































































List of books on DB2 and other mainframe topics

[Books Computer]

Home Books for Computer Professionals Privacy Terms |
Site Map and Site Search Programming Manuals and Tutorials The REXX Files Top of Page |