![[USflag]](http://www.theamericanprogrammer.com/pix/flag2.waving.gif) |
The American Programmer | |
| |
The American Programmer | |
| Home | Programming | Books for Computer Professionals | Privacy | Terms |
| Home > Programming > SQL Book > Embedded SQL |
This is about how to embed SQL in a COBOL program on a DB2/UDB system.
With my compliments.
Table of Contents
Section 1: Major Parts of the Program 2
Section 2: The Generated Declaration, popularly called DCLGEN 4
Section 3: Embedding SQL 9
Section 4: The SQLCA 10
Section 5 The SQLCODE 11
Section 6: Specific SQLCODE Conditions You Can Handle 13
Section 7: Some Severe SQLCODE Errors 14
Section 8: Referring to COBOL Variables (host variables) 15
Section 9: The Singleton Select 16
Section 10: Handling Nulls 17
Section 11: Whenever 18
Section 12: Host variable datatypes 19
Section 13: Handling Variable Length columns 20
Section 14: Examples Showing NULLS and Variable Length 21
Section 15: The Cursor. 25
Section 16: Considerations on Using a Cursor 27
Section 17: Deleting and Updating with a Cursor 29
Section 18: Creating a COBOL Library if You Don’t Already Have One 30
Section 19: Useful Things You Can Do with QMF 31
Section 20: Program DB2ACD1 33
Section 21: Program DB2CRSR1 40
Section 22: Program DB2LOD1 42
Section 23: Program DB2RND1 45
Section 24: Program DB2SINGL 47
Section 1: Major Parts of the Program
See the sample program DB2SINGL in Section 25
Identification division.
There are no differences up to working-storage section.
Working-storage section.
Contains Your regular code - 01's, counters, record descriptions, hold areas, etc.
Then the includes for SQLCA, your generated declarations (DCLGENS),
cursor declarations, if used.
EXEC SQL see note #1 in program DB2SINGL in Section 25
INCLUDE SQLCA
END-EXEC.
EXEC SQL
INCLUDE dclgen this will be the name of your generated declaration (DCLGEN)
END-EXEC. it is a member name in your COBOL library,
or your company’s COBOL COPY library.
It is the member you placed in the library when
you did a "DCLGEN" (see Section 2 later in course)
EXEC SQL cursor declaration. (see note #1 in program DB2CRSR1)
DECLARE cursor-name defines cursor for later use in procedure division
CURSOR FOR
SELECT rest of select statement
END-EXEC.
PROCEDURE DIVISION.
* An optional Whenever
EXEC SQL
see note #3 in program DB2SINGLWHENEVER SQLERROR GO TO ERROR-EXIT
END-EXEC.
Cobol code as needed
embedded sql as needed, for example:
EXEC SQL
sql statements go here, for example:
open cursor see note # 2 in program DB2CRSR1
select into see note # 4 in program DB2SINGL
insert
update
delete
fetch
close cursor
END-EXEC.
You must check SQLCODE after each SQL statement
Examples shown later and at note #5 in program DB2SINGL
Just before the GOBACK:
close files
close cursors
GOBACK
You may want to put an error exit in your program.
Error-exit. See note #1 in program DB2CRSR1
these are some of the things you can do can in an error-exit:
Move SQLCODE to a field suitable for displaying
(see DISPLAY-SQLCODE in the model programs)
display the display field
Optional: use the print error routine shown in sample programs to
display the text of the SQLCODE error message
If running in batch, do a rollback here
rollback reverses any changes made (since the beginning, or last commit)
and releases locks on the data
EXEC SQL
ROLLBACK
END-EXEC.
If running on-line, ask the transaction manager to do a rollback
EXEC CICS
CHECKPOINT ROLLBACK
END-EXEC.
Possibly do a user abort here
an abend, system or user, implies a rollback
Just for reference:
commit makes any changes permanent and releases locks on the data
EXEC SQL
COMMIT
END-EXEC.
note that a GOBACK implies a commit
GOBACK closes any open cursors. (Suggested that you close them yourself)
If running on-line, ask the transaction manager to do the commit
EXEC CICS
CHECKPOINT
END-EXEC.
Section 2: The Generated Declaration, Popularly Called DCLGEN
DCLGEN is SQL and COBOL code generated by DB2
will be INCLUDED into your program by the precompiler
created on a panel within DB2I within TSO/ISPF or by JCL
You do the DCLGEN in the class. In real life it may be done by a DBA.
Go into DB2I within ISPF and specify:
the name of table, its owner/high level qualifier,
the name of your COBOL library (see Section 19 on how to create one. )
or a library that your company has set aside to hold DCLGENs.
the name of the declaration member in the library
(generally the same as the table, abbreviated if necessary.)
DCLGEN SSID: DSN ==>
Enter table name for which declarations are required:
1 SOURCE TABLE NAME ===> staff < the name of your table
2 TABLE OWNER ..... ===> < the high level qualifier
< of the table, if any
3 AT LOCATION ..... ===>
Enter destination data set:
4 DATA SET NAME ... ===> ‘userid.DB2.COBOL(STAFF)’
the name of your cobol library
with the member name of your declaration.
Enter options as desired:
6 ACTION .......... ===> REPLACE
7 COLUMN LABEL .... ===> NO
8 STRUCTURE NAME .. ===>
9 FIELD NAME PREFIX ===>
PRESS ENTER
What the declarations look like.
The generated declaration contains two parts
table declaration
used by the DB2 precompiler to check whether you are
using the table columns properly
COBOL data items you can use to reference the table columns
contains correct cobol pictures
don't invent cobol pictures, use these, they are right
occasionally, the name of a table column is a cobol reserved word
and you have to change the name of the cobol variable
STAFF
Note that I changed the COBOL variables ID and NAME to ID-x and NAME-x because ID and NAME are not legal in COBOL. Blame the designer of the table at IBM for not knowing COBOL.
EXEC SQL DECLARE STAFF TABLE
( ID SMALLINT NOT NULL,
NAME VARCHAR(9),
DEPT SMALLINT,
JOB CHAR(5),
YEARS SMALLINT,
SALARY DECIMAL(7, 2),
COMM DECIMAL(7, 2)
) END-EXEC.
* COBOL DECLARATION FOR TABLE STAFF
01 DCLSTAFF.
10 ID-x PIC S9(4) USAGE COMP.
10 NAME-x.
49 NAME-LEN PIC S9(4) USAGE COMP.
49 NAME-TEXT PIC X(9).
10 DEPT PIC S9(4) USAGE COMP.
10 JOB PIC X(5).
10 YEARS PIC S9(4) USAGE COMP.
10 SALARY PIC S9(5)V9(2) USAGE COMP-3.
10 COMM PIC S9(5)V9(2) USAGE COMP-3.
APPLICANT
Note that I changed the COBOL variables NAME and ADDRESS to NAME-x and ADDRESS-x because NAME and ADDRESS are not legal in COBOL.
EXEC SQL DECLARE APPLICANT TABLE
( TEMPID SMALLINT NOT NULL,
NAME VARCHAR(9),
ADDRESS VARCHAR(17),
EDLEVEL SMALLINT,
COMMENTS VARCHAR(29)
) END-EXEC.
* COBOL DECLARATION FOR TABLE APPLICANT *
01 DCLAPPLICANT.
10 TEMPID PIC S9(4) USAGE COMP.
10 NAME-x.
49 NAME-LEN PIC S9(4) USAGE COMP.
49 NAME-TEXT PIC X(9).
10 ADDRESS-x.
49 ADDRESS-LEN PIC S9(4) USAGE COMP.
49 ADDRESS-TEXT PIC X(17).
10 EDLEVEL PIC S9(4) USAGE COMP.
10 COMMENTS.
49 COMMENTS-LEN PIC S9(4) USAGE COMP.
49 COMMENTS-TEXT PIC X(29).
ORG
Note that I changed the COBOL variable DIVISION to DIVISION-x because DIVISION is not legal in COBOL.
EXEC SQL DECLARE ORG TABLE
( DEPTNUMB SMALLINT NOT NULL,
DEPTNAME VARCHAR(14),
MANAGER SMALLINT,
DIVISION VARCHAR(10),
LOCATION VARCHAR(13)
) END-EXEC.
* COBOL DECLARATION FOR TABLE ORG *
01 DCLORG.
10 DEPTNUMB PIC S9(4) USAGE COMP.
10 DEPTNAME.
49 DEPTNAME-LEN PIC S9(4) USAGE COMP.
49 DEPTNAME-TEXT PIC X(14).
10 MANAGER PIC S9(4) USAGE COMP.
10 DIVISION-x.
49 DIVISION-LEN PIC S9(4) USAGE COMP.
49 DIVISION-TEXT PIC X(10).
10 LOCATION.
49 LOCATION-LEN PIC S9(4) USAGE COMP.
49 LOCATION-TEXT PIC X(13).
EMP
EXEC SQL DECLARE EMP TABLE
( EMPNO CHAR(6) NOT NULL,
FIRSTNME VARCHAR(12) NOT NULL,
MIDINIT CHAR(1) NOT NULL,
LASTNAME VARCHAR(15) NOT NULL,
WORKDEPT CHAR(3),
PHONENO CHAR(4),
HIREDATE DATE,
JOB CHAR(8),
EDLEVEL SMALLINT,
SEX CHAR(1),
BIRTHDATE DATE,
SALARY DECIMAL(9, 2),
BONUS DECIMAL(9, 2),
COMM DECIMAL(9, 2)
) END-EXEC.
* COBOL DECLARATION FOR TABLE EMP *
01 DCLEMP.
10 EMPNO PIC X(6).
10 FIRSTNME.
49 FIRSTNME-LEN PIC S9(4) USAGE COMP.
49 FIRSTNME-TEXT PIC X(12).
10 MIDINIT PIC X(1).
10 LASTNAME.
49 LASTNAME-LEN PIC S9(4) USAGE COMP.
49 LASTNAME-TEXT PIC X(15).
10 WORKDEPT PIC X(3).
10 PHONENO PIC X(4).
10 HIREDATE PIC X(10).
10 JOB PIC X(8).
10 EDLEVEL PIC S9(4) USAGE COMP.
10 SEX PIC X(1).
10 BIRTHDATE PIC X(10).
10 SALARY PIC S9(7)V9(2) USAGE COMP-3.
10 BONUS PIC S9(7)V9(2) USAGE COMP-3.
10 COMM PIC S9(7)V9(2) USAGE COMP-3.
DEPT
EXEC SQL DECLARE DEPT TABLE
( DEPTNO CHAR(3) NOT NULL,
DEPTNAME VARCHAR(36) NOT NULL,
MGRNO CHAR(6),
ADMRDEPT CHAR(3) NOT NULL
) END-EXEC.
* COBOL DECLARATION FOR TABLE DEPT *
01 DCLDEPT.
10 DEPTNO PIC X(3).
10 DEPTNAME.
49 DEPTNAME-LEN PIC S9(4) USAGE COMP.
49 DEPTNAME-TEXT PIC X(36).
10 MGRNO PIC X(6).
10 ADMRDEPT PIC X(3).
* THE NUMBER OF COLUMNS DESCRIBED BY THIS DECLARATION IS 4 *
You may also do a DCLGEN with JCL:
//RUNDB2 EXEC PGM=IKJEFT01,DYNAMNBR=20
//STEPLIB DD DSN=DB2-LIBRARY-1,DISP=SHR
// DD DSN=DB2-LIBRARY-2,DISP=SHR
// DD DSN=DB2-LIBRARY-3,DISP=SHR
// ETC
//SYSTSPRT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//SYSTSIN DD *
DSN SYSTEM(DSN) /* REPLACE (DSN) WITH (NAME OF YOUR DB2 SUBSYSTEM) */
DCLGEN TABLE(STAFF) /* NAME OF TABLE, QUALIFIED OR UNQUALIFIED */ -
/* EX: Q.STAFF OR STAFF */ -
LIBRARY('userid.DB2.COBOL(STAFF)') -
LANGUAGE(COBOL) /* also may be COB2 */
ACTION(REPLACE) /* CAN BE ACTION(ADD) ALSO */ -
QUOTE /* END OF COMMAND */
Section 3: Embedding SQL
Delimit the SQL with EXEC SQL and END-EXEC, in column 12.
Recommended you put EXEC SQL,
the sql statement,
and END-EXEC on separate lines.
EXEC SQL
the sql statement goes here
note: only one sql statement, please
no semicolon!
for comments use * in column 7, not --
END-EXEC
or
END-EXEC.
Do you use the period or not?
In WORKING-STORAGE section YES, always.
In procedure division
If your SQL is inside the scope of a conditional, (not recommended)
use the period if it will not interfere with the conditional
remember that the period will terminate the conditional
If END-EXEC is the last thing in the paragraph, YES
Other times, NO.
Note the logic error in this segment of code.
If Trans-code = ‘D’
then
move input-id to ID-x
EXEC SQL
DELETE FROM STAFF WHERE ID = :ID-x
END-EXEC.
Else .... whatever
The logic error is that the period stops the IF.
Remove the period.
Section 4: The SQLCA
The SQLCA is a COBOL COPY member
You include it in your program by the INCLUDE SQLCA statement.
The SQLCA looks like this:
01 SQLCA.
03 SQLCAID PIC X(8).
03 SQLCABC PIC S9(9) COMP-4.
03 SQLCODE PIC S9(9) COMP-4 VALUE 0.
03 SQLERRM.
49 SQLERRML PIC S9(4) COMP-4.
49 SQLERRMC PIC X(70).
03 SQLERRP PIC X(8).
03 SQLERRD OCCURS 6 PIC S9(9) COMP-4.
03 SQLWARN.
05 SQLWARN0 PIC X.
05 SQLWARN1 PIC X.
05 SQLWARN2 PIC X.
05 SQLWARN3 PIC X.
05 SQLWARN4 PIC X.
05 SQLWARN5 PIC X.
05 SQLWARN6 PIC X.
05 SQLWARN7 PIC X.
03 SQLEXT.
05 SQLWARN8 PIC X.
05 SQLWARN9 PIC X.
05 SQLWARNA PIC X.
05 SQLSTATE PIC X(5).
* comp-4 means BINARY or COMP
* review: comp-3 is PACKED-DECIMAL
Section 5: The SQLCODE
SQLCODE in the SQLCA tells you if the SQL worked.
check it after every SQL statement
0 - worked OK, warnings possible
<0 - serious error meaning you probably should rollback and terminate
or a potential error that you can handle in your program
>0 - worked OK, warnings given
To find out what each SQLCODE means
use the procedure found on TSO, Quick-Reference:
TYPE QW on any TSO/ISPF screen, or other command used at your company
or use the code shown in the ERROR-EXIT in the sample programs
Some of the other fields of the SQLCA:
SQLERRD(3) number of rows changed (insert, update, delete)
or -1 when a DELETE has no WHERE clause,
and all rows will be deleted
SQLWARN0 it contains a W when there are warnings i.e. when SQLCODE > 0
SQLWARN1 contains a W when character data truncated
SQLWARN2 contains a W when a function handled a null by ignoring it
SQLWARN3 contains a W when the number of host variables is less
than the number of columns selected
SQLWARN4 contains a W when a dynamic SQL UPDATE/DELETE
does not contain a WHERE clause
SQLWARN5 contains a W when dynamic SQL does not contain valid SQL
SQLWARN6 contains a W when date/timestamp arithmetic
produces an invalid date (Nov 31)
it is changed to last day of month (Nov 30)
SQLWARN7 contains a W when character data truncated
possible low order number truncation
SQLWARN8 contains a W when a character could not be converted
SQLWARN9 contains a W when arithmetic data errors are found
while doing a COUNT(DISTINCT...) operation
SQLWARNA contains a W when there is a character conversion error
in SQLCA or SQLDA. The code will be invalid.
Suggested logic for checking SQLCODE
After each SQL statement, check SQLCODE using the following Case logic structure
Remember the three main possibilities:
GREAT! / NO PROBLEM! / DISASTROUS
GREAT!
SQL CODE = 0
ALL IS OK, do the following as needed:
SET FOUND SWITCH
add 1 to counter
PERFORM CHECK-FOR-NULLS
move data to output location
or just CONTINUE
NO PROBLEM! (three possibilities here)
SQL CODE = +100
This is 'not found' on a singleton select, 'end of cursor' on a fetch
do the following as needed:
SET FOUND SWITCH TO NO
SET END OF TABLE SWITCH TO YES
SQL CODE IS negative and ONE YOU EXPECT AND CAN HANDLE for example:
Duplicate on insert or
referential integrity violation or others
take corrective action and continue with program
SQL CODE indicates a warning SQLCODE is >0, or SQLWARN = ‘W’
possibly perform a WARNING-PARAGRAPH (see note #2 in program DB2CRSR1)
that displays the SQLCODE, displays the text of the error message,
displays the SQLWARN fields, and continues with the program
DISASTROUS
SQLCODE is less than 0
nothing worked
you should not continue with the program
go to ERROR-EXIT where you display the code,
rollback and stop
Section 6: Specific SQLCODE Conditions You Can Handle
SQLCODE +100 SQLSTATE 02000
Row not found or end of cursor
SQLCODE -803 SQLSTATE 23505
Duplicate key on insert or update
SQLCODE -181 SQLSTATE 22007
Bad data in Date/Time/Timestamp
SQLCODE -180 SQLSTATE 22007
Bad data in Date/Time/Timestamp
SQLCODE -530 SQLSTATE 23503
Referential integrity prevents the INSERT/UPDATE
SQLCODE -532 SQLSTATE 23504
Referential integrity (DELETE RESTRICT rule) prevents the DELETE
SQLCODE -904 SQLSTATE 57011
Unavailable resource. Someone is locking the data you need
you may choose to terminate the program
SQLCODE -911 SQLSTATE 40000
Deadlock or timeout. Rollback has been done.
SQLCODE -913 SQLSTATE 40502
Your program was the victim of a deadlock or timeout.
NO rollback has been done.
You should do a ROLLBACK.
Section 7: Some Severe SQLCODE Errors
SQLCODE -305
Null indicator needed
SQLCODE -501
Cursor not open on FETCH
SQLCODE -311
Varchar, insert or update. You didn’t set the -LEN field with the right data length
SQLCODE -803
Duplicate key
SQLCODE -811
More than one row retrieved in SELECT INTO
SQLCODE -904, -911, -913
Timeout or unavailable resource
Section 8: Referring to COBOL Variables (Host Variables)
Host variables are defined for you in a DCLGEN.
You may define others for your own use, outside of a DCLGEN
but be sure their picture is exactly the same as that in the DCLGEN
if the pictures can't be the same, then move the non-conformist
to a conforming variable
In COBOL:
MOVE INPUT-ID TO ID-X
INPUT-ID is a COBOL variable defined in the FD record description.
It may or may not have the same picture as ID-x in the DCLGEN.
It probably doesn’t. Move it to ID-x in the declaration which has the correct picture.
In an SQL statement, prefix the host variable name with a colon
EXEC SQL
DELETE FROM STAFF WHERE ID = :ID-x
END-EXEC.
Qualification
When the cobol variable names are defined in more than one declaration,
qualify the variable name with the name of the 01 group level that the declaration generated.
Look in the DCLGEN, at the 01 group level in the COBOL part
it says:
01 DCLSTAFF
this is the name you will use for qualifying host variables
Qualifying host variables in SQL:
Put the COBOL 01 group level name after the colon and add a period.
SELECT SALARY
INTO :DCLSTAFF.SALARY
FROM STAFF
WHERE ID = :DCLSTAFF.ID-x
Qualifying host variables in COBOL
add "IN" or "OF" and the group level name.
MOVE 12 TO ID-x IN DCLSTAFF.
MOVE SALARY OF DCLSTAFF TO the-output-salary
Section 9: The Singleton Select
See the program DB2SINGL in Section 24.
The singleton SELECT returns one row and only one row.
Otherwise you get an SQLCODE -811.
If it returns more than one row, you have to use a cursor (later section)
Two ways to return just one row:
1 a SELECT with a WHERE clause with PK COLUMN is EQUAL to something
MOVE THE-INPUT-ID TO ID-X
EXEC SQL
* Note that the columns you select are in the same order
* as the host variables after the INTO
SELECT ID, NAME, SALARY
INTO :ID-x, :NAME-x, :SALARY
FROM STAFF
WHERE ID = :ID-x
END-EXEC.
2 a column function:
EXEC SQL
SELECT AVG(SALARY), MAX(COMM)
INTO :SALARY, :COMM
FROM STAFF
WHERE DEPT = 20
END-EXEC.
Note: this will return NULLS if there is no match
Another way, not seen very often
selecting one distinct column
with a WHERE clause requesting equality on that column
(this is a fictitious table)
EXEC SQL
SELECT DISTINCT RATE WHERE RATE = 58
AND CURRENT DATE => EFFECTIVE_DATE
END-EXEC.
this is being done to get a YES (SQLCODE = 0)
or NO (SQLCODE = +100)
in answer to the question "Is there a rate with this effective date?"
Section 10: Handling Nulls
You need one null indicator variable for each column that may contain nulls.
Otherwise, SQLCODE -305.
Remember Murphy's first law of Nullitude - 305:
Any column that CAN contain nulls WILL contains nulls when you are on call...
Look at DCLGEN, for NOT NULL - that means nulls not possible
If it doesn't say NOT NULL, you must use a null indicator variable
Put Indicator Variables in WORKING-STORAGE, near DCLGENs:
(see sample programs in Sections 20 thru 24)
01 COMM-NULL PIC S9(4) BINARY VALUE ZERO.
What to do in PROCEDURE DIVISION
* clear out the normal host variable
* if numeric, move zeros; if it's a character field, move spaces
* This is because, if there's really a null present, COMM is not changed
* In other words, no new data appears in COMM.
Move 0 to COMM
* zero out the null indicator (not necessary, but recommended)
Move 0 to COMM-NULL
MOVE INPUT-ID TO ID-X
EXEC SQL
SELECT ID, NAME, COMM
INTO :ID-x, :NAME-x, :COMM:COMM-NULL
FROM STAFF
WHERE ID = :ID-x
END-EXEC.
check SQLCODE as always
* If you retrieved a null, COMM-NULL will be negative
* and COMM will be zero
* If you retrieved a normal data value, COMM-NULL will be zero
More details on the null indicator
-1 means null
-2 means null because of an arithmetic statement that didn't work
also gives SQLCODE +802
0 means valid data is present
>0 means that there was a truncation
Examples after the section on Variable Length
Section 11: Whenever
A situation trap.
Recommended only in early stages of testing
Suggest you check SQLCODE yourself
Continuously monitors the SQLCODE of your SQL statements
takes action immediately after SQL statement is executed
Whenever overrides your own SQLCODE checking!
That means that WHENEVER SQLERROR overrides IF SQLCODE < 0 ...
All your case logic to test SQLCODE will be ignored if you use WHENEVER.
The Whenever influences all SQL statements that physically (!) follow it.
This is not a chronological or logical thing!
That makes it impossible to use logically in a structured program!
You have a choice of two actions to take when the condition comes true.
GO TO a paragraph, or CONTINUE (ignore the situation)
You can't PERFORM anything!
A law of structured programming states that if you GO TO anywhere,
you'd better not plan on coming back!
This means that you had better GO TO an ERROR-EXIT
if there is a severe error (SQLCODE < 0)
This one may be useful, when placed at the beginning of procedure division while testing
EXEC SQL
WHENEVER SQLERROR GO TO ERROR-EXIT
END-EXEC.
In ERROR EXIT, you display the SQLCODE,
display the text of the error message, (see sample program DB2ACD1)
and GET OUT!
You can ROLLBACK, call an abend routine,
or just GOBACK.
Section 12: Host Variable Datatypes
These are the correspondences between DB2 and COBOL datatypes
DB2 COBOL
CHAR(n) PIC X(n) n between 1 and 254
CHAR(10) PIC X(10)
VARCHAR(n)
DEPTNAME VARCHAR(14) 10 DEPTNAME.
49 DEPTNAME-LEN PIC S9(4) BINARY.
49 DEPTNAME-TEXT PIC X(14).
SMALLINT PIC S9(4) BINARY.
INTEGER PIC S9(9) BINARY.
COUNT(*) requires PIC S9(9) BINARY
DECIMAL(l,d) PIC S9(l - d)V9(d) PACKED-DECIMAL.
l is total length of the number
d is how many digits to right of decimal point
DECIMAL(7,2) PIC S9(5)V99 PACKED-DECIMAL.
TIME PIC X(8)
hh.mm.ss
DATE PIC X(10)
yyyy-mm-dd
TIMESTAMP PIC X(26)
yyyy-mm-dd-hh.mm.ss.mmmmmm
where mmmmmm stands for microseconds
Reminder about COBOL datatypes
COMP/BINARY number stored in binary
COMP-1 short precision floating point
COMP-2 long precision floating point
COMP-3/PACKED DECIMAL normal one used for counters,
money accumulators, etc
COMP-4 binary. Used in the SQLCA.
Section 13: Handling Variable Length Columns
If a column is VARCHAR the DCLGEN will use a group item instead, with level 49’s under it:
10 DEPTNAME.
49 DEPTNAME-LEN PIC S9(4) COMP/BINARY.
49 DEPTNAME-TEXT PIC X(14).
Handling VARCHAR in Procedure Division:
When SELECTing or FETCHing
Clear out the data portion of the variable:
Move spaces to DEPTNAME-TEXT
Make the length field zero:
Move 0 to DEPTNAME-LEN
SELECT or FETCH into the group name, DEPTNAME.
check SQLCODE as you always do after each SQL statement
Check the length field, greater than zero means there is usable data:
If DEPTNAME-LEN > 0
then use the data in DEPTNAME-TEXT constructively
else, don’t try to use the data in DEPTNAME-TEXT - it is not usable
If the SQL fails, DEPTNAME-TEXT is unchanged
If the SQL retrieves 6 characters, only 6 characters
of DEPTNAME-TEXT are changed, the remaining 8 are untouched,
this is why you moved spaces to it just above.
When INSERTing or UPDATEing
Move data to the data field:
MOVE ‘PAYROLL’ to DEPTNAME-TEXT
Put the length of the data (not counting trailing spaces) in the length field
MOVE 7 to DEPTNAME-LEN
7 was used because the literal ‘PAYROLL’ contains 7 characters.
You may also move 14, the maximum length (see the DCLGEN)
Do the INSERT/UPDATE
Section 14: Examples Showing NULLS and Variable Length
SELECT, not nullable, fixed format or numeric
* use this when table column is not null, char(..)
* or a numeric datatype
* note that JOB really is nullable
* but for this example, please consider it not nullable
EXEC SQL
SELECT JOB
INTO :JOB
FROM STAFF
WHERE ID = 10
END-EXEC
SELECT, nullable, fixed format or numeric
* use this when table column is char(..)
* or a numeric datatype
MOVE 0 TO JOB-NULL
MOVE SPACES TO JOB
EXEC SQL
SELECT JOB
INTO :JOB:JOB-NULL
FROM STAFF
WHERE ID = 10
END-EXEC
* if JOB happens to be null this gives spaces
* also JOB-NULL will contain a negative number
SELECT, not nullable, variable format
* use this when table column is not null, varchar(..)
* note that NAME really is nullable
* but for this example, please consider it not nullable
MOVE 0 TO NAME-LEN
MOVE SPACES TO NAME-TEXT
EXEC SQL
SELECT NAME
INTO :NAME-X
WHERE ID = 10
END-EXEC
* this will give spaces, if name happens to be length 0
IF NAME-LEN > 0
THEN DISPLAY 'SUCCESSFULLY RETRIEVED NAME ' NAME-TEXT
ELSE DISPLAY 'NAME WAS ZERO LENGTH OR MISSING'
END-IF
SELECT, nullable, variable format
* use this when table column is varchar(..)
MOVE 0 TO NAME-NULL
MOVE 0 TO NAME-LEN
MOVE SPACES TO NAME-TEXT
EXEC SQL
SELECT NAME
INTO :NAME-X:NAME-NULL
WHERE ID = 10
END-EXEC
*this will work, giving spaces, if name happens to be length 0
*if name is null it will give spaces
* and NAME-NULL will contain a negative number
IF NAME-LEN > 0 AND NAME-NULL > 0
THEN DISPLAY 'SUCCESSFULLY RETRIEVED NAME ' NAME-TEXT
ELSE DISPLAY 'NAME WAS ZERO LENGTH OR MISSING'
END-IF
INSERT, not nullable, fixed
* note that JOB really is nullable, but just for the example,
* assume it is not nullable
MOVE 'XYZ' TO JOB
MOVE 11 TO ID-X
EXEC SQL
INSERT INTO STAFF
(ID, JOB)
VALUES
(:ID-X, :JOB)
END-EXEC
INSERT, nullable, fixed, data is not null
MOVE 'XYZ' TO JOB
MOVE 0 TO JOB-NULL
MOVE 11 TO ID-X
EXEC SQL
INSERT INTO STAFF
(ID, JOB)
VALUES
(:ID-X, :JOB:JOB-NULL)
END-EXEC
INSERT, nullable, fixed format, data IS null
MOVE SPACES TO JOB
* IF NUMERIC FIELD, MOVE ZEROS
MOVE -1 TO JOB-NULL
MOVE 11 TO ID-X
EXEC SQL
INSERT INTO STAFF
(ID, JOB)
VALUES
(:ID-X, :JOB:JOB-NULL)
END-EXEC
INSERT, not nullable, variable
MOVE 11 TO ID-X
MOVE 'NADIA' TO NAME-TEXT
MOVE 5 TO NAME-LEN
EXEC SQL
INSERT INTO STAFF
(ID, NAME)
VALUES
(:ID-X, :NAME-X)
END-EXEC
INSERT, nullable, variable, data is not null
MOVE 0 TO NAME-NULL
MOVE 'NADIA' TO NAME-TEXT
MOVE 5 TO NAME-LEN
EXEC SQL
INSERT INTO STAFF
(ID, NAME)
VALUES
(:ID-X, :NAME-X:NAME-NULL)
END-EXEC
INSERT, nullable, variable, data IS null
MOVE -1 TO NAME-NULL
MOVE SPACE TO NAME-TEXT
MOVE 0 TO NAME-LEN
EXEC SQL
INSERT INTO STAFF
(ID, NAME)
VALUES
(:ID-X, :NAME-X:NAME-NULL)
END-EXEC
UPDATE, not nullable, fixed format (or numeric)
* note that JOB really is nullable, but just for the example,
* assume it is not nullable
MOVE 11 TO ID-X
MOVE 'XYZ' TO JOB
EXEC SQL
UPDATE STAFF
SET JOB = :JOB,
WHERE ID = :ID-X
END-EXEC
UPDATE, nullable, fixed format (or numeric) data is not null
MOVE 0 TO JOB-NULL
MOVE 'XYZ' TO JOB
MOVE 11 TO ID-X
EXEC SQL
UPDATE STAFF
SET JOB = :JOB:JOB-NULL,
WHERE ID = :ID-X
END-EXEC
UPDATE, nullable, fixed format (or numeric) data IS null
MOVE SPACES TO JOB
MOVE -1 TO JOB-NULL
MOVE 11 TO ID-X
EXEC SQL
UPDATE STAFF
SET JOB = :JOB:JOB-NULL
WHERE ID = :ID-X
END-EXEC
UPDATE, not nullable, variable format
* note that NAME really is nullable, but assume it is not nullable
MOVE 'NADIA' TO NAME-TEXT
MOVE 5 TO NAME-LEN
MOVE 11 TO ID-X
EXEC SQL
UPDATE STAFF
SET NAME = :NAME-X
WHERE ID = :ID-X
END-EXEC
UPDATE, nullable, variable format, data is not null
MOVE 0 TO NAME-NULL
MOVE 'NADIA' TO NAME-TEXT
MOVE 5 TO NAME-LEN
MOVE 11 TO ID-X
EXEC SQL
UPDATE STAFF
SET NAME = :NAME-X:NAME-NULL
WHERE ID = :ID-X
END-EXEC
UPDATE, nullable, variable format, data IS null
MOVE -1 TO NAME-NULL
MOVE SPACES TO NAME-TEXT
MOVE 0 TO NAME-LEN
MOVE 11 TO ID-X
EXEC SQL
UPDATE STAFF
SET NAME = :NAME-X:NAME-NULL
WHERE ID = :ID-X
END-EXEC
Section 15: The Cursor
See the program DB2CRSR1 in Section 21.
You need a cursor when:
you are going to retrieve multiple rows or there is a chance you might
Murphy's law number -811:
The select that has ALWAYS retrieved just one row
will suddenly retrieve 15 two seconds after the dog eats the pager...
The "cursor" is actually the result table, produced by a SELECT.
the result table appears in the form of an apparent flat (sequential) file,
which you handle in a way similar to that of a flat file.
You handle Cursors and flat files in a similar fashion
Here's what you do with a flat file:
define the file with SELECT and FD in Data Division
Open for input
do a "priming" read
repeat until end of file
process the data from the previous read
read a record, if end of file, set the end of file switch
end repeat
close the file
You can read only one record at a time,
in a forward direction only
no skipping records.
Here's what you do with a cursor:
Declare the cursor in Working-Storage section
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY
FROM STAFF
WHERE SALARY > 15000
END-EXEC
A declare cursor is actually a select. the select is not executed until you open the cursor
Don’t check SQLCODE here
Open the cursor
EXEC SQL
OPEN STAFF_CUR
END-EXEC
the select is now executed
more…
Do a FETCH, into COBOL variables (a "priming" fetch)
EXEC SQL
FETCH STAFF_CUR
INTO :NAME-x, :SALARY
END-EXEC
You can fetch only one row at a time,
and in a forward direction only
no skipping rows.
Use looping logic to process each row retrieved
Repeat until end-of-file-switch = ‘YES’
process the data obtained on the fetch
do a fetch, into cobol variables
if the sqlcode = +100, move ‘YES’ to end-of-file-switch
end repeat
Close the cursor
EXEC SQL
CLOSE STAFF_CUR
END-EXEC
this releases the result table
if you want to see the data again, you need another open
Section 16: Considerations on Using a Cursor
The DECLARE CURSOR is placed in the WORKING-STORAGE section.
It is not actually executed until you OPEN the cursor in the PROCEDURE DIVISION.
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY
FROM STAFF
WHERE SALARY > 15000
END-EXEC
The FETCH is executed in PROCEDURE DIVISION,
generally in a loop that is repeated until a +100 SQLCODE (end of results table)
or a negative SQLCODE is received.
-501 means that the cursor is not open
The FETCH must fetch into host variables
in the same order as the DECLARE CURSOR selected them.
EXEC SQL
FETCH STAFF_CUR
INTO :NAME-x, :SALARY
END-EXEC
COMMIT (by default) closes the cursor (so does a GOBACK)
and releases locks, releases the result table
and you have to open the cursor again if you want to continue
Cursor stays open on COMMIT when:
cursor is declared WITH HOLD
now, when you COMMIT, the results table is not touched
the current row pointed to is not touched
(the next FETCH gets the next row)
but locks are released
EXEC SQL
DECLARE STAFF_CUR CURSOR WITH HOLD FOR
SELECT NAME, SALARY FROM STAFF
WHERE SALARY > 15000
END-EXEC
FOR UPDATE OF column(s) to UPDATE these columns based on current cursor position
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY FROM STAFF
WHERE SALARY > 15000
FOR UPDATE OF SALARY
END-EXEC
FOR FETCH ONLY says you promise to READ and not change in any way.
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY FROM STAFF
WHERE SALARY > 15000
FOR FETCH ONLY
END-EXEC
OPTIMIZE FOR 10 ROWS asks DB2 to optimize for this number of rows
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY FROM STAFF
WHERE SALARY > 15000
FOR FETCH ONLY --(optional clause)
OPTIMIZE FOR 10 ROWS
END-EXEC
WITH UR WITH CS WITH RR specifies the isolation
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY FROM STAFF
WHERE SALARY > 15000
WITH UR
END-EXEC
This is the order of the clauses.
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY FROM STAFF
WHERE SALARY > 15000
FOR FETCH ONLY --(optional clause)
OPTIMIZE FOR 10 ROWS --(optional clause)
WITH UR --(optional clause)
END-EXEC
Section 17: Deleting and Updating with a Cursor
How to delete or update only the row just fetched
Deleting
Add the phrase WHERE CURRENT OF cursor to the DELETE SQL
EXEC SQL
DELETE FROM STAFF
WHERE CURRENT OF STAFF_CUR
END-EXEC
Updating
Add the phrase WHERE CURRENT OF cursor to the UPDATE SQL
EXEC SQL
UPDATE STAFF
SET SALARY = SALARY * 2
WHERE CURRENT OF STAFF_CUR
END-EXEC
Also add the phrase FOR UPDATE OF column to the cursor declaration
EXEC SQL
DECLARE STAFF_CUR CURSOR FOR
SELECT NAME, SALARY
FROM STAFF
FOR UPDATE OF SALARY
END-EXEC
Section 18: Creating a COBOL Library if You Don’t Already Have One
TSO/ISPF Option 3.2
---------------------------- DATA SET UTILITY
OPTION ===> M
A - Allocate new data set C - Catalog data set
R - Rename entire data set U - Uncatalog data set
D - Delete entire data set S - Data set information (short)
blank - Data set information M - Enhanced data set allocation
ISPF LIBRARY:
PROJECT ===> Userid
GROUP ===> DB2
TYPE ===> COBOL
OTHER PARTITIONED OR SEQUENTIAL DATA SET:
DATA SET NAME ===>
VOLUME SERIAL ===>
DATA SET PASSWORD ===> (If password protected)
ENTER
--------- ALLOCATE NEW DATA SET --
COMMAND ===>
DATA SET NAME: Userid.DB2.COBOL
MANAGEMENT CLASS ===>
STORAGE CLASS ===>
VOLUME SERIAL ===>
DATA CLASS ===>
SPACE UNITS ===> TRACK
PRIMARY QUANTITY ===> 10
SECONDARY QUANTITY ===> 5
DIRECTORY BLOCKS ===> 10
RECORD FORMAT ===> FB
RECORD LENGTH ===> 80
BLOCK SIZE ===>
DATA SET NAME TYPE ===> PDS (* Specifying LIBRARY may
override zero directory block)
EXPIRATION DATE ===>
ENTER
Section 19: Useful Things You Can Do with QMF
Seeing explanations of SQL syntax
______________________________________________________________________________
IBM*
Licensed Materials - Property of IBM
5706-254 5706-255 5648-061
(c) Copyright IBM Corp. 1982, 1995 All Rights Reserved.
* Trademark of International Business Machines
______________________________________________________________________________
QMF HOME PANEL
Version 3 Release 2.0 B ****** ** ** *********
** ** *** *** **
Query ** ** **** **** *******
Management ** ** ** ** ** ** **
Facility ** * ** ** **** ** **
****** ** ** ** **
________________________________________
Type command on command line or use PF keys. For help, press PF1 or type HELP.
______________________________________________________________________________
1=Help 2=List 3=End 4=Show 5=Chart 6=Query
7=Retrieve 8=Edit Table 9=Form 10=Proc 11=Profile 12=Report
Command = = > HELP
Type HELP or press PF1 to get the HELP panel
Choose SQL for explanations and examples of SQL syntax.
Seeing how the table was defined
Press PF6 to get into the query panel
SQL QUERY LINE 1
*** END ***
1=Help 2=Run 3=End 4=Print 5=Chart 6=Draw
7=Backward 8=Forward 9=Form 10=Insert 11=Delete 12=Report
QUERY is displayed.
COMMAND DRAW table-name (TYPE = INSERT)
Type in DRAW table-name (TYPE = INSERT)
Giving yourself a copy of a table that you can INSERT/UPDATE/DELETE
SQL QUERY LINE 1
*** END ***
1=Help 2=Run 3=End 4=Print 5=Chart 6=Draw
7=Backward 8=Forward 9=Form 10=Insert 11=Delete 12=Report
OK, QUERY is displayed.
COMMAND SCROLL ===> PAGE
Type on the command line:
RESET QUERY
DISPLAY table-name for example: Q.STAFF
SAVE DATA AS table-name qualified with your Userid for example: Userid.STAFF
Section 20: Program DB2ACD1
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ‘DB2ACD1’.
000300* sample cobol program
000400* Random update
000500* Read db2 table APPLICANT randomly,
000600* based on a regular file read sequentially (member transacd)
000700* add, change, delete based on the trans code
000800* in the regular file
000900 ENVIRONMENT DIVISION.
001000 CONFIGURATION SECTION.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 SELECT trans-FILE ASSIGN transacd.
001400 DATA DIVISION.
001500 FILE SECTION.
001600 FD trans-file
001700 RECORDING MODE IS F
001800 RECORD CONTAINS 80 CHARACTERS.
001900
002000 01 trans-RECORD.
002100 05 trans-code PIC X(01).
002200 88 add-trans value 'A'.
002300 88 change-trans value 'C'.
002400 88 delete-trans value 'D'.
002500 05 FILLER PIC X(01).
002600 05 trans-tempid PIC 9(04).
002700 05 FILLER PIC X(01).
002800 05 trans-name PIC X(09).
002900 05 FILLER PIC X(01).
003000 05 trans-address PIC X(17).
003100 05 FILLER PIC X(01).
003200 05 trans-edlevel PIC 9(04).
003300 05 FILLER PIC X(01).
003400 05 trans-comments PIC X(29).
003500 05 FILLER PIC X(01).
003600
003700 WORKING-STORAGE SECTION.
003800 01 SWITCHES.
003900 05 FILE-AT-END PIC X VALUE 'N'.
004000
004100 01 counters-and-accumulators.
004200 05 trans-record-count pic s9(7) packed-decimal value zero.
004300 05 trans-add-count pic s9(7) packed-decimal value zero.
004400 05 trans-change-count pic s9(7) packed-decimal value zero.
004500 05 trans-delete-count pic s9(7) packed-decimal value zero.
004600
004700 01 display-sqlcode pic z(8)9-.
004800
004900 01 ERR-MESS-DATA.
005000 05 ERR-MESS-LEN PIC S9(4) BINARY VALUE +960.
005100 05 ERR-MESS-TEXT PIC X(120) OCCURS 8 TIMES
005200 INDEXED BY ERR-INDEX.
005300 01 ERR-TEXT-LEN PIC S9(9) BINARY VALUE +120.
005400
005500* DB2 THINGS COME NEXT: SQLCA AND DECLARATIONS
005600*
005700* THE SQLCA IS HERE
005800 EXEC SQL
005900 INCLUDE SQLCA
006000 END-EXEC.
006100
006200 EXEC SQL
006300 INCLUDE applican
006400 END-EXEC.
009400
009500 PROCEDURE DIVISION.
009600 DISPLAY 'STARTING PROGRAM db2acd1'
009700
009800 PERFORM INITIALIZATION
009900 PERFORM PROCESS-ALL
010000 UNTIL FILE-AT-END = 'Y'
010100 PERFORM TERMINATION.
010300* EXEC SQL
* do a rollback if you want
010400* ROLLBACK
010500* END-EXEC
010600
010700* display 'rollback done at normal end of program'
010800
010900 GOBACK.
011000
011100 INITIALIZATION.
011200* when: one time, at beginning of program
011400* out: trans-record contains next record in trans-file
011500 OPEN INPUT trans-file
011600 PERFORM READ-PAR.
011700
011800 PROCESS-ALL.
011900* when: repeatedly, until no more records remain
012200 PERFORM process-trans
012300 PERFORM READ-PAR.
012400
012500 TERMINATION.
012600* when: one time, at logical end of program
012800* out: trans-file no longer available for processing
012900 CLOSE trans-file.
013000
013100 READ-PAR.
013200* when: one time, during initialization
013300* each time process-all is performed
013500* out: trans-record contains next record in trans-file
013600* file-at-end switch is set to 'Y' if there are no more records
013700 READ trans-file
013800 AT END MOVE 'Y' TO FILE-AT-END
013900 END-READ.
014000
014100 process-trans.
014200* when: one time, during initialization
014300* each time process-all is performed
014600* decisions: perform proper paragraph depending on type of trans
014700 display space
014800 evaluate true
014900 when add-trans perform process-add-trans
015000 when change-trans perform process-change-trans
015100 when delete-trans perform process-delete-trans
015200 when other perform process-unknown-trans
015300 end-evaluate.
015400
015500 process-add-trans.
015600* when: when an add transaction is read
015900* decisions: display proper message depending on sqlcode
016000* sqlcode > 0 or sqlwarn0 = 'W' perform warning paragraph
016100* sqlcode < 0 go to error-exit
016200 perform move-fields-to-dclgen
016300 perform sql-for-add
016400 evaluate true
016500 when sqlcode = 0 display 'successful add'
016600* display trans-record
016700 when sqlcode = -803
016800 display 'cannot add '
016900* display trans-record
017000 display 'duplicate -803'
017100 when sqlcode > 0 or sqlwarn0 = 'W'
017200 perform warning-paragraph
017300 when sqlcode < 0 go to error-exit
017400 end-evaluate.
017500
017600 process-change-trans.
017700* when: when a change transaction is read
018000* decisions: display proper message depending on sqlcode
018100* sqlcode > 0 or sqlwarn0 = 'W' perform warning paragraph
018200* sqlcode < 0 go to error-exit
018300 perform move-fields-to-dclgen
018400 perform sql-for-change
018500 evaluate true
018600 when sqlcode = 0
018700 display 'successful change'
018800* display trans-record
018900 when sqlcode = -803
019000 display 'cannot change'
019100* display trans-record
019200 display 'duplicate -803'
019300 when sqlcode = -530
019400 display 'cannot change'
019500* display trans-record
019600 display 'ri - 530'
019700 when sqlcode = -532
019800 display 'cannot change'
019900* display trans-record
020000 display 'ri - 532'
020100 when sqlcode = +100
020200 display 'cant change '
020300* display trans-record
020400 display 'notfound'
020500 when sqlcode > 0 or sqlwarn0 = 'W'
020600 perform warning-paragraph
020700 when sqlcode < 0 go to error-exit
020800 end-evaluate.
020900
021000 process-delete-trans.
021100* when: when a delete transaction is read
021400* decisions: display proper message depending on sqlcode
021500* sqlcode > 0 or sqlwarn0 = 'W' perform warning paragraph
021600* sqlcode < 0 go to error-exit
021700 move trans-tempid to tempid
021800 perform sql-for-delete
021900 evaluate true
022000 when sqlcode = 0 display 'successful delete'
022100* display trans-record
022200 when sqlcode = +100
022300 display 'cant delete '
022400* display trans-record
022500 display 'notfound'
022600 when sqlcode = -530
022700 display 'cannot delete'
022800* display trans-record
022900 display 'ri - 530'
023000 when sqlcode = -532
023100 display 'cannot delete'
023200* display trans-record
023300 display 'ri - 532'
023400 when sqlcode > 0 or sqlwarn0 = 'W'
023500 perform warning-paragraph
023600 when sqlcode < 0 go to error-exit
023700 end-evaluate.
023800
023900 process-unknown-trans.
024000 display 'transaction code ' trans-code ' is unknown'
024100 display 'on record # ' trans-record-count.
024200
024300 sql-for-add.
024400* when: when you need to insert a row into applicant
024500* in: COBOL data items tempid, name-x, address-x, edlevel, comments
024600* out: db2 table applicant columns tempid, name, address, edlevel,
024700* comments are changed to values in COBOL data items
024900 perform add-display
025000 exec sql
025100 insert into applicant
025200 (tempid, name, address, edlevel, comments)
025300 values
025400 (:tempid, :name-x, :address-x, :edlevel, :comments)
025500 end-exec.
025600
025700 sql-for-change.
025800* when: when you need to update the row in applicant
025900* that was most recently read
026000* the specific one is determined by the value of tempid
026100* in: COBOL data items name-x, address-x, edlevel, comments
026200* out: db2 table applicant columns name, address, edlevel,
026300* comments are changed to values in COBOL data items
026400* decisions:
026500 perform change-display
026600 exec sql
026700 update applicant
026800 set
026900 name = :name-x,
027000 address = :address-x,
027100 edlevel = :edlevel,
027200 comments = :comments
027300 where tempid = :tempid
027400 end-exec.
027500
027600 sql-for-delete.
027700* when: when you need to delete the row in applicant
027800* that was most recently read
027900* the specific one is determined by the value of tempid
028100* out: db2 table applicant row corresponding to tempid
028200* is deleted
028400 perform delete-display
028500 exec sql
028600 delete from applicant
028700 where tempid = :tempid
028800 end-exec.
028900
029000 move-fields-to-dclgen.
029100* when: just before adding, changing a row in applicant
029200* in: trans-tempid, trans-name, trans-address, trans-edlevel,
029300* trans-comments
029400* out: tempid, name-len, name-text, address-len, address-text
029500* edlevel, comments-len, comments-text
029600*
029800 move trans-tempid to tempid
029900 move 9 to name-len
030000 move trans-name to name-text
030100 move 17 to address-len
030200 move trans-address to address-text
030300 move trans-edlevel to edlevel
030400 move 29 to comments-len
030500 move trans-comments to comments-text.
030600
* 1
030700 ERROR-EXIT.
030800* when: when an sql statement produces a <0 sqlcode
030900* in: SQLCODE from SQL statement
031000* out: messages, rollback, end program
031200* decisions: display the proper message for each sqlcode
031300 MOVE SQLCODE TO DISPLAY-SQLCODE.
031400 DISPLAY 'SQLCODE FOLLOWS' display-SQLCODE
031500 EVALUATE true
031600 WHEN sqlcode = 0
031700* display 'successful execution'
031800 continue
031900 WHEN sqlcode = +100
032000* display 'not found'
032100 continue
032200 WHEN sqlcode = -305
032300 display 'no null indicator'
032200 WHEN sqlcode = -311
032300 display 'length of variable wrong'
032350 WHEN sqlcode = -501
032360 display 'cursor not open on fetch'
032400 WHEN sqlcode = -530
032500 display 'ri ins/upd'
032600 WHEN sqlcode = -532
032700 display 'ri delete'
032800 WHEN sqlcode = -803
032850 display 'dup row '
032860 WHEN sqlcode = -811
032900 display 'more than 1 row on select into '
033000 WHEN sqlcode = -904
033100 display 'unavail resource'
033200 WHEN sqlcode = -911
033300 display 'deadlock/timeout, rollback done'
033400 WHEN sqlcode = -913
033500 display 'deadlock/timeout victim, no rollback'
033600 WHEN OTHER
033700 display 'severe sql error'
033800 end-evaluate
033900
034000 CALL 'DSNTIAR' USING SQLCA ERR-MESS-DATA ERR-TEXT-LEN
034100
034200 PERFORM ERROR-EXIT-PRINT-ERROR
034300 VARYING ERR-INDEX FROM 1 BY 1 UNTIL ERR-INDEX > 8
034400
034500* IN REAL LIFE YOU WOULD CALL AN ABORT ROUTINE
034600 EXEC SQL
034700 ROLLBACK
034800 END-EXEC
034900
035000 display 'rollback done'
035100
035200 GOBACK.
035300
035400 ERROR-EXIT-PRINT-ERROR.
035500 if err-mess-text(err-index) not = spaces
035600 then DISPLAY ERR-MESS-TEXT(ERR-INDEX).
* 2
035800 warning-paragraph.
035850 MOVE SQLCODE TO DISPLAY-SQLCODE.
035860 DISPLAY 'SQLCODE FOLLOWS' display-SQLCODE
035900 if sqlwarn1 = 'W'
036000 then display 'character data truncated'
036100 'sqlwarn1 = W'
036200 end-if
036300
036400 if sqlwarn2 = 'W'
036500 then display 'a function handled a null by ignoring it'
036600 'sqlwarn2 = W'
036700 end-if
036800
036900 if sqlwarn3 = 'W'
037000 then display 'the number of host variables is less '
037100 'than the number of columns selected '
037200 'sqlwarn3 = W'
037300 end-if
037400
037500 if sqlwarn4 = 'W'
037600 then display 'a dynamic sql update/delete does not '
037700 'contain a where clause '
037800 'sqlwarn4 = W'
037900 end-if
038000
038100 if sqlwarn5 = 'W'
038200 then display 'dynamic sql does not contain valid sql'
038300 'sqlwarn5 = W'
038400 end-if
038500
038600 if sqlwarn6 = 'W'
038700 then display 'date/timestamp arithmetic '
038800 'produces an invalid date ex: nov 31'
038900 'it is changed to last day of month ex: nov 30'
039000 'sqlwarn6 = W'
039100 end-if
039200
039300 if sqlwarn7 = 'W'
039400 then display 'character data truncated '
039500 'possible low order truncation '
039600 'sqlwarn7 = W'
039700 end-if
039800
039900 if sqlwarn8 = 'W'
040000 then display 'a character could not be converted '
040100 'sqlwarn8 = W'
040200 end-if
040300
040400 if sqlwarn9 = 'W'
040500 then display 'arithmetic data errors found'
040600 'while doing a count(distinct) '
040700 'sqlwarn9 = W'
040800 end-if
040900
041000 if sqlwarna = 'W'
041100 then display 'character conversion error'
041200 'in sqlca or sqlda. the code will be invalid'
041300 'sqlwarna = W'
041400 end-if.
041500
041600 add-display.
041700 display 'adding' space
041800 display 'tempid' space
041900 tempid
042000 display 'name-x' space
042100 name-x
042200 display 'address-x' space
042300 address-x
042400 display 'edlevel' space
042500 edlevel
042600 display 'comments' space
042700 comments.
042800
042900 change-display.
043000 display 'changing' space
043100 display 'tempid' space
043200 tempid
043300 display 'name-x' space
043400 name-x
043500 display 'address-x' space
043600 address-x
043700 display 'edlevel' space
043800 edlevel
043900 display 'comments' space
044000 comments.
044100
044200 delete-display.
044300 display 'deleting'
044400 'tempid ' space tempid.
Section 21: Program DB2CRSR1
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*
002300* Db2 things come next: sqlca and declarations
002400*****************************************************************
002500* THE SQLCA IS HERE
002600 EXEC SQL
002700 INCLUDE SQLCA
002800 END-EXEC.
002900 EXEC SQL
003000 INCLUDE applican
003100 END-EXEC.
* 1
006100 EXEC SQL
006200 declare applican_cur cursor for
006300 SELECT tempid, name, address, edlevel, comments
006400 FROM applicant
006500 END-EXEC
006600
006700 PROCEDURE DIVISION.
006800 PERFORM INIT
006900 PERFORM GET-ALL-ROWS UNTIL cursor-at-end = 'Y'
007000 PERFORM TERM
007100 GOBACK.
* 2
007300 INIT.
007400 DISPLAY 'STARTING PROGRAM db2crsr1'
007500 DISPLAY 'GOING TO OPEN cursor'.
007600 EXEC SQL OPEN applican_CUR END-EXEC.
007700 PERFORM FETCH-PAR.
* 3
007900 TERM.
008000 EXEC SQL CLOSE applican_CUR END-EXEC.
008500
008600 GET-ALL-ROWS.
008700 DISPLAY 'row FROM TABLE:'
008800 DISPLAY tempid, name-x, address-x,
008900 edlevel, comments
009000 PERFORM FETCH-PAR.
009100
009200 FETCH-PAR.
009300 DISPLAY 'GOING TO FETCH'
009400 move spaces to name-x, address-x, comments
009500 move zeros to edlevel
009600 EXEC SQL
009700 fetch applican_cur
009800 INTO :tempid, :name-x, :address-x, :edlevel, :comments
009900 END-EXEC
010000
010100 evaluate true
010200 when sqlcode = 0
010300* display 'successful fetch '
010400 continue
010500 when sqlcode = +100
010600 display 'cursor at end'
010700 move 'Y' to cursor-at-end
010800 when sqlcode > 0 or sqlwarn0 = 'W'
010900 perform warning-paragraph
011000 when sqlcode < 0 go to error-exit
011100 end-evaluate.
011200
030000 ERROR-EXIT.
030100* see ERROR-EXIT in the model program DB2ACD1
030200 warning-paragraph.
030300* see WARNING-PARAGRAPH in the model program DB2ACD1
Section 22: Program DB2LOD1
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'DB2LOD1'.
000300* load a db2 table
000400* optionally deletes all rows in APPLICANT
000500* inserts rows from seqfile
000550* records do not have to be in sequence, but no dup keys allowed
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900 SELECT seqfile ASSIGN seqfile.
001000
001100 DATA DIVISION.
001200 FILE SECTION.
001300 FD seqfile
001400 RECORDING MODE IS F
001500 RECORD CONTAINS 80 CHARACTERS.
001600
001700 01 seqfile-record.
001800 10 sr-TEMPID PIC 9(04).
001900 10 sr-name-x PIC X(09).
002000 10 sr-address-x PIC X(17).
002100 10 sr-EDLEVEL PIC 9(04).
002200 10 sr-COMMENTS PIC X(29).
002300 10 filler PIC x(03).
002400
002500 WORKING-STORAGE SECTION.
002600
002700 01 DISPLAY-SQLCODE PIC Z(8)9-.
002800
002900 01 SWITCHES.
003000 05 seqfile-at-end PIC X VALUE 'N'.
003100
003200 01 ERR-MESS-DATA.
003300 05 ERR-MESS-LEN PIC S9(4) BINARY VALUE +960.
003400 05 ERR-MESS-TEXT PIC X(120) OCCURS 8 TIMES
003500 INDEXED BY ERR-INDEX.
003600
003700 01 ERR-TEXT-LEN PIC S9(9) BINARY VALUE +120.
003800*
003900 EXEC SQL
004000 INCLUDE SQLCA
004100 END-EXEC.
004200
004300 EXEC SQL
004400 INCLUDE applican
004500 END-EXEC.
006900
007000 PROCEDURE DIVISION.
007100
007200 PERFORM INIT
007300* to delete all rows, remove comment indicator on next
007400* to skip deleting all rows, add comment indicator on next
007500 PERFORM delete-all-rows
007600 PERFORM load-table-from-seqfile
007700 PERFORM TERM
007800* do a rollback if you want
007900* EXEC SQL
008000* ROLLBACK
008100* END-EXEC
008200* display 'rollback done at normal goback, testing mode'
008300 GOBACK.
008400
008500 INIT.
008600 DISPLAY 'STARTING PROGRAM db2lod1'.
008700
008800 TERM.
008900
009000 delete-all-ROWS.
009100 exec sql
009200 delete from applicant
009300 end-exec
009400
009500 evaluate true
009600 when sqlcode = 0
009700 display 'successful delete'
009800* continue
009900 when sqlcode = +100
010000 display 'not found '
010050 WHEN sqlcode = -311
010060 display 'length of variable wrong'
010100 when sqlcode = -530
010200 display 'cannot delete'
010300 display 'ri - 530'
010400 when sqlcode = -532
010500 display 'cannot delete'
010600 display 'ri - 532'
010700 when sqlcode > 0 or sqlwarn0 = 'W'
010800 perform warning-paragraph
010900 when sqlcode < 0 go to error-exit
011000 end-evaluate.
011100
011200 load-table-from-seqfile.
011300 open input seqfile
011500 read seqfile
011600 at end move 'Y' to seqfile-at-end
011700 end-read
011800 perform until seqfile-at-end = 'Y'
011900 perform insert-row-from-seqfile
012000 read seqfile
012100 at end move 'Y' to seqfile-at-end
012200 end-read
012300 end-perform
012400 close seqfile.
012500
012600 insert-row-from-seqfile.
012700 display 'inserting row' seqfile-record
012800 move sr-TEMPID to tempid
012900 move 9 to name-len
013000 move sr-name-x to name-text
013100 move 17 to address-len
013200 move sr-address-x to address-text
013300 move sr-EDLEVEL to edlevel
013400 move 29 to comments-len
013500 move sr-COMMENTS to comments-text
013600
013700 exec sql
013800 insert into applicant
013850 (TEMPID, NAME, ADDRESS, EDLEVEL, COMMENTS)
013900 values (
014000 :TEMPID,
014100 :name-x,
014200 :address-x,
014300 :EDLEVEL,
014400 :COMMENTS
014500 )
014600 end-exec.
014700
014800 evaluate true
014900 when sqlcode = 0
015000 display 'successful insert'
015100* continue
015200 when sqlcode = +100
015300 display 'cursor at end'
015320 when sqlcode = -311
015340 display 'data length wrong for column'
015360 display 'ri - 311'
015400 when sqlcode = -530
015500 display 'cannot insert'
015600 display 'ri - 530'
015700 when sqlcode = -532
015800 display 'cannot insert'
015900 display 'ri - 532'
016000 when sqlcode > 0 or sqlwarn0 = 'W'
016100 perform warning-paragraph
016200 when sqlcode < 0 go to error-exit
016300 end-evaluate.
016400
016500 ERROR-EXIT.
090100* see ERROR-EXIT in the model program DB2ACD1
090200 warning-paragraph.
090300* see WARNING-PARAGRAPH in the model program DB2ACD1
Section 23: Program DB2RND1
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. 'DB2RND1'.
000300* sample cobol program
000400* Read db2 APPLICANT table randomly,
000500* based on a regular file read sequentially(TEMPID)
000600* just display the db2 rows
000700* nothing complex in this program
000800* the logic is same as regular file read sequentially
000900 ENVIRONMENT DIVISION.
001000 CONFIGURATION SECTION.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300* THIS IS AN ORDINARY SEQUENTIAL FILE:
001400 SELECT IN-FILE ASSIGN tempid.
001500 DATA DIVISION.
001600 FILE SECTION.
001700 FD IN-FILE
001800 RECORDING MODE IS F
001900 RECORD CONTAINS 80 CHARACTERS.
002000
002100 01 IN-RECORD PIC X(80).
002150 05 INPUT-tempid PIC 9(4).
002160 05 FILLER PIC X(76).
002200
002300 WORKING-STORAGE SECTION.
002400 01 display-sqlcode pic z(8)9-.
002500
002600 01 SWITCHES.
002700 05 FILE-AT-END PIC X VALUE 'N'.
002800
003300 01 ERR-MESS-DATA.
003400 05 ERR-MESS-LEN PIC S9(4) BINARY VALUE +960.
003500 05 ERR-MESS-TEXT PIC X(120) OCCURS 8 TIMES
003600 INDEXED BY ERR-INDEX.
003700 01 ERR-TEXT-LEN PIC S9(9) BINARY VALUE +120.
003800
003900* DB2 THINGS COME NEXT: SQLCA AND DECLARATIONS
004000*****************************************************************
004100* THE SQLCA IS HERE
004200 EXEC SQL
004300 INCLUDE SQLCA
004400 END-EXEC.
004500
004600 EXEC SQL
004700 INCLUDE applican
004800 END-EXEC.
007900
008000 PROCEDURE DIVISION.
008100 DISPLAY 'STARTING PROGRAM db2rnd1'.
008200
008300 PERFORM INITIALIZATION
008400 PERFORM PROCESS-ALL
008500 UNTIL FILE-AT-END = 'Y'
008600 PERFORM TERMINATION
008700 GOBACK.
008800
008900 INITIALIZATION.
009000 OPEN INPUT IN-FILE
009200 PERFORM READ-PAR.
009300
009400 PROCESS-ALL.
009500 PERFORM SINGLETON-SELECT
009600 MOVE INPUT-TEMPID TO TEMPID
009700 PERFORM READ-PAR.
009800
009900 TERMINATION.
010000 CLOSE IN-FILE.
010100
010200 READ-PAR.
010300 READ IN-FILE
010400 AT END MOVE 'Y' TO FILE-AT-END
010500 END-READ.
010600
010700 SINGLETON-SELECT.
010800 move spaces to name-x, address-x, comments
010900 move zeros to edlevel
011000* Note: this will work only when just ONE row is retrieved.
011100 EXEC SQL
011200 SELECT tempid, name, address, edlevel, comments
011300 INTO :tempid, :name-x, :address-x, :edlevel, :comments
011400 FROM applicant
011500 WHERE tempid = :tempid
011600 END-EXEC
011700
011800 evaluate true
011900 when sqlcode = 0
012000* display 'successful select'
012100 DISPLAY
012200 tempid, name-x, address-x, edlevel, comments
012300 when sqlcode = +100
012400 display 'notfound'
012500 display input-tempid
012600 when sqlcode > 0 or sqlwarn0 = 'W'
012700 perform warning-paragraph
012800 when sqlcode < 0 go to error-exit
012900 end-evaluate.
013000
013100 ERROR-EXIT.
090100* see ERROR-EXIT in the model program DB2ACD1
090200 warning-paragraph.
090300* see WARNING-PARAGRAPH in the model program DB2ACD1
Section 24: Program DB2SINGL
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ‘DB2SINGL’.
000300* Sample program for db2 embedded sql
000400* does a singleton select from ORG
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 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
* 1
002000* DB2 THINGS COME NEXT: SQLCA AND DECLARATIONS
002300 EXEC SQL
002400 INCLUDE SQLCA
002500 END-EXEC.
002600
* 2
002700 EXEC SQL
002800 INCLUDE org
002900 END-EXEC.
003000
006500
006600 PROCEDURE DIVISION.
* 3
006610* note that WHENEVER is only an example. it is not recommended.
006620* EXEC SQL
006630* WHENEVER SQLERROR GOTO ERROR-EXIT
006640* END-EXEC
006700 DISPLAY 'STARTING PROGRAM db2singl'.
006800* SAMPLE SQL STATEMENT IS NEXT
006900* note, this will work with the data supplied
007000* however in real life, be sure that the select can retrieve
007100* at most one row
007200
007300* next two moves are not really necessary
007400 move spaces to
007500 deptname-text, division-text
007600 move zeros to
007700 deptnumb, manager
007800
* 4
007900 EXEC SQL
008000 SELECT deptnumb, deptname, manager
008100 INTO :deptnumb, :deptname, :manager
008200 FROM org
008300 WHERE deptnumb = 51
008400 END-EXEC
008500
* 5
008600 evaluate true
008700 when sqlcode = 0
008800* display 'successful select'
008900 DISPLAY
009000 deptnumb, deptname-text, manager, division-text
009100 when sqlcode = +100
009200 display 'notfound'
009300 display deptnumb
009400 when sqlcode > 0 or sqlwarn0 = 'W'
009500 perform warning-paragraph
009600 when sqlcode < 0 go to error-exit
009700 end-evaluate.
009800
009900 DISPLAY 'ENDING PROGRAM'.
010000
010100 GOBACK.
010200
030000 ERROR-EXIT.
030100* see ERROR-EXIT in the model program DB2ACD1
030200 warning-paragraph.
030300* see WARNING-PARAGRAPH in the model program DB2ACD1
![[Books Computer]](http://www.theamericanprogrammer.com/pix/rwb2_line.gif)
|
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]](http://www.theamericanprogrammer.com/pix/mononena.gif)