2.12.3 COBOLソースプログラムのコーディング例（DMLとSQLの両方を実行するUAPの場合）
DMLを記述した埋込み型UAP（SDBデータベースにアクセスする部分のUAP）のCOBOLソースプログラムのPADチャートとコーディング例を示します。DMLとSQLの両方を実行するUAPの例です。
- 〈この項の構成〉
(1) PADチャート
UAPのPADチャートを次の図に示します。
|
|
![[図データ]](GRAPHICS/ZU021201.GIF)
![[図データ]](GRAPHICS/ZU021202.GIF)
![[図データ]](GRAPHICS/ZU021203.GIF)
![[図データ]](GRAPHICS/ZU021204.GIF)
![[図データ]](GRAPHICS/ZU021205.GIF)
![[図データ]](GRAPHICS/ZU021206.GIF)
![[図データ]](GRAPHICS/ZU021207.GIF)
![[図データ]](GRAPHICS/ZU021208.GIF)
![[図データ]](GRAPHICS/ZU021209.GIF)
![[図データ]](GRAPHICS/ZU021210.GIF)
![[図データ]](GRAPHICS/ZU021211.GIF)
![[図データ]](GRAPHICS/ZU021212.GIF)
![[図データ]](GRAPHICS/ZU021213.GIF)
![[図データ]](GRAPHICS/ZU021214.GIF)
![[図データ]](GRAPHICS/ZU021215.GIF)
(2) コーディング例
次のCOBOLソースプログラムのコーディング例を説明します。
-
DMLを記述したCOBOLソースプログラム（UAPDML01）
-
SQLを記述したCOBOLソースプログラム（UAPSQL01）
左端の番号は行番号を示しています。
■DMLを記述したCOBOLソースプログラム（UAPDML01）のコーディング例
1 IDENTIFICATION DIVISION. 2 PROGRAM-ID. UAPDML01. 3 * 4 ENVIRONMENT DIVISION. 5 * 6 INPUT-OUTPUT SECTION. 7 FILE-CONTROL. 8 SELECT O-FILE 9 ASSIGN TO './UAPDML01.log' 10 LINE SEQUENTIAL. 11 SELECT I-FILE 12 ASSIGN TO './UAPDML01.txt' 13 LINE SEQUENTIAL. 14 DATA DIVISION. 15 FILE SECTION. 16 FD O-FILE DATA RECORD OUTREC. 17 01 OUTREC PIC X(132). 18 FD I-FILE DATA RECORD INREC. 19 01 INREC PIC X(80). 20 * 21 SDB-DATABASE SECTION. - 22 SDB DATABASE01 | 23 RECORD NAME RECNAME | 1. 24 RECORD LENGTH RECLENG | 25 . - 26 * 27 WORKING-STORAGE SECTION. 28 * 29 77 EOF PIC X VALUE '0'. 30 77 ERR-FLG PIC X VALUE '0'. 31 77 TENPO_END PIC X VALUE '0'. 32 77 ZAIKO_END PIC X VALUE '0'. 33 77 TENPO_NOT_1ST PIC X VALUE '0'. 34 * 35 77 REQSQL_CNCT PIC X(4) VALUE 'CNCT'. 36 77 REQSQL_DISC PIC X(4) VALUE 'DISC'. 37 77 REQSQL_COMT PIC X(4) VALUE 'COMT'. 38 77 REQSQL_ROLB PIC X(4) VALUE 'ROLB'. 39 * 40 77 RECNAME PIC X(30) VALUE SPACE. ←2. 41 77 RECLENG PIC S9(8) COMP VALUE ZERO. ←2. 42 * 43 01 INREC_W. 44 02 IW_KUBUN PIC X. 45 02 FILLER PIC X(79). 46 01 INREC_R REDEFINES INREC_W. 47 02 IR_KUBUN PIC X. 48 02 FILLER PIC X. 49 02 IR_KSN-KUBUN PIC X. 50 02 FILLER PIC X. 51 02 IR_TENPO_CD PIC X. 52 02 FILLER PIC X. 53 02 IR_TENPO_NAME PIC X(30). 54 01 INREC_C REDEFINES INREC_W. 55 02 IC_KUBUN PIC X. 56 02 FILLER PIC X. 57 02 IC_KSN-KUBUN PIC X. 58 02 FILLER PIC X. 59 02 IC_IO-KUBUN PIC X. 60 02 FILLER PIC X. 61 02 IC_TENPOID PIC X. 62 02 FILLER PIC X. 63 02 IC_SCODE PIC X(4). 64 02 FILLER PIC X. 65 02 IC_SNAME PIC X(30). 66 02 FILLER PIC X. 67 02 IC_SCOLOR PIC X(10). 68 02 FILLER PIC X. 69 02 IC_STANKA PIC 9(10). 70 02 FILLER PIC X. 71 02 IC_SSURYO PIC 9(10). 72 * 73 01 TENPO. ←3. 74 02 RT_DBKEY. 75 03 TENPO_CD PIC X. 76 02 TENPO_NAME PIC X(30). 77 * 78 01 ZAIKO. ←4. 79 02 CH_TENPO_CD PIC X. 80 02 CH_DBKEY PIC S9(8) COMP. 81 02 SCODE PIC X(4). 82 02 SNAME PIC X(30). 83 02 SCOLOR PIC X(10). 84 02 TANKA PIC S9(8) COMP. 85 02 ZSURYO PIC S9(8) COMP. 86 * 87 01 MIDASHI. 88 02 FILLER PIC X(80) VALUE 89 '*** ZAIKO ICHIRAN ***'. 90 * 91 01 O_TENPO. 92 02 FILLER PIC X(15) VALUE ' TENPO CODE : '. 93 02 O_TENPO_CD PIC X. 94 02 FILLER PIC X(10) VALUE ', NAME : "'. 95 02 O_TENPO_NAME PIC X(30). 96 02 FILLER PIC X VALUE '"'. 97 * 98 01 O_ZAIKO. 99 02 FILLER PIC X(15) VALUE ' ZAIKO CODE : '. 100 02 O_ZAIKO_CODE PIC X(4). 101 02 FILLER PIC X(10) VALUE ', NAME : "'. 102 02 O_ZAIKO_NAME PIC X(30). 103 02 FILLER PIC X(11) VALUE '", COLOR : '. 104 02 O_ZAIKO_COLOR PIC X(10). 105 02 FILLER PIC X(10) VALUE ', TANKA : '. 106 02 O_ZAIKO_TANKA PIC ZZZZZZZZ9. 107 02 FILLER PIC X(11) VALUE ', SUURYO : '. 108 02 O_ZAIKO_SUURYO PIC ZZZZZZZZ9. 109 * 110 01 ERR_MSG. 111 02 FILLER PIC X(22) VALUE '*** ERROR SQLCODE : '. 112 02 EM_SQLCODE PIC -ZZZZZZZZ9. 113 02 FILLER PIC X(15) VALUE ', ERROR DML : "'. 114 02 EM_ERRDML PIC X(30). 115 02 FILLER PIC X(7) VALUE '" ***'. 116 * 117 PROCEDURE DIVISION. 118 MAIN SECTION. 119 M-01. 120 MOVE 0 TO RETURN-CODE. 121 OPEN OUTPUT O-FILE. 122 OPEN INPUT I-FILE. 123 M-02. 124 CALL 'UAPSQL01' USING REQSQL_CNCT. ←5. 125 IF RETURN-CODE NOT = 0 126 THEN 127 MOVE '1' TO ERR-FLG 128 ELSE 129 PERFORM DB-KOUSHIN 130 END-IF. 131 M-03. 132 EVALUATE ERR-FLG 133 WHEN '0' 134 PERFORM FUTSUU 135 WHEN '1' 136 GO TO M-EXIT 137 WHEN '2' 138 PERFORM IJYOU ←6. 139 END-EVALUATE. 140 M-04. 141 CALL 'UAPSQL01' USING REQSQL_DISC. ←7. 142 M-EXIT. 143 CLOSE O-FILE. 144 CLOSE I-FILE. 145 GOBACK. 146 * 147 DB-KOUSHIN SECTION. 148 D-01. 149 PERFORM UNTIL ( EOF = '1' OR ERR-FLG NOT = '0' ) 150 READ I-FILE 151 AT END MOVE '1' TO EOF 152 END-READ 153 IF EOF = '0' 154 THEN 155 MOVE INREC TO INREC_W 156 IF IW_KUBUN = 'R' 157 THEN 158 EVALUATE IR_KSN-KUBUN 159 WHEN 'S' 160 PERFORM TENPO-TSUIKA 161 WHEN 'E' 162 PERFORM TENPO-SAKUJO 163 END-EVALUATE 164 ELSE 165 MOVE IC_TENPOID TO TENPO_CD 166 MOVE 'D-01:FIND TENPO' TO EM_ERRDML 167 EXEC DML - 168 FIND FIRST "TENPO" WHERE ( "DBKEY" = :RT_DBKEY ) |8. 169 END-DML - 170 IF SQLCODE = 0 ←9. 171 EVALUATE IC_KSN-KUBUN 172 WHEN 'M' 173 PERFORM ZAIKO-KOUSHIN 174 WHEN 'S' 175 PERFORM ZAIKO-TSUIKA 176 WHEN 'E' 177 PERFORM ZAIKO-SAKUJO 178 END-EVALUATE 179 ELSE 180 MOVE '2' TO ERR-FLG 181 END-IF 182 END-IF 183 END-IF 184 END-PERFORM. 185 D-02. 186 IF ERR-FLG = '0' 187 THEN 188 CALL 'UAPSQL01' USING REQSQL_COMT ←10. 189 IF RETURN-CODE NOT = 0 190 THEN 191 MOVE '3' TO ERR-FLG 192 ELSE 193 CONTINUE 194 END-IF 195 ELSE 196 CONTINUE 197 END-IF. 198 D-EXIT. 199 EXIT. 200 * 201 ZAIKO-KOUSHIN SECTION. 202 M-01. 203 PERFORM ICHIDUKE. ←11. 204 IF ERR-FLG = '0' 205 THEN 206 IF IC_IO-KUBUN = '1' 207 THEN 208 COMPUTE ZSURYO = ZSURYO + IC_SSURYO ←12. 209 ELSE 210 COMPUTE ZSURYO = ZSURYO - IC_SSURYO ←12. 211 END-IF 212 MOVE 'M-01:MODIFY ZAIKO' TO EM_ERRDML 213 EXEC DML 214 MODIFY ZAIKO FROM :ZAIKO ←13. 215 END-DML 216 IF SQLCODE NOT = 0 ←9. 217 THEN 218 MOVE '2' TO ERR-FLG 219 ELSE 220 CONTINUE 221 END-IF 222 END-IF. 223 M-EXIT. 224 EXIT. 225 * 226 ZAIKO-TSUIKA SECTION. 227 S-01. 228 MOVE IC_TENPOID TO TENPO_CD. ←14. 229 MOVE 0 TO CH_DBKEY. ←15. 230 MOVE IC_SCODE TO SCODE. - 231 MOVE IC_SNAME TO SNAME. | 232 MOVE IC_SCOLOR TO SCOLOR. |14. 233 MOVE IC_STANKA TO TANKA. | 234 MOVE IC_SSURYO TO ZSURYO. - 235 S-02. 236 MOVE 'S-02:STORE ZAIKO' TO EM_ERRDML. 237 EXEC DML 238 STORE ZAIKO FROM :ZAIKO ←16. 239 END-DML. 240 IF SQLCODE NOT = 0 ←9. 241 THEN 242 MOVE '2' TO ERR-FLG 243 ELSE 244 CONTINUE 245 END-IF. 246 S-EXIT. 247 EXIT. 248 * 249 ZAIKO-SAKUJO SECTION. 250 E-01. 251 PERFORM ICHIDUKE. ←17. 252 IF ERR-FLG = '0' 253 THEN 254 MOVE 'E-01:ERASE ZAIKO' TO EM_ERRDML 255 EXEC DML 256 ERASE ZAIKO ALL ←18. 257 END-DML 258 IF SQLCODE NOT = 0 ←9. 259 THEN 260 MOVE '2' TO ERR-FLG 261 ELSE 262 CONTINUE 263 END-IF 264 END-IF. 265 E-EXIT. 266 EXIT. 267 * 268 TENPO-TSUIKA SECTION. 269 A-01. 270 MOVE IR_TENPO_CD TO TENPO_CD. ←19. 271 MOVE IR_TENPO_NAME TO TENPO_NAME. ←14. 272 MOVE 'A-01:STORE TENPO' TO EM_ERRDML 273 EXEC DML 274 STORE TENPO FROM :TENPO ←20. 275 END-DML. 276 IF SQLCODE NOT = 0 ←9. 277 THEN 278 MOVE '2' TO ERR-FLG 279 ELSE 280 CONTINUE 281 END-IF. 282 A-EXIT. 283 EXIT. 284 * 285 TENPO-SAKUJO SECTION. 286 K-01. 287 MOVE IR_TENPO_CD TO TENPO_CD. ←21. 288 MOVE 'K-01:FIND TENPO' TO EM_ERRDML 289 EXEC DML 290 FIND FOR UPDATE FIRST TENPO ←22. 291 WHERE ( "DBKEY" = :RT_DBKEY ) ←22. 292 END-DML. 293 IF SQLCODE = 0 ←9. 294 THEN 295 MOVE 'K-01:ERASE TENPO' TO EM_ERRDML 296 EXEC DML 297 ERASE TENPO ALL ←23. 298 END-DML 299 ELSE 300 CONTINUE 301 END-IF. 302 IF SQLCODE NOT = 0 ←9. 303 THEN 304 MOVE '2' TO ERR-FLG 305 ELSE 306 CONTINUE 307 END-IF. 308 K-EXIT. 309 EXIT. 310 * 311 ICHIDUKE SECTION. 312 I-01. 313 MOVE 'I-01:FETCH ZAIKO 01' TO EM_ERRDML. 314 EXEC DML 315 FETCH FOR UPDATE FIRST ZAIKO ←24. 316 INTO :ZAIKO WITHIN TENPO_ZAIKO 317 END-DML. 318 IF SQLCODE NOT = 0 ←9. 319 THEN 320 MOVE '2' TO ERR-FLG 321 ELSE 322 CONTINUE 323 END-IF. 324 PERFORM UNTIL ( IC_SCODE = SCODE OR ERR-FLG NOT = '0' ) 325 MOVE 'I-01:FETCH ZAIKO 02' TO EM_ERRDML 326 EXEC DML 327 FETCH FOR UPDATE NEXT ZAIKO ←25. 328 INTO :ZAIKO WITHIN TENPO_ZAIKO 329 END-DML 330 IF SQLCODE NOT = 0 ←9. 331 THEN 332 MOVE '2' TO ERR-FLG 333 ELSE 334 CONTINUE 335 END-IF 336 END-PERFORM. 337 I-EXIT. 338 EXIT. 339 * 340 FUTSUU SECTION. 341 F-01. 342 WRITE OUTREC FROM MIDASHI. 343 PERFORM UNTIL ( TENPO_END = '1' OR ERR-FLG NOT = '0' ) 344 MOVE 'F-01:FETCH TENPO' TO EM_ERRDML 345 IF TENPO_NOT_1ST = '0' 346 THEN 347 EXEC DML 348 FETCH FIRST TENPO INTO :TENPO ←26. 349 END-DML 350 ELSE 351 EXEC DML 352 FETCH NEXT TENPO INTO :TENPO ←27. 353 END-DML 354 END-IF 355 IF SQLCODE = 0 ←9. 356 THEN 357 MOVE TENPO_CD TO O_TENPO_CD 358 MOVE TENPO_NAME TO O_TENPO_NAME 359 WRITE OUTREC FROM O_TENPO 360 PERFORM UNTIL ( ZAIKO_END = '1' OR ERR-FLG NOT = '0' ) 361 MOVE 'F-01:FETCH ZAIKO' TO EM_ERRDML 362 EXEC DML 363 FETCH NEXT ZAIKO INTO :ZAIKO WITHIN TENPO_ZAIKO ←28. 364 END-DML 365 IF SQLCODE = 0 ←9. 366 THEN 367 MOVE SCODE TO O_ZAIKO_CODE - 368 MOVE SNAME TO O_ZAIKO_NAME | 369 MOVE SCOLOR TO O_ZAIKO_COLOR | 29. 370 MOVE TANKA TO O_ZAIKO_TANKA | 371 MOVE ZSURYO TO O_ZAIKO_SUURYO | 372 WRITE OUTREC FROM O_ZAIKO - 373 ELSE 374 IF SQLCODE = 100 - 375 THEN | 30. 376 MOVE '1' TO ZAIKO_END - 377 ELSE 378 MOVE '2' TO ERR-FLG 379 END-IF 380 END-IF 381 END-PERFORM 382 MOVE '1' TO TENPO_NOT_1ST 383 MOVE '0' TO ZAIKO_END 384 ELSE 385 IF SQLCODE = 100 - 386 THEN | 31. 387 MOVE '1' TO TENPO_END - 388 ELSE 389 MOVE '2' TO ERR-FLG 390 END-IF 391 END-IF 392 END-PERFORM. 393 F-02. 394 IF ERR-FLG NOT = '0' 395 THEN 396 CALL 'UAPSQL01' USING REQSQL_ROLB ←32. 397 ELSE 398 CONTINUE 399 END-IF. 400 F-EXIT. 401 EXIT. 402 * 403 IJYOU SECTION. 404 J-01. 405 MOVE SQLCODE TO EM_SQLCODE. ←33. 406 WRITE OUTREC FROM ERR_MSG. ←34. 407 WRITE OUTREC FROM SQLERRMC. ←35. 408 WRITE OUTREC FROM INREC ←36. 409 CALL 'UAPSQL01' USING REQSQL_ROLB. ←37. 410 J-EXIT. 411 EXIT.
［説明］
-
SDBデータベース節を指定します。
-
UAP内のDMLでアクセスするSDBデータベースを指定します。
-
DMLの実行後にレコード名を受け取る埋込み変数の名前を指定します。
-
DMLの実行後にレコード長を受け取る埋込み変数の名前を指定します。
SDBデータベース節については，「2.3 SDBデータベース節の記述」を参照してください。
-
-
次の埋込み変数を宣言します。
-
SDBデータベース節のRECORD NAMEで指定した埋込み変数
-
SDBデータベース節のRECORD LENGTHで指定した埋込み変数
SDBデータベース節で指定する埋込み変数の宣言については，「2.3.3 SDBデータベース節で指定する埋込み変数の宣言」を参照してください。
-
-
レコード型TENPOとデータの受け渡しを行う埋込み変数を宣言します。
埋込み変数の宣言については，「2.4 埋込み変数の宣言」を参照してください。
-
レコード型ZAIKOとデータの受け渡しを行う埋込み変数を宣言します。
-
HiRDBサーバに接続します。
SQLのCONNECT文を実行してHiRDBサーバに接続します。SQLのCONNECT文は，DMLを記述したUAPソースプログラムとは別のUAPソースプログラム（UAPSQL01）に記述します。
-
エラーが発生した場合，トランザクションの取り消し処理を行います。
-
HiRDBサーバから切り離します。
SQLのDISCONNECT文を実行してHiRDBサーバから切り離します。SQLのDISCONNECT文は，DMLを記述したUAPソースプログラムとは別のUAPソースプログラム（UAPSQL01）に記述します。
-
ルートレコードのデータベースキーの一致するTENPOレコードに位置指示子を位置づけます。
DML先頭子（EXEC DML）に続けてDMLを記述します。DMLの直後にDML終了子（END-DML）を記述します。
-
SQLCODEを参照してDMLの実行結果を判定します。
DMLの実行結果の判定については，「2.7 DMLの実行結果の判定処理」を参照してください。
-
データベースの更新がすべて正常に終了した場合は，SQLのCOMMIT文でトランザクションをコミットします。DMLを記述したUAPソースプログラムとは別のUAPソースプログラム（UAPSQL01）にCOMMIT文を記述します。
-
レコード実現値の変更前に，変更するレコードに対して位置指示子を位置づけます。
-
変更する構成要素に対応する埋込み変数に更新値を設定します。
-
位置づけしたZAIKOレコードのユーザデータを埋込み変数の値に変更します。
-
構成要素に対応する埋込み変数に格納するデータを設定します。
-
一連番号はHiRDB/SDが割り当てます。
-
親レコードTENPOへの位置づけ後に，子レコードZAIKOにレコード実現値を格納します。
-
レコード実現値の削除前に，削除するレコードに対して位置指示子を位置づけます。
-
位置づけしたZAIKOレコードのレコード実現値を削除します。
-
TENPOレコードはルートレコードのため，格納前にルートレコードのデータベースキーの値を埋込み変数に設定します。
-
ルートレコードのTENPOレコードを格納します。
-
キーの検索条件に指定する埋込み変数に，削除対象のルートレコードのデータベースキーの値を設定します。
-
レコード実現値の削除前に，削除するレコードに対して位置指示子を更新指定で位置づけます。削除するレコードはキーの検索条件で指定します。
-
位置指示子が位置づけられているレコード実現値を削除します。下位レコードがある場合は，下位レコードも同時に削除されます。
-
子レコードZAIKOの検索は，親レコードTENPOの位置づけ後に行います。更新指定で先頭のZAIKOレコードへの位置づけを行い，レコード実現値を埋込み変数ZAIKOに取得します。
-
現在位置づけられているZAIKOレコードの次のレコードに更新指定で位置づけを行い，レコード実現値を埋込み変数ZAIKOに取得します。
-
先頭のTENPOレコードへの位置づけを行い，レコード実現値を埋込み変数TENPOに取得します。
-
現在位置づけられているTENPOレコードの次のレコードに位置づけを行い，レコード実現値を埋込み変数TENPOに取得します。
-
ZAIKOレコードに位置づけがない場合は，先頭のZAIKOレコードに位置づけを行い，レコード実現値を埋込み変数ZAIKOに取得します。
位置づけられている場合は，位置づけられているZAIKOレコードの次のレコードに位置づけを行い，レコード実現値を埋込み変数ZAIKOに取得します。
-
埋込み変数からレコード実現値を取り出します。
-
SQLCODEが100かどうかを判定します。100の場合は，TENPOレコード下のすべてのZAIKOレコードの検索が完了しています。
-
SQLCODEが100かどうかを判定します。100の場合は，すべてのTENPOレコードの検索が完了しています。
-
SQLのROLLBACK文でトランザクションを取り消します。DMLを記述したUAPソースプログラムとは別のUAPソースプログラム（UAPSQL01）にROLLBACK文を記述します。
-
エラー要因を取得するため，SQLCODEをエラーメッセージに含めます。
-
エラーメッセージを出力します。
-
HiRDBのエラーメッセージを出力します。
-
エラーが発生した入力データを出力します。
-
トランザクションを取り消します。SQLのROLLBACK文は，DMLを記述したUAPソースプログラムとは別のUAPソースプログラム（UAPSQL01）に記述します。
■SQLを記述したCOBOLソースプログラム（UAPSQL01）のコーディング例
1 IDENTIFICATION DIVISION. 2 PROGRAM-ID. UAPSQL01. 3 * 4 ENVIRONMENT DIVISION. 5 * 6 INPUT-OUTPUT SECTION. 7 FILE-CONTROL. 8 SELECT O-FILE 9 ASSIGN TO './CT0.log' 10 LINE SEQUENTIAL. 11 DATA DIVISION. 12 FILE SECTION. 13 FD O-FILE DATA RECORD OUTREC. 14 01 OUTREC PIC X(132). 15 * 16 WORKING-STORAGE SECTION. 17 * 18 ***************************************************************** 19 *** REQCODE FOR UAPSQL01 *** 20 ***************************************************************** 21 77 REQSQL_CNCT PIC X(4) VALUE 'CNCT'. 22 77 REQSQL_DISC PIC X(4) VALUE 'DISC'. 23 77 REQSQL_COMT PIC X(4) VALUE 'COMT'. 24 77 REQSQL_ROLB PIC X(4) VALUE 'ROLB'. 25 * 26 * 27 ***************************************************************** 28 *** MESSAGE *** 29 ***************************************************************** 30 01 MSG-ERRREQ. 31 02 FILLER PIC X(80) VALUE 32 '>>> INVALID REQSQL "'. 33 02 ERRREQ PIC X(4). 34 02 FILLER PIC X(80) VALUE '" SPECIFIED'. 35 * 36 01 ERRSQL. 37 02 FILLER PIC X(28) VALUE 38 '>>> SQL ERROR, SQLCODE = "'. 39 02 ERRCODE PIC -ZZZZZZZZZ9. 40 02 FILLER PIC X(12) VALUE '", SQLSTMT "'. 41 02 ERRSTMT PIC X(4). 42 02 FILLER PIC X(1) VALUE '"'. 43 * 44 LINKAGE SECTION. 45 77 REQSQL PIC X(4). 46 * 47 PROCEDURE DIVISION USING REQSQL. ←実行するSQLのリクエストを引数で受け取ります 48 * 49 OPEN OUTPUT O-FILE. 50 * 51 MOVE REQSQL TO ERRSTMT. 52 MOVE 0 TO RETURN-CODE. 53 * 54 EVALUATE REQSQL ←リクエストで実行するSQLの振り分け 55 WHEN REQSQL_CNCT 56 PERFORM PROC-CNCT ←CONNECT処理の実行 57 WHEN REQSQL_DISC 58 PERFORM PROC-DISC ←DISCONNECT処理の実行 59 WHEN REQSQL_COMT 60 PERFORM PROC-COMT ←COMMIT処理の実行 61 WHEN REQSQL_ROLB 62 PERFORM PROC-ROLB ←ROLLBACK処理の実行 63 WHEN OTHER 64 MOVE REQSQL TO ERRREQ 65 DISPLAY MSG-ERRREQ UPON SYSOUT 66 MOVE 99 TO RETURN-CODE 67 GO TO OWARI 68 END-EVALUATE. 69 * 70 OWARI. 71 CLOSE O-FILE. 72 GOBACK. 73 * 74 ***************************************************************** 75 *** CONNECT *** 76 ***************************************************************** 77 PROC-CNCT SECTION. 78 EXEC SQL 79 CONNECT 80 END-EXEC. 81 IF SQLCODE < 0 ←SQLの実行結果の判定 82 THEN 83 MOVE SQLCODE TO ERRCODE 84 DISPLAY ERRSQL UPON SYSOUT 85 MOVE SQLCODE TO RETURN-CODE 86 ELSE 87 CONTINUE 88 END-IF. 89 ***************************************************************** 90 *** DISCONNECT *** 91 ***************************************************************** 92 PROC-DISC SECTION. 93 EXEC SQL 94 DISCONNECT 95 END-EXEC. 96 IF SQLCODE < 0 ←SQLの実行結果の判定 97 THEN 98 MOVE SQLCODE TO ERRCODE 99 DISPLAY ERRSQL UPON SYSOUT 100 MOVE SQLCODE TO RETURN-CODE 101 ELSE 102 CONTINUE 103 END-IF. 104 ***************************************************************** 105 *** COMMIT *** 106 ***************************************************************** 107 PROC-COMT SECTION. 108 EXEC SQL 109 COMMIT 110 END-EXEC. 111 IF SQLCODE < 0 ←SQLの実行結果の判定 112 THEN 113 MOVE SQLCODE TO ERRCODE 114 DISPLAY ERRSQL UPON SYSOUT 115 MOVE SQLCODE TO RETURN-CODE 116 ELSE 117 CONTINUE 118 END-IF. 119 ***************************************************************** 120 *** ROLLBACK *** 121 ***************************************************************** 122 PROC-ROLB SECTION. 123 EXEC SQL 124 ROLLBACK 125 END-EXEC. 126 IF SQLCODE < 0 ←SQLの実行結果の判定 127 THEN 128 MOVE SQLCODE TO ERRCODE 129 DISPLAY ERRSQL UPON SYSOUT 130 MOVE SQLCODE TO RETURN-CODE 131 ELSE 132 CONTINUE 133 END-IF.