6.1.3 SPPの例（サービスプログラム）
SPPのサービスプログラムのコーディング例を次に示します。
10 * 20 ******************************************************** 30 * SPPサービスプログラム SVR01 * 40 ******************************************************** 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. SVR01. 90 * 100 ******************************************************** 110 * データ領域の設定 * 120 ******************************************************** 130 * 140 DATA DIVISION. 150 WORKING-STORAGE SECTION. 160 01 FD-ID EXTERNAL. 170 10 FD-SAVE PIC S9(9) COMP. 180 01 DAM-ARG1. 190 02 REQUEST PIC X(8) VALUE SPACE. 200 02 STATUS-CODE PIC X(5) VALUE SPACE. 210 02 FILLER PIC X(3). 220 02 FILE-NAME PIC X(8). 230 02 KEY-NO PIC S9(9) COMP VALUE ZERO. 240 02 BUFFER-LEN PIC S9(9) COMP VALUE ZERO. 250 02 FILDES PIC S9(9) COMP VALUE ZERO. 260 02 FILLER PIC X(28). 270 01 DAM-ARG2. 280 02 ACCESS-CODE PIC X(4). 290 02 FLAG1 PIC X(1). 300 02 FLAG2 PIC X(1). 310 02 FLAG3 PIC X(1). 320 02 FLAG4 PIC X(1). 330 02 FLAGS PIC S9(9) COMP VALUE ZERO. 340 02 DAMKEY. 350 03 FIRST-BLOCK-NO PIC S9(9) COMP. 360 03 LAST-BLOCK-NO PIC S9(9) COMP. 370 * 380 01 CNTL-BUFFER. 390 02 W-COUNT PIC S9(9) COMP. 400 02 RWT-DATA PIC X(18) VALUE SPACE. 410 02 FILLER PIC X(483) VALUE SPACE. 420 * 430 01 W-BUFFER. 440 02 FILLER PIC X(504). 450 * 460 LINKAGE SECTION. 470 77 IN-DATA PIC X(32). 480 77 IN-LENG PIC S9(9) COMP. 490 77 OUT-DATA PIC X(32). 500 77 OUT-LENG PIC S9(9) COMP. 510 * 520 PROCEDURE DIVISION USING IN-DATA IN-LENG OUT-DATA OUT-LENG. 530 SVR01 SECTION. 540 DISPLAY 'SVR01:PROCEDURE START' . 550 * 560 ******************************************************** 570 * DAM-READ(論理ファイルからブロックの入力) * 580 ******************************************************** 590 * 600 MOVE 'DCDAMSVC' TO REQUEST OF DAM-ARG1. 610 MOVE 'damfile0' TO FILE-NAME OF DAM-ARG1. 620 MOVE 1 TO KEY-NO OF DAM-ARG1. 630 MOVE 504 TO BUFFER-LEN OF DAM-ARG1. 640 MOVE FD-SAVE TO FILDES OF DAM-ARG1. 650 MOVE 'READ' TO ACCESS-CODE OF DAM-ARG2. 660 MOVE 'M' TO FLAG1 OF DAM-ARG2. 670 MOVE SPACE TO FLAG2 OF DAM-ARG2. 680 MOVE 0 TO FIRST-BLOCK-NO OF DAMKEY. 690 MOVE 0 TO LAST-BLOCK-NO OF DAMKEY. 700 CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2 CNTL-BUFFER. 710 IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN 720 DISPLAY 'SVR01:DAM-READ FAILED. CODE =' 730 STATUS-CODE OF DAM-ARG1 740 MOVE 'SVR01: DAM READ FAILED' TO OUT-DATA 750 MOVE 25 TO OUT-LENG 760 GO TO PROG-END 770 END-IF. 780 * 790 ******************************************************** 800 * DAM-WRITE(論理ファイルへブロックの出力) * 810 ******************************************************** 820 * 830 DAM-WRITE. 840 ADD 1 TO W-COUNT OF CNTL-BUFFER. 850 MOVE 'DCDAMSVC' TO REQUEST OF DAM-ARG1. 860 MOVE 'damfile0' TO FILE-NAME OF DAM-ARG1. 870 MOVE 1 TO KEY-NO OF DAM-ARG1. 880 MOVE 504 TO BUFFER-LEN OF DAM-ARG1. 890 MOVE FD-SAVE TO FILDES OF DAM-ARG1. 900 MOVE 'WRIT' TO ACCESS-CODE OF DAM-ARG2. 910 MOVE W-COUNT OF CNTL-BUFFER TO FIRST-BLOCK-NO OF DAMKEY. 920 MOVE 0 TO LAST-BLOCK-NO OF DAMKEY. 930 MOVE IN-DATA TO W-BUFFER. 940 CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2 W-BUFFER. 950 IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN 960 IF STATUS-CODE OF DAM-ARG1 = '01606' THEN 970 MOVE 0 TO W-COUNT OF CNTL-BUFFER 980 GO TO DAM-WRITE 990 END-IF 1000 DISPLAY 'SVR01:DAM-WRITE FAILED. CODE = ' 1010 STATUS-CODE OF DAM-ARG1 1020 MOVE 'SVR01:DAM WRITE FAILED' TO OUT-DATA 1030 MOVE 26 TO OUT-LENG 1040 GO TO PROG-END 1050 END-IF. 1060 * 1070 ******************************************************** 1080 * DAM-REWRITE(論理ファイルのブロックの更新) * 1090 ******************************************************** 1100 * 1110 MOVE 'DCDAMSVC' TO REQUEST OF DAM-ARG1. 1120 MOVE 'damfile0' TO FILE-NAME OF DAM-ARG1. 1130 MOVE 1 TO KEY-NO OF DAM-ARG1. 1140 MOVE 504 TO BUFFER-LEN OF DAM-ARG1. 1150 MOVE FD-SAVE TO FILDES OF DAM-ARG1. 1160 MOVE 'REWT' TO ACCESS-CODE OF DAM-ARG2. 1170 MOVE 'U' TO FLAG1 OF DAM-ARG2. 1180 MOVE 0 TO FIRST-BLOCK-NO OF DAMKEY. 1190 MOVE 0 TO LAST-BLOCK-NO OF DAMKEY. 1200 MOVE 'REWRITE COMPLETE' TO RWT-DATA OF CNTL-BUFFER. 1210 CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2 CNTL-BUFFER. 1220 IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN 1230 DISPLAY 'SVR01:DAM-REWRITE FAILED. CODE = ' 1240 STATUS-CODE OF DAM-ARG1 1250 MOVE 'SVR01:DAM REWRITE FAILED' TO OUT-DATA 1260 MOVE 28 TO OUT-LENG 1270 GO TO PROG-END 1280 END-IF. 1290 MOVE 'SVR01:PROCESS COMPLETE' TO OUT-DATA. 1300 MOVE 26 TO OUT-LENG. 1310 PROG-END. 1320 DISPLAY 'SVR01:Good-By!!'. 1330 END PROGRAM SVR01.