Example: SQL statements in COBOL and ILE COBOL programs
This example program is written in the COBOL programming language.
Note: By using the code examples, you agree to the terms
of the Code license and disclaimer information.
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 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............VxRxMx
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
SQL rules.................*DB2
Created object type.......*PGM
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
Minimum divide scale....0
DECFLOAT rounding mode....*HALFEVEN
Compiler options..........*NONE
Source member changed on 07/01/96 09:44:58
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 2
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 SEQNBR Last change
1
2 ****************************************************************
3 * A sample program that 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 * that 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 * (that is, potentially affected by the retroactive raises ) *
12 * with its total salary expenses and a count of employees *
13 * who 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
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 05 EMPNO PIC X(6).
52 05 NAME PIC X(30).
53 05 SALARY PIC S9(6)V99 PACKED-DECIMAL.
54
55
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 3
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 SEQNBR Last change
56 ***************************************************************
57 * Structure for report 2. *
58 ***************************************************************
59
60 01 RPT2.
61 15 PROJNO PIC X(6).
62 15 PROJECT-NAME PIC X(36).
63 15 EMPLOYEE-COUNT PIC S9(4) BINARY.
64 15 TOTAL-PROJ-COST PIC S9(10)V99 PACKED-DECIMAL.
65
66 2 EXEC SQL
67 INCLUDE SQLCA
68 END-EXEC.
69 77 CODE-EDIT PIC ---99.
70
71 ***************************************************************
72 * Headers for reports. *
73 ***************************************************************
74
75 01 RPT1-HEADERS.
76 05 RPT1-HEADER1.
77 10 FILLER PIC X(21) VALUE SPACES.
78 10 FILLER PIC X(111)
79 VALUE "REPORT OF PROJECTS AFFECTED BY RAISES".
80 05 RPT1-HEADER2.
81 10 FILLER PIC X(9) VALUE "PROJECT".
82 10 FILLER PIC X(10) VALUE "EMPID".
83 10 FILLER PIC X(35) VALUE "EMPLOYEE NAME".
84 10 FILLER PIC X(40) VALUE "SALARY".
85 01 RPT2-HEADERS.
86 05 RPT2-HEADER1.
87 10 FILLER PIC X(21) VALUE SPACES.
88 10 FILLER PIC X(111)
89 VALUE "ACCUMULATED STATISTICS BY PROJECT".
90 05 RPT2-HEADER2.
91 10 FILLER PIC X(9) VALUE "PROJECT".
92 10 FILLER PIC X(38) VALUE SPACES.
93 10 FILLER PIC X(16) VALUE "NUMBER OF".
94 10 FILLER PIC X(10) VALUE "TOTAL".
95 05 RPT2-HEADER3.
96 10 FILLER PIC X(9) VALUE "NUMBER".
97 10 FILLER PIC X(38) VALUE "PROJECT NAME".
98 10 FILLER PIC X(16) VALUE "EMPLOYEES".
99 10 FILLER PIC X(65) VALUE "COST".
100 01 RPT1-DATA.
101 05 PROJNO PIC X(6).
102 05 FILLER PIC XXX VALUE SPACES.
103 05 EMPNO PIC X(6).
104 05 FILLER PIC X(4) VALUE SPACES.
105 05 NAME PIC X(30).
106 05 FILLER PIC X(3) VALUE SPACES.
107 05 SALARY PIC ZZZZZ9.99.
108 05 FILLER PIC X(96) VALUE SPACES.
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
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 4
Record *...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 SEQNBR Last change
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, roll back 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 the employee participates in *
154 ***************************************************************
155
156 ***************************************************************
157 * Write out the header for Report 1. *
158 ***************************************************************
159
160 write print-record from rpt1-header1
161 before advancing 2 lines.
162 write print-record from rpt1-header2
163 before advancing 1 line.
164 6 exec sql
165 declare c1 cursor for
166 SELECT DISTINCT projno, empprojact.empno,
167 lastname||", "||firstnme ,salary
168 from corpdata/empprojact, corpdata/employee
169 where empprojact.empno =employee.empno and
170 comm >= :commission
171 order by projno, empno
172 end-exec.
173 7 EXEC SQL
174 OPEN C1
175 END-EXEC.
176
177 PERFORM B000-GENERATE-REPORT1 THRU B010-GENERATE-REPORT1-EXIT
178 UNTIL SQLCODE NOT EQUAL TO ZERO.
179
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 5
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 (that is, those projects potentially affected by the*
188 * salary raises), generate a report containing the project *
189 * 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-REPORT2-EXIT
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
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 6
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 * Fetch and write the rows to PRINTFILE. *
263 ***************************************************************
264
265 C000-GENERATE-REPORT2.
266 EXEC SQL
267 WHENEVER NOT FOUND GO TO A200-DONE2
268 END-EXEC.
269 12 EXEC SQL
270 FETCH C2 INTO :RPT2
271 END-EXEC.
272 MOVE CORRESPONDING RPT2 TO RPT2-DATA.
273 WRITE PRINT-RECORD FROM RPT2-DATA
274 BEFORE ADVANCING 1 LINE.
275
276 C010-GENERATE-REPORT2-EXIT.
277 EXIT.
278
279 ***************************************************************
280 * Error occurred while updating table. Inform user and *
281 * roll back changes. *
282 ***************************************************************
283
284 E010-UPDATE-ERROR.
285 13 EXEC SQL
286 WHENEVER SQLERROR CONTINUE
287 END-EXEC.
288 MOVE SQLCODE TO CODE-EDIT.
289 STRING "*** ERROR Occurred while updating table. SQLCODE="
290 CODE-EDIT DELIMITED BY SIZE INTO PRINT-RECORD.
291 WRITE PRINT-RECORD.
292 14 EXEC SQL
293 ROLLBACK
294 END-EXEC.
295 STOP RUN.
296
297 ***************************************************************
298 * Error occurred while generating reports. Inform user and *
299 * exit. *
300 ***************************************************************
301
302 E020-REPORT-ERROR.
303 MOVE SQLCODE TO CODE-EDIT.
304 STRING "*** ERROR Occurred while generating reports. SQLCODE
305 - "=" CODE-EDIT DELIMITED BY SIZE INTO PRINT-RECORD.
306 WRITE PRINT-RECORD.
307 STOP RUN.
* * * * * E N D O F S O U R C E * * * * *xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 7
CROSS REFERENCE
Data Names Define Reference
ACTNO 168 SMALL INTEGER PRECISION(4,0) COLUMN (NOT NULL) IN CORPDATA.EMPPROJACT
A100-DONE1 **** LABEL
247
A200-DONE2 **** LABEL
267
BIRTHDATE 134 DATE(10) COLUMN IN CORPDATA.EMPLOYEE
BONUS 134 DECIMAL(9,2) COLUMN IN CORPDATA.EMPLOYEE
CODE-EDIT 69
COMM **** COLUMN
136 170
COMM 134 DECIMAL(9,2) COLUMN IN CORPDATA.EMPLOYEE
COMMISSION 43 DECIMAL(7,2)
136 170
CORPDATA **** SCHEMA
134 168 168 213 213 214
C1 165 CURSOR
174 182 250
C2 209 CURSOR
222 230 270
DEPTNO 50 CHARACTER(3) IN PROJECT
DEPTNO 213 CHARACTER(3) COLUMN (NOT NULL) IN CORPDATA.PROJECT
EDLEVEL 134 SMALL INTEGER PRECISION(4,0) COLUMN (NOT NULL) IN CORPDATA.EMPLOYEE
EMENDATE 168 DATE(10) COLUMN IN CORPDATA.EMPPROJACT
EMENDATE **** COLUMN
211
EMPLOYEE **** TABLE IN CORPDATA
134 168 214
EMPLOYEE **** TABLE
169 216
EMPLOYEE-COUNT 63 SMALL INTEGER PRECISION(4,0) IN RPT2
EMPLOYEE-COUNT 114 IN RPT2-DATA
EMPNO 51 CHARACTER(6) IN RPT1
250
EMPNO 103 CHARACTER(6) IN RPT1-DATA
EMPNO 134 CHARACTER(6) COLUMN (NOT NULL) IN CORPDATA.EMPLOYEE
EMPNO **** COLUMN IN EMPPROJACT
166 169 171 216
EMPNO **** COLUMN IN EMPLOYEE
169 216
EMPNO 168 CHARACTER(6) COLUMN (NOT NULL) IN CORPDATA.EMPPROJACT
EMPPROJACT **** TABLE
166 169 210 215 216 218
EMPPROJACT **** TABLE IN CORPDATA
168 213
EMPTIME 168 DECIMAL(5,2) COLUMN IN CORPDATA.EMPPROJACT
EMPTIME **** COLUMN
212
EMSTDATE 168 DATE(10) COLUMN IN CORPDATA.EMPPROJACT
EMSTDATE **** COLUMN
211
E010-UPDATE-ERROR **** LABEL
131
E020-REPORT-ERROR **** LABEL
148
FIRSTNME 134 VARCHAR(12) COLUMN (NOT NULL) IN CORPDATA.EMPLOYEE
FIRSTNME **** COLUMN
167
HIREDATE 134 DATE(10) COLUMN IN CORPDATA.EMPLOYEE
JOB 134 CHARACTER(8) COLUMN IN CORPDATA.EMPLOYEE
LASTNAME 134 VARCHAR(15) COLUMN (NOT NULL) IN CORPDATA.EMPLOYEE
LASTNAME **** COLUMN
167
MAJPROJ 50 CHARACTER(6) IN PROJECT
MAJPROJ 213 CHARACTER(6) COLUMN IN CORPDATA.PROJECT
MIDINIT 134 CHARACTER(1) COLUMN (NOT NULL) IN CORPDATA.EMPLOYEE
NAME 52 CHARACTER(30) IN RPT1
251
NAME 105 CHARACTER(30) IN RPT1-DATA
xxxxST1 VxRxMx yymmdd Create SQL COBOL Program CBLEX 08/06/07 11:09:13 Page 8
CROSS REFERENCE
PERCENTAGE 42 DECIMAL(5,2)
135
PHONENO 134 CHARACTER(4) COLUMN IN CORPDATA.EMPLOYEE
PRENDATE 50 DATE(10) IN PROJECT
PRENDATE **** COLUMN
217
PRENDATE 213 DATE(10) COLUMN IN CORPDATA.PROJECT
PRINT-RECORD 37 CHARACTER(132)
PROJECT 50 STRUCTURE IN RPT1
PROJECT **** TABLE IN CORPDATA
213
PROJECT **** TABLE
215
PROJECT-NAME 62 CHARACTER(36) IN RPT2
PROJECT-NAME 112 CHARACTER(36) IN RPT2-DATA
PROJNAME 50 VARCHAR(24) IN PROJECT
PROJNAME **** COLUMN
210 218
PROJNAME 213 VARCHAR(24) COLUMN (NOT NULL) IN CORPDATA.PROJECT
PROJNO 50 CHARACTER(6) IN PROJECT
250
PROJNO 61 CHARACTER(6) IN RPT2
PROJNO 101 CHARACTER(6) IN RPT1-DATA
PROJNO 110 CHARACTER(6) IN RPT2-DATA
PROJNO **** COLUMN
166 171
PROJNO 168 CHARACTER(6) COLUMN (NOT NULL) IN CORPDATA.EMPPROJACT
PROJNO **** COLUMN IN EMPPROJACT
210 215 218
PROJNO **** COLUMN IN PROJECT
215
PROJNO 213 CHARACTER(6) COLUMN (NOT NULL) IN CORPDATA.PROJECT
PRSTAFF 50 DECIMAL(5,2) IN PROJECT
PRSTAFF 213 DECIMAL(5,2) COLUMN IN CORPDATA.PROJECT
PRSTDATE 50 DATE(10) IN PROJECT
PRSTDATE 213 DATE(10) COLUMN IN CORPDATA.PROJECT
RAISE-DATE 41 CHARACTER(11)
217
RESPEMP 50 CHARACTER(6) IN PROJECT
RESPEMP 213 CHARACTER(6) COLUMN (NOT NULL) IN CORPDATA.PROJECT
RPT1 49
RPT1-DATA 100
RPT1-HEADERS 75
RPT1-HEADER1 76 IN RPT1-HEADERS
RPT1-HEADER2 80 IN RPT1-HEADERS
RPT2 60 STRUCTURE
270
RPT2-DATA 109
SS REFERENCE
RPT2-HEADERS 85
RPT2-HEADER1 86 IN RPT2-HEADERS
RPT2-HEADER2 90 IN RPT2-HEADERS
RPT2-HEADER3 95 IN RPT2-HEADERS
SALARY 53 DECIMAL(8,2) IN RPT1
251
SALARY 107 IN RPT1-DATA
SALARY **** COLUMN
135 135 167 212
SALARY 134 DECIMAL(9,2) COLUMN IN CORPDATA.EMPLOYEE
SEX 134 CHARACTER(1) COLUMN IN CORPDATA.EMPLOYEE
TOTAL-PROJ-COST 64 DECIMAL(12,2) IN RPT2
TOTAL-PROJ-COST 116 IN RPT2-DATA
WORK-DAYS 40 SMALL INTEGER PRECISION(4,0)
212
WORKDEPT 134 CHARACTER(3) COLUMN IN CORPDATA.EMPLOYEE
No errors found in source
307 Source records processed
* * * * * E N D O F L I S T I N G * * * * *