[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   > Embedded SQL

Application Programming with DB2 and Embedded SQL in COBOL

This is about how to embed SQL in a COBOL program on a DB2/UDB system.

SQLCODES Cheat Sheet

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"

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 DB2SINGL

WHENEVER 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.

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 5248-067

(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