6.2.2 SPPの例（サービスプログラム）
SPPのサービスプログラムのコーディング例を次に示します。
10 * 20 ****************************************************** 30 * SPPサービスプログラム SVR01 * 40 ****************************************************** 50 * 60 IDENTIFICATION DIVISION. 70 PROGRAM-ID. SVR01. 80 * 90 ****************************************************** 100 * データ領域の設定 * 110 ****************************************************** 120 * 130 DATA DIVISION. 140 WORKING-STORAGE SECTION. 150 01 TAM-ARG1. 160 02 REQ-CODE PIC X(4) VALUE SPACE. 170 02 STATUS-CODE PIC X(5) VALUE SPACE. 180 02 FILLER PIC X(3). 190 02 TABLE-NAME PIC X(32) VALUE SPACE. 200 02 FILLER PIC X(68). 210 02 BUF-SIZE PIC S9(4) COMP VALUE ZERO. 220 02 FILLER PIC X(398). 230 01 READ-ARG1. 240 02 DML-KIND PIC X(4) VALUE SPACE. 250 02 LOK-KIND PIC X(1) VALUE SPACE. 260 02 FILLER PIC X(3). 270 01 WRITE-ARG1. 280 02 DML-KIND PIC X(4) VALUE SPACE. 290 02 FILLER PIC X(4). 300 01 KEY-DATA1 PIC X(10) VALUE X'00000000000000000001'. 310 01 KEY-DATA2 PIC X(10) VALUE X'00000000000000000002'. 320 01 KEY-DATA4 PIC X(10) VALUE X'00000000000000000004'. 330 01 KEY-ARG. 340 02 KEYNAME PIC X(10) VALUE SPACE. 350 01 W-BUFFER. 360 02 KEYNAME PIC X(10) VALUE SPACE. 370 02 DATAREA PIC X(118) VALUE SPACE. 380 LINKAGE SECTION. 390 77 IN-DATA PIC X(118). 400 77 IN-LENG PIC S9(9) COMP. 410 77 OUT-DATA PIC X(32). 420 77 OUT-LENG PIC S9(9) COMP. 430 PROCEDURE DIVISION USING IN-DATA IN-LENG OUT-DATA OUT-LENG. 440 DISPLAY ' SVR01:PROCEDURE START' . 450 * 460 ****************************************************** 470 * TAM-READ(TAMテーブルの第1レコードを入力) * 480 ****************************************************** 490 * 500 MOVE 'tamtable30' TO TABLE-NAME OF TAM-ARG1. 510 MOVE 128 TO BUF-SIZE OF TAM-ARG1. 520 MOVE 'FCHU' TO DML-KIND OF READ-ARG1. 530 MOVE KEY-DATA1 TO KEY-ARG. 540 CALL 'CBLDCTAM' USING TAM-ARG1 READ-ARG1 KEY-ARG W-BUFFER. 550 IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN 560 DISPLAY 'SVR01:TAM-READ FAILED. CODE = ' 570 STATUS-CODE OF TAM-ARG1 580 MOVE 'SVR01: TAM READ FAILED' TO OUT-DATA 590 MOVE 22 TO OUT-LENG 600 GO TO PROG-END 610 END-IF. 620 * 630 ********************************************************** 640 * TAM-REWRITE(TAMテーブル第1レコードの入力が前提の更新) * 650 ********************************************************** 660 * 670 MOVE 'MFY ' TO DML-KIND OF WRITE-ARG1. 680 MOVE IN-DATA TO DATAREA OF W-BUFFER. 690 CALL 'CBLDCTAM' USING TAM-ARG1 WRITE-ARG1 KEY-ARG W-BUFFER. 700 IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN 710 DISPLAY 'SVR01:TAM-REWRITE FAILED. CODE = ' 720 STATUS-CODE OF TAM-ARG1 730 MOVE 'SVR01: TAM REWRITE FAILED' TO OUT-DATA 740 MOVE 25 TO OUT-LENG 750 GO TO PROG-END 760 END-IF. 770 * 780 ****************************************************** 790 * TAM-WRITE(TAMテーブルの第2レコードを更新) * 800 ****************************************************** 810 * 820 MOVE 'MFY ' TO DML-KIND OF WRITE-ARG1. 830 MOVE KEY-DATA2 TO KEY-ARG. 840 MOVE KEY-DATA2 TO KEYNAME OF W-BUFFER. 850 MOVE IN-DATA TO DATAREA OF W-BUFFER. 860 CALL 'CBLDCTAM' USING TAM-ARG1 WRITE-ARG1 KEY-ARG W-BUFFER. 870 IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN 880 DISPLAY 'SVR01:TAM-WRITE FAILED. CODE = ' 890 STATUS-CODE OF TAM-ARG1 900 MOVE 'SVR01: TAM WRITE FAILED' TO OUT-DATA 910 MOVE 23 TO OUT-LENG 920 GO TO PROG-END 930 END-IF. 940 * 950 ****************************************************** 960 * TAM-DELETE(TAMテーブルの第4レコードを削除) * 970 ****************************************************** 980 * 990 MOVE 'ERS ' TO DML-KIND OF WRITE-ARG1. 1000 MOVE KEY-DATA4 TO KEY-ARG. 1010 CALL 'CBLDCTAM' USING TAM-ARG1 WRITE-ARG1 KEY-ARG W-BUFFER. 1020 IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN 1030 DISPLAY 'SVR01:TAM-DELETE FAILED. CODE = ' 1040 STATUS-CODE OF TAM-ARG1 1050 MOVE 'SVR01: TAM DELETE FAILED' TO OUT-DATA 1060 MOVE 24 TO OUT-LENG 1070 END-IF. 1080 PROG-END. 1090 * 1100 ****************************************************** 1110 * 終了処理 * 1120 ****************************************************** 1130 * 1140 DISPLAY 'SVR01:GooD-by!'. 1150 EXIT PROGRAM.