[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   > Handling a variable format column, in Embedded SQL

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

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'VARO'.
000300* SAMPLE PROGRAM FOR DB2 EMBEDDED SQL
000400* DOES A SINGLETON SELECT FROM DEPT
000410* SHOWS USE OF VARIABLE LENGTH FIELD

      * This is what the output looks like:
           SPIFFY COMPUTER SERVICE DIV.
      *
      *    PLANNINGOMPUTER SERVICE DIV.
      *    SUCCESSFUL SELECT
      *    ENDING PROGRAM

000500 ENVIRONMENT DIVISION.
000600 INPUT-OUTPUT SECTION.
000700 FILE-CONTROL.
000800 DATA DIVISION.
000900 FILE SECTION.
001000 WORKING-STORAGE SECTION.
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(8)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 VARO   '.
003900
004100     MOVE SPACES TO DEPTNAME-TEXT
004300     MOVE 0      TO DEPTNAME-LEN
004500
004600     EXEC SQL
004700         SELECT DEPTNO,    DEPTNAME
004800          INTO :DEPTNO,   :DEPTNAME
004900          FROM DEPT
005000          WHERE DEPTNO = 'A00'
005100     END-EXEC.
005200
005201     IF DEPTNAME-LEN > 0
005202        DISPLAY DEPTNAME-TEXT
005203        ELSE DISPLAY 'LENGTH OF DEPTNAME WAS ZERO'.
005204
005230*    THE SECOND SELECT FORGETS TO MOVE SPACES
005231*    THE DATA SELECTED IS LONGER THIS TIME.
005232*    WATCH WHAT HAPPENS.
005233*    MOVE SPACES TO DEPTNAME-TEXT
005234     MOVE 0      TO DEPTNAME-LEN
005235
005240     EXEC SQL
005250         SELECT DEPTNO,    DEPTNAME
005260          INTO :DEPTNO,   :DEPTNAME
005270          FROM DEPT
005280          WHERE DEPTNO = 'B01'
005290     END-EXEC.
005291
005292     IF DEPTNAME-LEN > 0
005293        DISPLAY DEPTNAME-TEXT
005294        ELSE DISPLAY 'LENGTH OF DEPTNAME WAS ZERO'.
005295
005296
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).
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 |