[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   > The Singleton Select in Embedded SQL

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

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'NULLO'.
000300* SAMPLE PROGRAM FOR DB2 EMBEDDED SQL
000400* DOES A SINGLETON SELECT FROM DEPT
000410* SHOWS NULL INDICATOR
000500 ENVIRONMENT DIVISION.
000600 INPUT-OUTPUT SECTION.
000700 FILE-CONTROL.
000800 DATA DIVISION.
000900 FILE SECTION.
001000 WORKING-STORAGE SECTION.
001010 01  NULL-MGRNO         PIC S9(4) BINARY VALUE ZERO.
001020
001100*  REGULAR WORKING STORAGE THINGS GO HERE AS ALWAYS
001200 01  ERR-MESS-DATA.
001300     05  ERR-MESS-LEN      PIC S9(4)   BINARY VALUE +960.
001400     05  ERR-MESS-TEXT     PIC X(120) OCCURS 8 TIMES
001500         INDEXED BY ERR-INDEX.
001600 01  ERR-TEXT-LEN          PIC S9(9) BINARY VALUE +120.
001700
001800 01  DISPLAY-SQLCODE       PIC Z(9)-.
001900
002100     EXEC SQL
002200            INCLUDE SQLCA
002300     END-EXEC.
002400
002500     EXEC SQL
002600            INCLUDE DEPT
002700     END-EXEC.
002820
002900 PROCEDURE DIVISION.
003000* NOTE THAT WHENEVER IS ONLY AN EXAMPLE. IT IS NOT RECOMMENDED.
003100*    EXEC SQL
003200*      WHENEVER SQLERROR GOTO ERROR-EXIT
003300*    END-EXEC
003400     DISPLAY 'STARTING  PROGRAM NULLO   '.
003500*    SAMPLE SQL STATEMENT IS NEXT
003600*    NOTE, THIS WILL WORK WITH THE DATA SUPPLIED
003700*    HOWEVER IN REAL LIFE, BE SURE THAT THE SELECT CAN RETRIEVE
003800*    AT MOST ONE ROW
003900
004100     MOVE SPACES TO  MGRNO
004300     MOVE ZEROS  TO  NULL-MGRNO
004500
004600     EXEC SQL
004700         SELECT DEPTNO,    DEPTNAME,  MGRNO
004710*        SELECT DEPTNO,    DEPTNAME,  COALESCE(MGRNO,'   ')
004800          INTO :DEPTNO,   :DEPTNAME, :MGRNO:NULL-MGRNO
004810*         INTO :DEPTNO,   :DEPTNAME, :MGRNO
004900          FROM DEPT
005000          WHERE DEPTNO = 'D01'
005100     END-EXEC.
005200
005210     IF NULL-MGRNO = 0 THEN DISPLAY 'NO NULL'.
005220     IF NULL-MGRNO < 0 THEN DISPLAY 'WAS NULL'.
005230
005300     EVALUATE TRUE
005400        WHEN SQLCODE = 0
005500*            DISPLAY 'SUCCESSFUL SELECT'
005600             DISPLAY
005700                DEPTNO, DEPTNAME, MGRNO
005800        WHEN SQLCODE = +100
005900             DISPLAY 'NOTFOUND'
006000             DISPLAY DEPTNO
006100        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
006200             PERFORM WARNING-PARAGRAPH
006300        WHEN SQLCODE < 0 GO TO ERROR-EXIT
006400     END-EVALUATE.
006500
006600     DISPLAY 'ENDING PROGRAM'.
006700
006800     GOBACK.
006900
007000 ERROR-EXIT.
007400     MOVE SQLCODE TO DISPLAY-SQLCODE.
007500     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
010000
010100     CALL 'DSNTIAR' USING SQLCA ERR-MESS-DATA ERR-TEXT-LEN
010200
010300     PERFORM ERROR-EXIT-PRINT-ERROR
010400           VARYING ERR-INDEX FROM 1 BY 1 UNTIL ERR-INDEX > 8
010500
010600*    IN REAL LIFE YOU WOULD CALL AN ABORT ROUTINE
010700     EXEC SQL
010800         ROLLBACK
010900     END-EXEC
011000
011100     DISPLAY 'ROLLBACK DONE'
011200
011300     GOBACK.
011400
011500 ERROR-EXIT-PRINT-ERROR.
011600     IF ERR-MESS-TEXT(ERR-INDEX) NOT = SPACES
011700     THEN DISPLAY  ERR-MESS-TEXT(ERR-INDEX).
011800
011900 WARNING-PARAGRAPH.
012000     IF SQLWARN1 = 'W'
012100        THEN DISPLAY 'CHARACTER DATA TRUNCATED'
012200             'SQLWARN1 = W'
012300     END-IF
012400
012500     IF SQLWARN2 = 'W'
012600        THEN DISPLAY 'A FUNCTION HANDLED A NULL BY IGNORING IT'
012700             'SQLWARN2 = W'
012800     END-IF
012900
013000     IF SQLWARN3 = 'W'
013100        THEN DISPLAY 'THE NUMBER OF HOST VARIABLES IS LESS  '
013200             'THAN THE NUMBER OF COLUMNS SELECTED  '
013300             'SQLWARN3 = W'
013400     END-IF
013500
013600     IF SQLWARN4 = 'W'
013700        THEN DISPLAY 'A DYNAMIC SQL UPDATE/DELETE DOES NOT  '
013800             'CONTAIN A WHERE CLAUSE  '
013900             'SQLWARN4 = W'
014000     END-IF
014100
014200     IF SQLWARN5 = 'W'
014300        THEN DISPLAY 'DYNAMIC SQL DOES NOT CONTAIN VALID SQL'
014400             'SQLWARN5 = W'
014500     END-IF
014600
014700     IF SQLWARN6 = 'W'
014800        THEN DISPLAY 'DATE/TIMESTAMP ARITHMETIC '
014900             'PRODUCES AN INVALID DATE EX: NOV 31'
015000             'IT IS CHANGED TO LAST DAY OF MONTH EX: NOV 30'
015100             'SQLWARN6 = W'
015200     END-IF
015300
015400     IF SQLWARN7 = 'W'
015500        THEN DISPLAY 'CHARACTER DATA TRUNCATED '
015600             'POSSIBLE LOW ORDER TRUNCATION      '
015700             'SQLWARN7 = W'
015800     END-IF
015900
016000     IF SQLWARN8 = 'W'
016100        THEN DISPLAY 'A CHARACTER COULD NOT BE CONVERTED '
016200             'SQLWARN8 = W'
016300     END-IF
016400
016500     IF SQLWARN9 = 'W'
016600        THEN DISPLAY 'ARITHMETIC DATA ERRORS FOUND'
016700             'WHILE DOING A COUNT(DISTINCT)      '
016800             'SQLWARN9 = W'
016900     END-IF
017000
017100     IF SQLWARNA = 'W'
017200        THEN DISPLAY 'CHARACTER CONVERSION ERROR'
017300             'IN SQLCA OR SQLDA. THE CODE WILL BE INVALID'
017400             'SQLWARNA = W'
017500     END-IF.
005400**HTTP://theamericanprogrammer.com/db2-sql/index.html



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 |