[USflag] The American Programmer [USflag]
Home Programming Books for Computer Professionals Privacy Terms
           Home   > Programming   > The Singleton Select in Embedded SQL
           Home   > Programming   > The Singleton Select in Embedded SQL 
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 JCL and other mainframe topics

[Books Computer]

|  Home |  Programming |  Books for Computer Professionals |  Privacy |  Terms |  Contact |
|  Site Map and Site Search |  Programming Manuals and Tutorials |  The REXX Files | Top of Page |

[link page]