[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 with cursor in Embedded SQL

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

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