6.1.2 SPPの例（メインプログラム）
SPPのメインプログラムのコーディング例を次に示します。
10 * 20 ******************************************************** 30 * SPP01 メインプログラム * 40 ******************************************************** 50 * 60 IDENTIFICATION DIVISION. 70 * 80 PROGRAM-ID. MAIN. 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 RPC-ARG1. 190 02 REQ-CODE PIC X(8) VALUE SPACE. 200 02 STATUS-CODE PIC X(5) VALUE SPACE. 210 02 FILLER PIC X(3). 220 02 FLAGS PIC S9(9) COMP. 230 01 DAM-ARG1. 240 02 REQUEST PIC X(8) VALUE SPACE. 250 02 STATUS-CODE PIC X(5) VALUE SPACE. 260 02 FILLER PIC X(3). 270 02 FILE-NAME PIC X(8). 280 02 FILLER PIC S9(9) COMP. 290 02 FILLER PIC S9(9) COMP. 300 02 FILDES PIC S9(9) COMP VALUE ZERO. 310 02 FILLER PIC X(28). 320 01 DAM-ARG2. 330 02 ACCESS-CODE PIC X(4). 340 02 FLAG1 PIC X(1). 350 02 FILLER PIC X(1). 360 02 FILLER PIC X(1). 370 02 FILLER PIC X(1). 380 02 FLAGS PIC S9(9) COMP VALUE ZERO. 390 * 400 PROCEDURE DIVISION. 410 * 420 ******************************************************** 430 * RPC-OPEN（UAPの開始） * 440 ******************************************************** 450 * 460 MOVE 'OPEN' TO REQ-CODE OF RPC-ARG1. 470 MOVE ZERO TO FLAGS OF RPC-ARG1. 480 CALL 'CBLDCRPC' USING RPC-ARG1. 490 IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN 500 DISPLAY 'SPP01:RPC-OPEN FAILED. CODE = ' 510 STATUS-CODE OF RPC-ARG1 520 GO TO PROG-END 530 END-IF. 540 * 550 ******************************************************** 560 * DAM-OPEN(論理ファイルのオープン) * 570 ******************************************************** 580 * 590 MOVE 'DCDAMSVC' TO REQUEST OF DAM-ARG1. 600 MOVE 'damfile0' TO FILE-NAME OF DAM-ARG1. 610 MOVE 'OPEN' TO ACCESS-CODE OF DAM-ARG2. 620 MOVE 'B' TO FLAG1 OF DAM-ARG2. 630 CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2. 640 IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN 650 DISPLAY 'SPP01:DAM-OPEN FAILED. CODE = ' 660 STATUS-CODE OF DAM-ARG1 670 GO TO DAM-END 680 END-IF. 690 MOVE FILDES TO FD-SAVE. 700 * 710 ******************************************************** 720 * RPC-MAINLOOP(SPPのサービス開始) * 730 ******************************************************** 740 * 750 DISPLAY 'SPP01: MAINLOOP START.' 760 MOVE 'MAINLOOP' TO REQ-CODE OF RPC-ARG1. 770 MOVE ZERO TO FLAGS OF RPC-ARG1. 780 CALL 'CBLDCRSV' USING RPC-ARG1. 790 IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN 800 DISPLAY 'SPP01:RPC-MAINLOOP FAILED. CODE =' 810 STATUS-CODE OF RPC-ARG1 820 END-IF. 830 DAM-END. 840 * 850 ******************************************************** 860 * DAM-CLOSE(論理ファイルのクローズ) * 870 ******************************************************** 880 * 890 MOVE 'damfile0' TO FILE-NAME OF DAM-ARG1. 900 MOVE FD-SAVE TO FILDES OF DAM-ARG1. 910 MOVE 'CLOS' TO ACCESS-CODE OF DAM-ARG2. 920 CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2. 930 IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN 940 DISPLAY 'SPP01:DAM-CLOSE FAILED. CODE = ' 950 STATUS-CODE OF DAM-ARG1 960 END-IF. 970 PROG-END. 980 * 990 ******************************************************** 1000 * RPC-CLOSE(UAPの終了) * 1010 ******************************************************** 1020 * 1030 MOVE 'CLOSE' TO REQ-CODE OF RPC-ARG1. 1040 MOVE ZERO TO FLAGS OF RPC-ARG1. 1050 CALL 'CBLDCRPC' USING RPC-ARG1. 1060 * 1070 ******************************************************** 1080 * 終了処理 * 1090 ******************************************************** 1100 * 1110 DISPLAY 'SPP01:Good-by!' 1120 STOP RUN.