Send feedback | Rate this page

Example: SQL Statements in COBOL and ILE COBOL

Programs
Note:
Read the Code disclaimer information for important legal information.
Figure 4. Sample COBOL Program Using SQL Statements
5722ST1 V5R3M0 040528
Create SQL COBOL Program
08/06/02 11:09:13
Page
1
Source type...............COBOL
Program name..............CORPDATA/CBLEX
Source file...............CORPDATA/SRC
Member....................CBLEX
To source file............QTEMP/QSQLTEMP
Options...................*SRC
*XREF
Target release............V5R3M0
INCLUDE file..............*SRCFILE
Commit....................*CHG
Allow copy of data........*YES
Close SQL cursor..........*ENDPGM
Allow blocking............*READ
Delay PREPARE.............*NO
Generation level..........10
Printer file..............*LIBL/QSYSPRT
Date format...............*JOB
Date separator............*JOB
Time format...............*HMS
Time separator ...........*JOB
Replace...................*YES
Relational database.......*LOCAL
User .....................*CURRENT
RDB connect method........*DUW
Default collection........*NONE
Dynamic default
collection..............*NO
Package name..............*PGMLIB/*PGM
Path......................*NAMING
Created object type.......*PGM
SQL rules.................*DB2
User profile..............*NAMING
Dynamic user profile......*USER
Sort Sequence.............*JOB
Language ID...............*JOB
IBM SQL flagging..........*NOFLAG
ANS flagging..............*NONE
Text......................*SRCMBRTXT
Source file CCSID.........65535
Job CCSID.................65535
Decimal result options:
Maximum precision.......31
Maximum scale...........31

CBLEX

Minimum divide scale....0

Compiler options..........*NONE
Source member changed on 07/01/96 09:44:58
1
2
****************************************************************
3
* A sample program which updates the salaries for those
*
4
* employees whose current commission total is greater than or *
5
* equal to the value of COMMISSION. The salaries of those who *
6
* qualify are increased by the value of PERCENTAGE retroactive *
7
* to RAISE-DATE. A report is generated showing the projects
*
8
* which these employees have contributed to ordered by the
*
9
* project number and employee ID. A second report shows each
*
10
* project having an end date occurring after RAISE-DATE
*
11
* (i.e. potentially affected by the retroactive raises ) with *
12
* its total salary expenses and a count of employees who
*
13
* contributed to the project.
*
14
****************************************************************
15
16
17
IDENTIFICATION DIVISION.
18
19
PROGRAM-ID. CBLEX.
20
ENVIRONMENT DIVISION.
21
CONFIGURATION SECTION.
22
SOURCE-COMPUTER. IBM-AS400.
23
OBJECT-COMPUTER. IBM-AS400.
24
INPUT-OUTPUT SECTION.
25
26
FILE-CONTROL.
27
SELECT PRINTFILE ASSIGN TO PRINTER-QPRINT
28
ORGANIZATION IS SEQUENTIAL.
29
30
DATA DIVISION.
31
5722ST1 V5R3M0 040528
Create SQL COBOL Program
CBLEX
08/06/02 11:09:13
Page
2
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8
SEQNBR Last change
32
FILE SECTION.
33
34
FD PRINTFILE
35
BLOCK CONTAINS 1 RECORDS
36
LABEL RECORDS ARE OMITTED.
37
01 PRINT-RECORD PIC X(132).
38
39
WORKING-STORAGE SECTION.
40
77 WORK-DAYS PIC S9(4) BINARY VALUE 253.
41
77 RAISE-DATE PIC X(11) VALUE "1982-06-01".
42
77 PERCENTAGE PIC S999V99 PACKED-DECIMAL.
43
77 COMMISSION PIC S99999V99 PACKED-DECIMAL VALUE 2000.00.
44
45
***************************************************************
46
* Structure for report 1.
*
47
***************************************************************
48
49
1
01 RPT1.
50
COPY DDS-PROJECT OF CORPDATA-PROJECT.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

05
05
05

EMPNO
NAME
SALARY

PIC X(6).
PIC X(30).
PIC S9(6)V99 PACKED-DECIMAL.

***************************************************************
* Structure for report 2.
*
***************************************************************
01

RPT2.
15 PROJNO PIC X(6).
15 PROJECT-NAME PIC X(36).
15 EMPLOYEE-COUNT PIC S9(4) BINARY.
15 TOTAL-PROJ-COST PIC S9(10)V99 PACKED-DECIMAL.
2

77

EXEC SQL
INCLUDE SQLCA
END-EXEC.
CODE-EDIT PIC ---99.

***************************************************************
* Headers for reports.
*
***************************************************************
01

01

01

RPT1-HEADERS.
05 RPT1-HEADER1.
10 FILLER PIC X(21) VALUE SPACES.
10 FILLER PIC X(111)
VALUE "REPORT OF PROJECTS AFFECTED BY RAISES".
05 RPT1-HEADER2.
10 FILLER PIC X(9) VALUE "PROJECT".
10 FILLER PIC X(10) VALUE "EMPID".
10 FILLER PIC X(35) VALUE "EMPLOYEE NAME".
10 FILLER PIC X(40) VALUE "SALARY".
RPT2-HEADERS.
05 RPT2-HEADER1.
10 FILLER PIC X(21) VALUE SPACES.
10 FILLER PIC X(111)
VALUE "ACCUMULATED STATISTICS BY PROJECT".
05 RPT2-HEADER2.
10 FILLER PIC X(9) VALUE "PROJECT".
10 FILLER PIC X(38) VALUE SPACES.
10 FILLER PIC X(16) VALUE "NUMBER OF".
10 FILLER PIC X(10) VALUE "TOTAL".
05 RPT2-HEADER3.
10 FILLER PIC X(9) VALUE "NUMBER".
10 FILLER PIC X(38) VALUE "PROJECT NAME".
10 FILLER PIC X(16) VALUE "EMPLOYEES".
10 FILLER PIC X(65) VALUE "COST".
RPT1-DATA.
05 PROJNO
PIC X(6).
05 FILLER
PIC XXX VALUE SPACES.
05 EMPNO
PIC X(6).
05 FILLER
PIC X(4) VALUE SPACES.
05 NAME
PIC X(30).
05 FILLER
PIC X(3) VALUE SPACES.
05 SALARY
PIC ZZZZZ9.99.

108
05 FILLER
PIC X(96) VALUE SPACES.
5722ST1 V5R3M0 040528
Create SQL COBOL Program
CBLEX
08/06/02 11:09:13
Page
3
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8
SEQNBR Last change
109
01 RPT2-DATA.
110
05 PROJNO PIC X(6).
111
05 FILLER PIC XXX VALUE SPACES.
112
05 PROJECT-NAME PIC X(36).
113
05 FILLER PIC X(4) VALUE SPACES.
114
05 EMPLOYEE-COUNT PIC ZZZ9.
115
05 FILLER PIC X(5) VALUE SPACES.
116
05 TOTAL-PROJ-COST PIC ZZZZZZZZ9.99.
117
05 FILLER PIC X(56) VALUE SPACES.
118
119
PROCEDURE DIVISION.
120
121
A000-MAIN.
122
MOVE 1.04 TO PERCENTAGE.
123
OPEN OUTPUT PRINTFILE.
124
125
***************************************************************
126
* Update the selected employees by the new percentage. If an *
127
* error occurs during the update, ROLLBACK the changes,
*
128
***************************************************************
129
130
3 EXEC SQL
131
WHENEVER SQLERROR GO TO E010-UPDATE-ERROR
132
END-EXEC.
133
4 EXEC SQL
134
UPDATE CORPDATA/EMPLOYEE
135
SET SALARY = SALARY * :PERCENTAGE
136
WHERE COMM >= :COMMISSION
137
END-EXEC.
138
139
***************************************************************
140
* Commit changes.
*
141
***************************************************************
142
143
5 EXEC SQL
144
COMMIT
145
END-EXEC.
146
147
EXEC SQL
148
WHENEVER SQLERROR GO TO E020-REPORT-ERROR
149
END-EXEC.
150
151
***************************************************************
152
* Report the updated statistics for each employee receiving *
153
* a raise and the projects that s/he participates in
*
154
***************************************************************
155
156
***************************************************************
157
* Write out the header for Report 1.
*
158
***************************************************************
159
160
write print-record from rpt1-header1

161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
EXIT
178
179

before advancing 2 lines.

write print-record from rpt1-header2
before advancing 1 line.
6 exec sql
declare c1 cursor for
SELECT DISTINCT projno, empprojact.empno,
lastname||", "||firstnme ,salary
from corpdata/empprojact, corpdata/employee
where empprojact.empno =employee.empno and
comm >= :commission
order by projno, empno
end-exec.
7 EXEC SQL
OPEN C1
END-EXEC.
PERFORM B000-GENERATE-REPORT1 THRU B010-GENERATE-REPORT1UNTIL SQLCODE NOT EQUAL TO ZERO.

Note:
8 and 9 are located on Part 5 of this figure.
5722ST1 V5R3M0 040528
Create SQL COBOL Program
CBLEX
08/06/02 11:09:13
Page
4
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8
SEQNBR Last change
180
10 A100-DONE1.
181
EXEC SQL
182
CLOSE C1
183
END-EXEC.
184
185
*************************************************************
186
* For all projects ending at a date later than the RAISE- *
187
* DATE ( i.e. those projects potentially affected by the
*
188
* salary raises generate a report containing the project
*
189
* project number, project name, the count of employees
*
190
* participating in the project and the total salary cost
*
191
* for the project
*
192
*************************************************************
193
194
195
***************************************************************
196
* Write out the header for Report 2.
*
197
***************************************************************
198
199
MOVE SPACES TO PRINT-RECORD.
200
WRITE PRINT-RECORD BEFORE ADVANCING 2 LINES.
201
WRITE PRINT-RECORD FROM RPT2-HEADER1
202
BEFORE ADVANCING 2 LINES.
203
WRITE PRINT-RECORD FROM RPT2-HEADER2
204
BEFORE ADVANCING 1 LINE.
205
WRITE PRINT-RECORD FROM RPT2-HEADER3
206
BEFORE ADVANCING 2 LINES.
207
208
EXEC SQL
209
11 DECLARE C2 CURSOR FOR

210
SELECT EMPPROJACT.PROJNO, PROJNAME, COUNT(*),
211
SUM ( (DAYS(EMENDATE)-DAYS(EMSTDATE)) *
212
EMPTIME * DECIMAL((SALARY / :WORK-DAYS),8,2))
213
FROM CORPDATA/EMPPROJACT, CORPDATA/PROJECT,
214
CORPDATA/EMPLOYEE
215
WHERE EMPPROJACT.PROJNO=PROJECT.PROJNO AND
216
EMPPROJACT.EMPNO =EMPLOYEE.EMPNO AND
217
PRENDATE > :RAISE-DATE
218
GROUP BY EMPPROJACT.PROJNO, PROJNAME
219
ORDER BY 1
220
END-EXEC.
221
EXEC SQL
222
OPEN C2
223
END-EXEC.
224
225
PERFORM C000-GENERATE-REPORT2 THRU C010-GENERATE-REPORT2EXIT
226
UNTIL SQLCODE NOT EQUAL TO ZERO.
227
228
A200-DONE2.
229
EXEC SQL
230
CLOSE C2
231
END-EXEC
232
233
***************************************************************
234
* All done.
*
235
***************************************************************
236
237
A900-MAIN-EXIT.
238
CLOSE PRINTFILE.
239
STOP RUN.
240
5722ST1 V5R3M0 040528
Create SQL COBOL Program
CBLEX
08/06/02 11:09:13
Page
5
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
...+... 8
SEQNBR Last change
241
***************************************************************
242
* Fetch and write the rows to PRINTFILE.
*
243
***************************************************************
244
245
B000-GENERATE-REPORT1.
246
8 EXEC SQL
247
WHENEVER NOT FOUND GO TO A100-DONE1
248
END-EXEC.
249
9 EXEC SQL
250
FETCH C1 INTO :PROJECT.PROJNO, :RPT1.EMPNO,
251
:RPT1.NAME, :RPT1.SALARY
252
END-EXEC.
253
MOVE CORRESPONDING RPT1 TO RPT1-DATA.
254
MOVE PROJNO OF RPT1 TO PROJNO OF RPT1-DATA.
255
WRITE PRINT-RECORD FROM RPT1-DATA
256
BEFORE ADVANCING 1 LINE.
257
258
B010-GENERATE-REPORT1-EXIT.
259
EXIT.
260
261
***************************************************************

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
SQLCODE
305
306
307

* Fetch and write the rows to PRINTFILE.

*
***************************************************************
C000-GENERATE-REPORT2.
EXEC SQL
WHENEVER NOT FOUND GO TO A200-DONE2
END-EXEC.
12 EXEC SQL
FETCH C2 INTO :RPT2
END-EXEC.
MOVE CORRESPONDING RPT2 TO RPT2-DATA.
WRITE PRINT-RECORD FROM RPT2-DATA
BEFORE ADVANCING 1 LINE.
C010-GENERATE-REPORT2-EXIT.
EXIT.
***************************************************************
* Error occured while updating table. Inform user and
*
* rollback changes.
*
***************************************************************
E010-UPDATE-ERROR.
13 EXEC SQL
WHENEVER SQLERROR CONTINUE
END-EXEC.
MOVE SQLCODE TO CODE-EDIT.
STRING "*** ERROR Occurred while updating table. SQLCODE="
CODE-EDIT DELIMITED BY SIZE INTO PRINT-RECORD.
WRITE PRINT-RECORD.
14 EXEC SQL
ROLLBACK
END-EXEC.
STOP RUN.
***************************************************************
* Error occured while generating reports. Inform user and
*
* exit.
*
***************************************************************
E020-REPORT-ERROR.
MOVE SQLCODE TO CODE-EDIT.
STRING "*** ERROR Occurred while generating reports.

"=" CODE-EDIT
WRITE PRINT-RECORD.
STOP RUN.
* * * *
5722ST1 V5R3M0 040528
Create
08/06/02 11:09:13
Page
6
CROSS REFERENCE
Data Names
Define
ACTNO
168
(NOT NULL) IN CORPDATA.EMPPROJACT
A100-DONE1
****
A200-DONE2

****

DELIMITED BY SIZE INTO PRINT-RECORD.

* E N D O F S O U R C E * * * * *
SQL COBOL Program
CBLEX
Reference
SMALL INTEGER PRECISION(4,0) COLUMN
LABEL
247
LABEL

267
DATE(10) COLUMN IN CORPDATA.EMPLOYEE
DECIMAL(9,2) COLUMN IN

BIRTHDATE
BONUS
CORPDATA.EMPLOYEE
CODE-EDIT
COMM

134
134

COMM
CORPDATA.EMPLOYEE
COMMISSION

134

CORPDATA

****

C1

165

C2

209

DEPTNO
DEPTNO
CORPDATA.PROJECT
EDLEVEL
(NOT NULL) IN CORPDATA.EMPLOYEE
EMENDATE
CORPDATA.EMPPROJACT
EMENDATE

50
213

DECIMAL(7,2)
136 170
COLLECTION
134 168 168 213 213 214
CURSOR
174 182 250
CURSOR
222 230 270
CHARACTER(3) IN PROJECT
CHARACTER(3) COLUMN (NOT NULL) IN

134

SMALL INTEGER PRECISION(4,0) COLUMN

168

DATE(10) COLUMN IN

****

EMPLOYEE

****

EMPLOYEE

****

EMPLOYEE-COUNT
EMPLOYEE-COUNT
EMPNO

63
114
51

EMPNO
EMPNO
CORPDATA.EMPLOYEE
EMPNO

103
134

COLUMN
211
TABLE IN CORPDATA
134 168 214
TABLE
169 216
SMALL INTEGER PRECISION(4,0) IN RPT2
IN RPT2-DATA
CHARACTER(6) IN RPT1
250
CHARACTER(6) IN RPT1-DATA
CHARACTER(6) COLUMN (NOT NULL) IN

EMPNO

****

EMPNO
CORPDATA.EMPPROJACT
EMPPROJACT

168

EMPPROJACT

****

EMPTIME
CORPDATA.EMPPROJACT
EMPTIME

168

EMSTDATE
CORPDATA.EMPPROJACT
EMSTDATE

168

E010-UPDATE-ERROR

****

69
****

43

****

****

****

****

COLUMN
136 170
DECIMAL(9,2) COLUMN IN

COLUMN IN EMPPROJACT
166 169 171 216
COLUMN IN EMPLOYEE
169 216
CHARACTER(6) COLUMN (NOT NULL) IN
TABLE
166 169 210 215 216 218
TABLE IN CORPDATA
168 213
DECIMAL(5,2) COLUMN IN
COLUMN
212
DATE(10) COLUMN IN
COLUMN
211
LABEL
131

E020-REPORT-ERROR

****

FIRSTNME
CORPDATA.EMPLOYEE
FIRSTNME

134

HIREDATE
JOB
CORPDATA.EMPLOYEE
LASTNAME
CORPDATA.EMPLOYEE
LASTNAME

134
134

COLUMN
167
DATE(10) COLUMN IN CORPDATA.EMPLOYEE
CHARACTER(8) COLUMN IN

134

VARCHAR(15) COLUMN (NOT NULL) IN

****

MAJPROJ
MAJPROJ
CORPDATA.PROJECT
MIDINIT
CORPDATA.EMPLOYEE
NAME

50
213

COLUMN
167
CHARACTER(6) IN PROJECT
CHARACTER(6) COLUMN IN

134

CHARACTER(1) COLUMN (NOT NULL) IN

NAME
5722ST1 V5R3M0 040528
08/06/02 11:09:13
Page
CROSS REFERENCE
PERCENTAGE

****

LABEL
148
VARCHAR(12) COLUMN (NOT NULL) IN

52

CHARACTER(30) IN RPT1
251
105
CHARACTER(30) IN RPT1-DATA
Create SQL COBOL Program
CBLEX
7
42

PHONENO
CORPDATA.EMPLOYEE
PRENDATE
PRENDATE

134

PRENDATE
PRINT-RECORD
PROJECT
PROJECT

213
37
50
****

PROJECT

****

PROJECT-NAME
PROJECT-NAME
PROJNAME
PROJNAME

62
112
50
****

PROJNAME
CORPDATA.PROJECT
PROJNO

213

PROJNO
PROJNO
PROJNO
PROJNO

61
101
110
****

PROJNO
CORPDATA.EMPPROJACT
PROJNO

168

PROJNO

****

50
****

50

****

DECIMAL(5,2)
135
CHARACTER(4) COLUMN IN
DATE(10) IN PROJECT
COLUMN
217
DATE(10) COLUMN IN CORPDATA.PROJECT
CHARACTER(132)
STRUCTURE IN RPT1
TABLE IN CORPDATA
213
TABLE
215
CHARACTER(36) IN RPT2
CHARACTER(36) IN RPT2-DATA
VARCHAR(24) IN PROJECT
COLUMN
210 218
VARCHAR(24) COLUMN (NOT NULL) IN
CHARACTER(6)
250
CHARACTER(6)
CHARACTER(6)
CHARACTER(6)
COLUMN
166 171
CHARACTER(6)

IN PROJECT
IN RPT2
IN RPT1-DATA
IN RPT2-DATA
COLUMN (NOT NULL) IN

COLUMN IN EMPPROJACT
210 215 218
COLUMN IN PROJECT

PROJNO
CORPDATA.PROJECT
PRSTAFF
PRSTAFF
CORPDATA.PROJECT
PRSTDATE
PRSTDATE
RAISE-DATE

213

215
CHARACTER(6) COLUMN (NOT NULL) IN

50
213

DECIMAL(5,2) IN PROJECT
DECIMAL(5,2) COLUMN IN

50
213
41

RESPEMP
RESPEMP
CORPDATA.PROJECT
RPT1
RPT1-DATA
RPT1-HEADERS
RPT1-HEADER1
RPT1-HEADER2
RPT2

50
213

DATE(10) IN PROJECT
DATE(10) COLUMN IN CORPDATA.PROJECT
CHARACTER(11)
217
CHARACTER(6) IN PROJECT
CHARACTER(6) COLUMN (NOT NULL) IN

RPT2-DATA
SS REFERENCE
RPT2-HEADERS
RPT2-HEADER1
RPT2-HEADER2
RPT2-HEADER3
SALARY

109

SALARY
SALARY

107
****

SALARY
CORPDATA.EMPLOYEE
SEX
CORPDATA.EMPLOYEE
TOTAL-PROJ-COST
TOTAL-PROJ-COST
WORK-DAYS

134

IN RPT2-HEADERS
IN RPT2-HEADERS
IN RPT2-HEADERS
DECIMAL(8,2) IN RPT1
251
IN RPT1-DATA
COLUMN
135 135 167 212
DECIMAL(9,2) COLUMN IN

134

CHARACTER(1) COLUMN IN

64
116
40

WORKDEPT
CORPDATA.EMPLOYEE
No errors found in source
307 Source records processed

134

DECIMAL(12,2) IN RPT2
IN RPT2-DATA
SMALL INTEGER PRECISION(4,0)
212
CHARACTER(3) COLUMN IN

49
100
75
76
80
60

85
86
90
95
53

* * * * *

IN RPT1-HEADERS
IN RPT1-HEADERS
STRUCTURE
270

E N D

O F

L I S T I N G

* * * * *

___________________-

************* Program Start **************** IDENTIFICATION DIVISION.

PROGRAM-ID. TESTSQL. ENVIRONMENT DIVISION. CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. SPECIALNAMES. SYSOUT IS SYS-LST. DATA DIVISION. WORKING-STORAGE SECTION. 77
DSPSQLCODE PIC ------99. 77 STMT1 PIC X(100) VALUE "DELETE FROM MYFILE
WHERE MYFIELD < ""6126""". 77 STMT2 PIC X(100) VALUE "DELETE FROM MYFILE2
WHERE MYFIELD2 = ""35""". 77 STMTSTRING PIC X(100). EXEC SQL INCLUDE
SQLCA END-EXEC. PROCEDURE DIVISION. 000-PROGRAM-START. EXEC SQL

WHENEVER SQLERROR GO TO 900-SQL-ERROR END-EXEC. MOVE STMT1 TO

STMTSTRING. PERFORM 100-EXEC-SQL. MOVE STMT2 TO STMTSTRING. PERFORM
100-EXEC-SQL. GOBACK. 100-EXEC-SQL. EXEC SQL EXECUTE IMMEDIATE
:STMTSTRING END-EXEC. 900-SQL-ERROR. MOVE SQLCODE TO DSPSQLCODE.
DISPLAY "SQL ERROR - ERROR:" DSPSQLCODE " STATE:" SQLSTATE UPON SYS-LST.
GOBACK. ************* Program End ******************
Read more at: http://archive.midrange.com/cobol400-l/200401/msg00015.html midrange.com