[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. 'DB2SING2'.
000300* SAMPLE PROGRAM FOR DB2 EMBEDDED SQL
000400* DOES A SINGLETON SELECT FROM ORG
000410* SHOWS HOW TO HANDLE NULLS AND VARIABLE
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
001110 01  INPUT-DEPTNUMB        PIC S9(4) USAGE COMP VALUE +0.
001120 01  NULL-DEPTNAME         PIC S9(4) BINARY VALUE ZERO.
001130
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
002000     EXEC SQL
002100            INCLUDE SQLCA
002200     END-EXEC.
002300
002400     EXEC SQL
002500            INCLUDE ORG
002600     END-EXEC.
002700
002800 PROCEDURE DIVISION.
002900* NOTE THAT WHENEVER IS ONLY AN EXAMPLE. IT IS NOT RECOMMENDED.
003000*    EXEC SQL
003100*      WHENEVER SQLERROR GOTO ERROR-EXIT
003200*    END-EXEC
003300     DISPLAY 'STARTING  PROGRAM DB2SING2'.
003400*    SAMPLE SQL STATEMENT IS NEXT
003500*    NOTE, THIS WILL WORK WITH THE DATA SUPPLIED
003600*    HOWEVER IN REAL LIFE, BE SURE THAT THE SELECT CAN RETRIEVE
003700*    AT MOST ONE ROW
003800
003810
003820     DISPLAY SPACE
003821     DISPLAY 'DOING FIRST SELECT'
003830     DISPLAY 'IGNORING NULL AND VARIABLE LENGTH FIELD'
003900*    JUST GET ONE ROW, PAYING NO ATTENTION TO NULLS OR VARIABLE
004000     MOVE SPACES TO
004100         DEPTNAME
004200     MOVE ZEROS TO
004300         DEPTNUMB, MANAGER
004400*    MOVE 51 TO INPUT-DEPTNUMB.
004500     EXEC SQL
004600         SELECT DEPTNUMB,      DEPTNAME,  MANAGER
004700          INTO :DEPTNUMB,     :DEPTNAME, :MANAGER
004800          FROM ORG
004900          WHERE DEPTNUMB = 51
004910*         WHERE DEPTNUMB = :INPUT-DEPTNUMB
005000     END-EXEC
005100
005200     EVALUATE TRUE
005300        WHEN SQLCODE = 0
005310*            CONTINUE
005400             DISPLAY 'SUCCESSFUL SELECT'
005500             DISPLAY
005600                DEPTNUMB, DEPTNAME,      MANAGER
005700        WHEN SQLCODE = +100
005800             DISPLAY 'NOTFOUND'
005900             DISPLAY DEPTNUMB
006000        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
006100             PERFORM WARNING-PARAGRAPH
006200        WHEN SQLCODE < 0 GO TO ERROR-EXIT
006300     END-EVALUATE.
006400
006410
006411     DISPLAY SPACE
006420     DISPLAY 'DOING SECOND SELECT'
006421     DISPLAY 'HANDLING NULL, IGNORING VARIABLE LENGTH FIELD'
006430*    JUST GET ONE ROW, PAYING NO ATTENTION TO VARIABLE
006431*    BUT HANDLING NULLS WITH NULL-INDICATOR
006440     MOVE SPACES TO
006450         DEPTNAME
006460     MOVE ZEROS TO
006470         DEPTNUMB, MANAGER
006471     MOVE ZEROS TO NULL-DEPTNAME
006480*    MOVE 51 TO INPUT-DEPTNUMB.
006490     EXEC SQL
006491         SELECT DEPTNUMB,      DEPTNAME,                MANAGER
006492          INTO :DEPTNUMB,     :DEPTNAME:NULL-DEPTNAME, :MANAGER
006493          FROM ORG
006494          WHERE DEPTNUMB = 51
006495*         WHERE DEPTNUMB = :INPUT-DEPTNUMB
006496     END-EXEC
006497
006498     IF NULL-DEPTNAME = 0 THEN DISPLAY 'NO NULL'.
006499     IF NULL-DEPTNAME < 0 THEN DISPLAY 'WAS NULL'.
006501
006502     MOVE SQLCODE TO DISPLAY-SQLCODE.
006503     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE
006504     EVALUATE TRUE
006505        WHEN SQLCODE = 0
006506*            CONTINUE
006507             DISPLAY 'SUCCESSFUL SELECT'
006508             DISPLAY
006509                DEPTNUMB, DEPTNAME,      MANAGER
006510        WHEN SQLCODE = +100
006511             DISPLAY 'NOTFOUND'
006512             DISPLAY DEPTNUMB
006513        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
006514             PERFORM WARNING-PARAGRAPH
006515        WHEN SQLCODE < 0 GO TO ERROR-EXIT
006516     END-EVALUATE.
006517
006518
006519
006520     DISPLAY SPACE
006521     DISPLAY 'DOING THIRD  SELECT'
006522     DISPLAY 'HANDLING VARIABLE LENGTH FIELD, IGNORING NULL'
006523*    JUST GET ONE ROW, PAYING NO ATTENTION TO NULLS
006524*    BUT HANDLING VARIABLE
006525     MOVE SPACES TO
006526         DEPTNAME-TEXT
006527     MOVE ZEROS TO
006528         DEPTNUMB, MANAGER
006529     MOVE ZEROS TO DEPTNAME-LEN
006530*    MOVE 51 TO INPUT-DEPTNUMB.
006531     EXEC SQL
006532         SELECT DEPTNUMB,      DEPTNAME,                MANAGER
006533          INTO :DEPTNUMB,     :DEPTNAME,               :MANAGER
006534          FROM ORG
006535          WHERE DEPTNUMB = 51
006536*         WHERE DEPTNUMB = :INPUT-DEPTNUMB
006537     END-EXEC
006538
006539     MOVE SQLCODE TO DISPLAY-SQLCODE.
006540     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE
006541     IF DEPTNAME-LEN = 0 THEN DISPLAY 'DEPTNAME WAS ZERO CHAR'.
006542
006543     MOVE SQLCODE TO DISPLAY-SQLCODE.
006544     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE
006545     EVALUATE TRUE
006546        WHEN SQLCODE = 0
006547*            CONTINUE
006548             DISPLAY 'SUCCESSFUL SELECT'
006549             DISPLAY
006550                DEPTNUMB, DEPTNAME-TEXT, MANAGER
006551        WHEN SQLCODE = +100
006552             DISPLAY 'NOTFOUND'
006553             DISPLAY DEPTNUMB
006554        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
006555             DISPLAY 'WARNINGS ISSUED'
006556             PERFORM WARNING-PARAGRAPH
006557        WHEN SQLCODE < 0 GO TO ERROR-EXIT
006558     END-EVALUATE.
006559
006560
006561
006562     DISPLAY SPACE
006563     DISPLAY 'DOING FOURTH SELECT'
006564     DISPLAY 'HANDLING VARIABLE LENGTH FIELD AND NULL'
006565*    JUST GET ONE ROW, HANDLING VARIABLE
006566*    AND HANDLING NULLS WITH NULL-INDICATOR
006567     MOVE SPACES TO
006568         DEPTNAME-TEXT
006569     MOVE ZEROS TO
006570         DEPTNUMB, MANAGER
006571     MOVE ZEROS TO DEPTNAME-LEN
006572     MOVE ZEROS TO NULL-DEPTNAME
006573*    MOVE 51 TO INPUT-DEPTNUMB.
006574     EXEC SQL
006575         SELECT DEPTNUMB,      DEPTNAME,                MANAGER
006576          INTO :DEPTNUMB,     :DEPTNAME:NULL-DEPTNAME, :MANAGER
006577          FROM ORG
006578          WHERE DEPTNUMB = 51
006579*         WHERE DEPTNUMB = :INPUT-DEPTNUMB
006580     END-EXEC
006581
006582     IF DEPTNAME-LEN = 0 THEN DISPLAY 'DEPTNAME WAS ZERO CHAR'.
006583     IF NULL-DEPTNAME = 0 THEN DISPLAY 'NO NULL'.
006584     IF NULL-DEPTNAME < 0 THEN DISPLAY 'WAS NULL'.
006585
006586
006587     MOVE SQLCODE TO DISPLAY-SQLCODE.
006588     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE
006589     EVALUATE TRUE
006590        WHEN SQLCODE = 0
006591*            CONTINUE
006592             DISPLAY 'SUCCESSFUL SELECT'
006593             DISPLAY
006594                DEPTNUMB, DEPTNAME-TEXT, MANAGER
006595        WHEN SQLCODE = +100
006596             DISPLAY 'NOTFOUND'
006597             DISPLAY DEPTNUMB
006598        WHEN SQLCODE > 0 OR SQLWARN0 = 'W'
006599             PERFORM WARNING-PARAGRAPH
006600        WHEN SQLCODE < 0 GO TO ERROR-EXIT
006601     END-EVALUATE.
006602
006603
006604
006605
006606     DISPLAY 'ENDING PROGRAM'.
006610
006700     GOBACK.
006800
006900 ERROR-EXIT.
007000
007100     MOVE SQLCODE TO DISPLAY-SQLCODE.
007200     DISPLAY 'SQLCODE FOLLOWS' DISPLAY-SQLCODE
007300     EVALUATE TRUE
007400       WHEN SQLCODE = 0
007500*           DISPLAY 'SUCCESSFUL EXECUTION'
007600            CONTINUE
007700       WHEN SQLCODE = +100
007800*           DISPLAY 'NOT FOUND'
007900            CONTINUE
008000       WHEN SQLCODE = -180
008100            DISPLAY 'BAD DATA IN DATE/TIME/TIMESTAMP'
008200       WHEN SQLCODE = -181
008300            DISPLAY 'BAD DATA IN DATE/TIME/TIMESTAMP'
008400       WHEN SQLCODE = -305
008500            DISPLAY 'NO NULL INDICATOR'
008600       WHEN SQLCODE = -311
008700            DISPLAY 'LENGTH OF VARIABLE WRONG'
008800       WHEN SQLCODE = -501
008900            DISPLAY 'CURSOR NOT OPEN ON FETCH'
009000       WHEN SQLCODE = -530
009100            DISPLAY 'RI INS/UPD'
009200       WHEN SQLCODE = -532
009300            DISPLAY 'RI DELETE'
009400       WHEN SQLCODE = -803
009500            DISPLAY 'DUP ROW '
009600       WHEN SQLCODE = -805
009700            DISPLAY 'DBRM NOT FOUND IN PLAN'
009800       WHEN SQLCODE = -811
009900            DISPLAY 'MORE THAN 1 ROW ON SELECT INTO '
010000       WHEN SQLCODE = -818
010100            DISPLAY 'TIMESTAMP MISMATCH, LOAD MOD/PLAN'
010200       WHEN SQLCODE = -904
010300            DISPLAY 'UNAVAIL RESOURCE'
010400       WHEN SQLCODE = -911
010500            DISPLAY 'DEADLOCK/TIMEOUT, ROLLBACK DONE'
010600       WHEN SQLCODE = -913
010700            DISPLAY 'DEADLOCK/TIMEOUT VICTIM, NO ROLLBACK'
010800       WHEN OTHER
010900            DISPLAY 'SEVERE SQL ERROR'
011000       END-EVALUATE
011100
011200     CALL 'DSNTIAR' USING SQLCA ERR-MESS-DATA ERR-TEXT-LEN
011300
011400     PERFORM ERROR-EXIT-PRINT-ERROR
011500           VARYING ERR-INDEX FROM 1 BY 1 UNTIL ERR-INDEX > 8
011600
011700*    IN REAL LIFE YOU WOULD CALL AN ABORT ROUTINE
011800     EXEC SQL
011900         ROLLBACK
012000     END-EXEC
012100     GOBACK.
012200
012300 ERROR-EXIT-PRINT-ERROR.
012400     IF ERR-MESS-TEXT(ERR-INDEX) NOT = SPACES
012500     THEN DISPLAY  ERR-MESS-TEXT(ERR-INDEX).
012600
012700 WARNING-PARAGRAPH.
012800     IF SQLWARN1 = 'W'
012900        THEN DISPLAY 'CHARACTER DATA TRUNCATED'
013000             'SQLWARN1 = W'
013100     END-IF
013200
013300     IF SQLWARN2 = 'W'
013400        THEN DISPLAY 'A FUNCTION HANDLED A NULL BY IGNORING IT'
013500             'SQLWARN2 = W'
013600     END-IF
013700
013800     IF SQLWARN3 = 'W'
013900        THEN DISPLAY 'THE NUMBER OF HOST VARIABLES IS LESS  '
014000             'THAN THE NUMBER OF COLUMNS SELECTED  '
014100             'SQLWARN3 = W'
014200     END-IF
014300
014400     IF SQLWARN4 = 'W'
014500        THEN DISPLAY 'A DYNAMIC SQL UPDATE/DELETE DOES NOT  '
014600             'CONTAIN A WHERE CLAUSE  '
014700             'SQLWARN4 = W'
014800     END-IF
014900
015000     IF SQLWARN5 = 'W'
015100        THEN DISPLAY 'DYNAMIC SQL DOES NOT CONTAIN VALID SQL'
015200             'SQLWARN5 = W'
015300     END-IF
015400
015500     IF SQLWARN6 = 'W'
015600        THEN DISPLAY 'DATE/TIMESTAMP ARITHMETIC '
015700             'PRODUCES AN INVALID DATE EX: NOV 31'
015800             'IT IS CHANGED TO LAST DAY OF MONTH EX: NOV 30'
015900             'SQLWARN6 = W'
016000     END-IF
016100
016200     IF SQLWARN7 = 'W'
016300        THEN DISPLAY 'CHARACTER DATA TRUNCATED '
016400             'POSSIBLE LOW ORDER TRUNCATION      '
016500             'SQLWARN7 = W'
016600     END-IF
016700
016800     IF SQLWARN8 = 'W'
016900        THEN DISPLAY 'A CHARACTER COULD NOT BE CONVERTED '
017000             'SQLWARN8 = W'
017100     END-IF
017200
017300     IF SQLWARN9 = 'W'
017400        THEN DISPLAY 'ARITHMETIC DATA ERRORS FOUND'
017500             'WHILE DOING A COUNT(DISTINCT)      '
017600             'SQLWARN9 = W'
017700     END-IF
017800
017900     IF SQLWARNA = 'W'
018000        THEN DISPLAY 'CHARACTER CONVERSION ERROR'
018100             'IN SQLCA OR SQLDA. THE CODE WILL BE INVALID'
018200             'SQLWARNA = W'
018300     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 |