[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   > Load a table from sequential file, in Embedded SQL

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

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'DB2LOD1'.
000300* LOAD A DB2 TABLE
000400*     OPTIONALLY DELETES ALL ROWS IN APPLICANT
000500*     INSERTS ROWS FROM SEQFILE
000600* RECORDS DO NOT HAVE TO BE IN SEQUENCE, BUT NO DUP KEYS ALLOWED
000700 ENVIRONMENT DIVISION.
000800 INPUT-OUTPUT SECTION.
000900 FILE-CONTROL.
001000     SELECT SEQFILE     ASSIGN SEQFILE.
001100
001200 DATA DIVISION.
001300 FILE SECTION.
001400 FD  SEQFILE
001500     RECORDING MODE IS F
001600     RECORD CONTAINS 80 CHARACTERS.
001700
001800 01  SEQFILE-RECORD.
001900     10 SR-TEMPID               PIC 9(04).
002000     10 SR-NAME-X               PIC X(09).
002100     10 SR-ADDRESS-X            PIC X(17).
002200     10 SR-EDLEVEL              PIC 9(04).
002300     10 SR-COMMENTS             PIC X(29).
002400     10 FILLER                  PIC X(03).
002500
002600 WORKING-STORAGE SECTION.
002700
002800 01  DISPLAY-SQLCODE    PIC Z(8)9-.
002900
003000 01  SWITCHES.
003100      05  SEQFILE-AT-END            PIC X VALUE 'N'.
003200
003300 01  ERR-MESS-DATA.
003400     05  ERR-MESS-LEN      PIC S9(4)   BINARY VALUE +960.
003500     05  ERR-MESS-TEXT     PIC X(120) OCCURS 8 TIMES
003600         INDEXED BY ERR-INDEX.
003700
003800 01  ERR-TEXT-LEN          PIC S9(9) BINARY VALUE +120.
003900*
004000     EXEC SQL
004100            INCLUDE SQLCA
004200     END-EXEC.
004300
004400     EXEC SQL
004500            INCLUDE APPLICAN
004600     END-EXEC.
004700
004800 PROCEDURE DIVISION.
004900
005000     PERFORM INIT
005100*    TO DELETE ALL ROWS, REMOVE COMMENT INDICATOR ON NEXT
005200*    TO SKIP DELETING ALL ROWS, ADD COMMENT INDICATOR ON NEXT
005300     PERFORM DELETE-ALL-ROWS
005400     PERFORM LOAD-TABLE-FROM-SEQFILE
005500     PERFORM TERM
005600*    DO A ROLLBACK IF YOU WANT
005700*    EXEC SQL
005800*        ROLLBACK
005900*    END-EXEC
006000*    DISPLAY 'ROLLBACK DONE AT NORMAL GOBACK, TESTING MODE'
006100     GOBACK.
006200
006300 INIT.
006400     DISPLAY 'STARTING  PROGRAM DB2LOD1'.
006500
006600 TERM.
006700
006800 DELETE-ALL-ROWS.
006900     EXEC SQL
007000       DELETE FROM APPLICANT
007100     END-EXEC
007200
007300     EVALUATE TRUE
007400        WHEN SQLCODE = 0
007500             DISPLAY 'SUCCESSFUL DELETE'
007600*            CONTINUE
007700        WHEN SQLCODE = +100
007800             DISPLAY 'NOT FOUND    '
007900        WHEN SQLCODE = -311
008000             DISPLAY 'LENGTH OF VARIABLE WRONG'
008100        WHEN SQLCODE = -530
008200             DISPLAY 'CANNOT DELETE'
008300             DISPLAY 'RI - 530'
008400        WHEN SQLCODE = -532
008500             DISPLAY 'CANNOT DELETE'
008600             DISPLAY 'RI - 532'
008700        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
008800             PERFORM WARNING-PARAGRAPH
008900        WHEN SQLCODE < 0 GO TO ERROR-EXIT
009000     END-EVALUATE.
009100
009200 LOAD-TABLE-FROM-SEQFILE.
009300     OPEN INPUT SEQFILE
009400     READ SEQFILE
009500        AT END MOVE 'Y' TO SEQFILE-AT-END
009600     END-READ
009700     PERFORM UNTIL SEQFILE-AT-END = 'Y'
009800        PERFORM INSERT-ROW-FROM-SEQFILE
009900        READ SEQFILE
010000           AT END MOVE 'Y' TO SEQFILE-AT-END
010100        END-READ
010200     END-PERFORM
010300     CLOSE SEQFILE.
010400
010500 INSERT-ROW-FROM-SEQFILE.
010600     DISPLAY 'INSERTING ROW' SEQFILE-RECORD
010700     MOVE SR-TEMPID             TO TEMPID
010800     MOVE 9                     TO NAME-LEN
010900     MOVE SR-NAME-X             TO NAME-TEXT
011000     MOVE 17                    TO ADDRESS-LEN
011100     MOVE SR-ADDRESS-X          TO ADDRESS-TEXT
011200     MOVE SR-EDLEVEL            TO EDLEVEL
011300     MOVE 29                    TO COMMENTS-LEN
011400     MOVE SR-COMMENTS           TO COMMENTS-TEXT
011500
011600     EXEC SQL
011700        INSERT INTO APPLICANT
011800        (TEMPID, NAME, ADDRESS, EDLEVEL, COMMENTS)
011900        VALUES (
012000                :TEMPID,
012100                :NAME-X,
012200                :ADDRESS-X,
012300                :EDLEVEL,
012400                :COMMENTS
012500               )
012600     END-EXEC.
012700
012800     EVALUATE TRUE
012900        WHEN SQLCODE = 0
013000             DISPLAY 'SUCCESSFUL INSERT'
013100*            CONTINUE
013200        WHEN SQLCODE = +100
013300             DISPLAY 'CURSOR AT END'
013400        WHEN SQLCODE = -311
013500             DISPLAY 'DATA LENGTH WRONG FOR COLUMN'
013600             DISPLAY 'RI - 311'
013700        WHEN SQLCODE = -530
013800             DISPLAY 'CANNOT INSERT'
013900             DISPLAY 'RI - 530'
014000        WHEN SQLCODE = -532
014100             DISPLAY 'CANNOT INSERT'
014200             DISPLAY 'RI - 532'
014300        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
014400             PERFORM WARNING-PARAGRAPH
014500        WHEN SQLCODE < 0 GO TO ERROR-EXIT
014600     END-EVALUATE.
014700
014800 ERROR-EXIT.
014900****
015000**UPDATES, MAINFRAME INFO AT:
015100**HTTP://theamericanprogrammer.com/db2-sql/index.html
015200     MOVE SQLCODE TO DISPLAY-SQLCODE.
015300     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
017800
017900     CALL 'DSNTIAR' USING SQLCA ERR-MESS-DATA ERR-TEXT-LEN
018000
018100     PERFORM ERROR-EXIT-PRINT-ERROR
018200           VARYING ERR-INDEX FROM 1 BY 1 UNTIL ERR-INDEX > 8
018300
018400*    IN REAL LIFE YOU WOULD CALL AN ABORT ROUTINE
018500     EXEC SQL
018600         ROLLBACK
018700     END-EXEC
018800
018900     DISPLAY 'ROLLBACK DONE'
019000
019100     GOBACK.
019200
019300 ERROR-EXIT-PRINT-ERROR.
019400     IF ERR-MESS-TEXT(ERR-INDEX) NOT = SPACES
019500     THEN DISPLAY  ERR-MESS-TEXT(ERR-INDEX).
019600
019700 WARNING-PARAGRAPH.
019800     IF SQLWARN1 = 'W'
019900        THEN DISPLAY 'CHARACTER DATA TRUNCATED'
020000             'SQLWARN1 = W'
020100     END-IF
020200
020300     IF SQLWARN2 = 'W'
020400        THEN DISPLAY 'A FUNCTION HANDLED A NULL BY IGNORING IT'
020500             'SQLWARN2 = W'
020600     END-IF
020700
020800     IF SQLWARN3 = 'W'
020900        THEN DISPLAY 'THE NUMBER OF HOST VARIABLES IS LESS  '
021000             'THAN THE NUMBER OF COLUMNS SELECTED  '
021100             'SQLWARN3 = W'
021200     END-IF
021300
021400     IF SQLWARN4 = 'W'
021500        THEN DISPLAY 'A DYNAMIC SQL UPDATE/DELETE DOES NOT  '
021600             'CONTAIN A WHERE CLAUSE  '
021700             'SQLWARN4 = W'
021800     END-IF
021900
022000     IF SQLWARN5 = 'W'
022100        THEN DISPLAY 'DYNAMIC SQL DOES NOT CONTAIN VALID SQL'
022200             'SQLWARN5 = W'
022300     END-IF
022400
022500     IF SQLWARN6 = 'W'
022600        THEN DISPLAY 'DATE/TIMESTAMP ARITHMETIC '
022700             'PRODUCES AN INVALID DATE EX: NOV 31'
022800             'IT IS CHANGED TO LAST DAY OF MONTH EX: NOV 30'
022900             'SQLWARN6 = W'
023000     END-IF
023100
023200     IF SQLWARN7 = 'W'
023300        THEN DISPLAY 'CHARACTER DATA TRUNCATED '
023400             'POSSIBLE LOW ORDER TRUNCATION      '
023500             'SQLWARN7 = W'
023600     END-IF
023700
023800     IF SQLWARN8 = 'W'
023900        THEN DISPLAY 'A CHARACTER COULD NOT BE CONVERTED '
024000             'SQLWARN8 = W'
024100     END-IF
024200
024300     IF SQLWARN9 = 'W'
024400        THEN DISPLAY 'ARITHMETIC DATA ERRORS FOUND'
024500             'WHILE DOING A COUNT(DISTINCT)      '
024600             'SQLWARN9 = W'
024700     END-IF
024800
024900     IF SQLWARNA = 'W'
025000        THEN DISPLAY 'CHARACTER CONVERSION ERROR'
025100             'IN SQLCA OR SQLDA. THE CODE WILL BE INVALID'
025200             'SQLWARNA = W'
025300     END-IF.



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 |