This sample 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.
Figure 1. Sample COBOL program using SQL
statements
5722ST1 V5R4M0 060210 Create SQL COBOL Program CBLEX 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............v5r4m0 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 Minimum divide scale....0 Compiler options..........*NONE Source member changed on 07/01/96 09:44:58
5722ST1 V5R4M0 060210 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
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
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
5722ST1 V5R4M0 060210 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
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
5722ST1 V5R4M0 060210 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 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 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
Note: 8 and 9 are located on Part 5 of
this figure.
5722ST1 V5R4M0 060210 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 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-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
5722ST1 V5R4M0 060210 Create SQL COBOL Program CBLEX 08/06/02 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 * rollback 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 * * * * *
5722ST1 V5R4M0 060210 Create SQL COBOL Program CBLEX 08/06/02 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 **** COLLECTION
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
5722ST1 V5R4M0 060210 Create SQL COBOL Program CBLEX 08/06/02 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 * * * * *