[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   > Read randomly, with Select in Embedded SQL

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

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'DB2RND1'.
000300*  SAMPLE COBOL PROGRAM
000400* READ DB2 APPLICANT TABLE RANDOMLY,
000500* BASED ON A REGULAR FILE READ SEQUENTIALLY(TEMPID)
000600* JUST DISPLAY THE DB2 ROWS
000700* NOTHING COMPLEX IN THIS PROGRAM
000800* THE LOGIC IS SAME AS REGULAR FILE READ SEQUENTIALLY
000900 ENVIRONMENT DIVISION.
001000 CONFIGURATION SECTION.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300*    THIS IS AN ORDINARY SEQUENTIAL FILE:
001400     SELECT IN-FILE  ASSIGN TEMPID.
001500 DATA DIVISION.
001600 FILE SECTION.
001700 FD  IN-FILE
001800     RECORDING MODE IS F
001900     RECORD CONTAINS 80 CHARACTERS.
002000
002100 01  IN-RECORD.
002200     05  INPUT-TEMPID         PIC 9(4).
002300     05  FILLER               PIC X(76).
002400
002500 WORKING-STORAGE SECTION.
002600 01  DISPLAY-SQLCODE       PIC Z(8)9-.
002700
002800 01  SWITCHES.
002900     05  FILE-AT-END     PIC X  VALUE 'N'.
003000
003100 01  ERR-MESS-DATA.
003200     05  ERR-MESS-LEN      PIC S9(4)   BINARY VALUE +960.
003300     05  ERR-MESS-TEXT     PIC X(120) OCCURS 8 TIMES
003400         INDEXED BY ERR-INDEX.
003500 01  ERR-TEXT-LEN          PIC S9(9) BINARY VALUE +120.
003600
004000     EXEC SQL
004100            INCLUDE SQLCA
004200     END-EXEC.
004300
004400     EXEC SQL
004500            INCLUDE APPLICAN
004600     END-EXEC.
004700
004800 PROCEDURE DIVISION.
004900     DISPLAY 'STARTING  PROGRAM DB2RND1'.
005000
005100     PERFORM INITIALIZATION
005200     PERFORM PROCESS-ALL
005300         UNTIL FILE-AT-END = 'Y'
005400     PERFORM TERMINATION
005500     GOBACK.
005600
005700 INITIALIZATION.
005800     OPEN INPUT IN-FILE
005900     PERFORM READ-PAR.
006000
006100 PROCESS-ALL.
006300      MOVE INPUT-TEMPID TO TEMPID
006200     PERFORM SINGLETON-SELECT
006400     PERFORM READ-PAR.
006500
006600 TERMINATION.
006700     CLOSE IN-FILE.
006800
006900 READ-PAR.
007000     READ IN-FILE
007100         AT END MOVE 'Y' TO FILE-AT-END
007200     END-READ.
007300
007400 SINGLETON-SELECT.
007500     MOVE SPACES TO NAME-X, ADDRESS-X, COMMENTS
007600     MOVE ZEROS TO EDLEVEL
007700*    NOTE: THIS WILL WORK ONLY WHEN JUST ONE ROW IS RETRIEVED.
007800      EXEC SQL
007900        SELECT TEMPID, NAME, ADDRESS, EDLEVEL, COMMENTS
008000        INTO  :TEMPID, :NAME-X, :ADDRESS-X, :EDLEVEL, :COMMENTS
008100        FROM APPLICANT
008200          WHERE TEMPID = :TEMPID
008300     END-EXEC
008400
008500     EVALUATE TRUE
008600        WHEN SQLCODE = 0
008700*            DISPLAY 'SUCCESSFUL SELECT'
008800             DISPLAY
008900                TEMPID, NAME-X, ADDRESS-X, EDLEVEL, COMMENTS
009000        WHEN SQLCODE = +100
009100             DISPLAY 'NOTFOUND'
009200             DISPLAY INPUT-TEMPID
009300        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
009400             PERFORM WARNING-PARAGRAPH
009500        WHEN SQLCODE < 0 GO TO ERROR-EXIT
009600     END-EVALUATE.
009700
009800 ERROR-EXIT.
009900****
010000**UPDATES, MAINFRAME INFO AT:
010100**HTTP://theamericanprogrammer.com/db2-sql/index.html
010200     MOVE SQLCODE TO DISPLAY-SQLCODE.
010300     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'
012700       END-EVALUATE
012800
012900     CALL 'DSNTIAR' USING SQLCA ERR-MESS-DATA ERR-TEXT-LEN
013000
013100     PERFORM ERROR-EXIT-PRINT-ERROR
013200           VARYING ERR-INDEX FROM 1 BY 1 UNTIL ERR-INDEX > 8
013300
013400*    IN REAL LIFE YOU WOULD CALL AN ABORT ROUTINE
013500     EXEC SQL
013600         ROLLBACK
013700     END-EXEC
013800
013900     DISPLAY 'ROLLBACK DONE'
014000
014100     GOBACK.
014200
014300 ERROR-EXIT-PRINT-ERROR.
014400     IF ERR-MESS-TEXT(ERR-INDEX) NOT = SPACES
014500     THEN DISPLAY  ERR-MESS-TEXT(ERR-INDEX).
014600
014700 WARNING-PARAGRAPH.
014800     IF SQLWARN1 = 'W'
014900        THEN DISPLAY 'CHARACTER DATA TRUNCATED'
015000             'SQLWARN1 = W'
015100     END-IF
015200
015300     IF SQLWARN2 = 'W'
015400        THEN DISPLAY 'A FUNCTION HANDLED A NULL BY IGNORING IT'
015500             'SQLWARN2 = W'
015600     END-IF
015700
015800     IF SQLWARN3 = 'W'
015900        THEN DISPLAY 'THE NUMBER OF HOST VARIABLES IS LESS  '
016000             'THAN THE NUMBER OF COLUMNS SELECTED  '
016100             'SQLWARN3 = W'
016200     END-IF
016300
016400     IF SQLWARN4 = 'W'
016500        THEN DISPLAY 'A DYNAMIC SQL UPDATE/DELETE DOES NOT  '
016600             'CONTAIN A WHERE CLAUSE  '
016700             'SQLWARN4 = W'
016800     END-IF
016900
017000     IF SQLWARN5 = 'W'
017100        THEN DISPLAY 'DYNAMIC SQL DOES NOT CONTAIN VALID SQL'
017200             'SQLWARN5 = W'
017300     END-IF
017400
017500     IF SQLWARN6 = 'W'
017600        THEN DISPLAY 'DATE/TIMESTAMP ARITHMETIC '
017700             'PRODUCES AN INVALID DATE EX: NOV 31'
017800             'IT IS CHANGED TO LAST DAY OF MONTH EX: NOV 30'
017900             'SQLWARN6 = W'
018000     END-IF
018100
018200     IF SQLWARN7 = 'W'
018300        THEN DISPLAY 'CHARACTER DATA TRUNCATED '
018400             'POSSIBLE LOW ORDER TRUNCATION      '
018500             'SQLWARN7 = W'
018600     END-IF
018700
018800     IF SQLWARN8 = 'W'
018900        THEN DISPLAY 'A CHARACTER COULD NOT BE CONVERTED '
019000             'SQLWARN8 = W'
019100     END-IF
019200
019300     IF SQLWARN9 = 'W'
019400        THEN DISPLAY 'ARITHMETIC DATA ERRORS FOUND'
019500             'WHILE DOING A COUNT(DISTINCT)      '
019600             'SQLWARN9 = W'
019700     END-IF
019800
019900     IF SQLWARNA = 'W'
020000        THEN DISPLAY 'CHARACTER CONVERSION ERROR'
020100             'IN SQLCA OR SQLDA. THE CODE WILL BE INVALID'
020200             'SQLWARNA = W'
020300     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 |