6.4.1 XATMIインタフェースの例

<この項の構成>
(1) リクエスト/レスポンス型サービスの通信の例
(2) 会話型サービスの通信の例

(1) リクエスト/レスポンス型サービスの通信の例

(a) 処理の概要

ここで示す例題の処理概要を,次に説明します。

[説明]宿泊施設の空き状況を調べるサービスと,飛行機の空き状況を調べるサービスを,SUPから呼びます。前者は非同期に,後者は同期的に応答を受信します。

(b) UAPの構成

例題のUAPの構成を次の図に示します。

図6-4 同期的に応答を受信するリクエスト/レスポンス型サービスの通信形態

[図データ]

(c) 通信に使う型付きバッファ

通信に使う型付きバッファの構造体を次に示します。

HOTEL.cbl
          05 RDATE            PIC S9(9) COMP-5.
          05 PLACE            PIC X(128).
          05 HNAME            PIC X(128).
          05 RSTATUS          PIC S9(9) COMP-5.

PLANE.cbl
          05 RDATE            PIC S9(9) COMP-5.
          05 DEST             PIC X(128).
          05 DEPARTURE        PIC S9(9) COMP-5.
          05 RSTATUS          PIC S9(9) COMP-5.

(d) SUPの例

 10  /* SUPのXATMIインタフェース定義の例(rrsupcb.defファイル)*/
 20  called_servers = { "rrsppcb.def" };

 10      *
 20      *********************************************************
 30      * SUPの例(rrsup.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID.  MAIN.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160      *********************************************************
170      * 変数の宣言
180      *********************************************************
190      ***** typed record for SVHOTEL *****
200       01  HOTEL-REQ.
210           COPY HOTEL.
220      ***** type infomation for SVHOTEL *****
230       01  HOTELTYPE-REC.
240           COPY TPTYPE.
250      ***** typed record for SVPLANE *****
260       01  PLANE-REQ.
270           COPY PLANE.
280      ***** type infomation for SVPLANE *****
290       01  PLANETYPE-REC.
300           COPY TPTYPE.
310      ***** WERRMSG *****
320       01  WERRMSG-REC.
330           COPY ERRMSG.
340      ***** service definition for SVHOTEL *****
350       01  HOTELDEF-REC.
360           COPY TPSVCDEF.
370      ***** service definition for SVPLANE *****
380       01  PLANEDEF-REC.
390           COPY TPSVCDEF.
400      ***** return record *****
410       01  STATUS-REC.
420           COPY TPSTATUS.
430      ***** working area is used for replies *****
440       01  WK-AREA    PIC X(264).
450      ***** redefine working area 1 *****
460       01  HOTEL-REP REDEFINES WK-AREA.
470           COPY HOTEL.
480      ***** redefine working area 2 *****
490       01  PLANE-REP REDEFINES WK-AREA.
500           COPY PLANE.
510      ***** redefine working area 3 *****
520       01  ERRMSG-REP REDEFINES WK-AREA.
530           COPY ERRMSG.
540      ***** typed infomation  *****
550       01  TYPE-REC.
560           COPY TPTYPE.
570      ***** others *****
580       01  WSTATUS PIC S9(9) COMP-5.
590      ***** dc_rpc_open *****
600       01  RPC-OP-ARG.
610           02  REQEST        PIC X(8) VALUE 'OPEN    '.
620           02  STATUS-CODE   PIC X(5) VALUE SPACE.
630           02  FILLER        PIC X(3).
640           02  FLAGS         PIC S9(9) COMP VALUE ZERO.
650      ***** dc_rpc_close *****
660       01  RPC-CL-ARG.
670           02  REQEST        PIC X(8) VALUE 'CLOSE   '.
680           02  STATUS-CODE   PIC X(5) VALUE SPACE.
690           02  FILLER        PIC X(3).
700           02  FLAGS         PIC S9(9) COMP VALUE ZERO.
710      *
720       01  ADM-ARG.
730           02    REQUEST     PIC X(8) VALUE 'COMPLETE'.
740           02    STATUS-CODE PIC X(5) VALUE SPACE.
750           02    FILLER      PIC X(3).
760           02    FLAGS       PIC S9(9) COMP VALUE ZERO.
770           02    FILLER      PIC X(3).
780      *
790       01  FLAG              PIC S9(9) COMP VALUE ZERO.
800      *
810       PROCEDURE DIVISION.
820      *
830      *********************************************************
840      * RPC-OPEN(UAPの開始)
850      *********************************************************
860      *
870       CALL 'CBLDCRPC' USING RPC-OP-ARG.
880           IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN
890             DISPLAY 'CLIENT: RPC-OPEN FAILED. CODE = '
900                      STATUS-CODE OF RPC-OP-ARG
910             GO TO PROG-END
920           END-IF.
930      *
940      *********************************************************
950      * ADM-COMPLETE(ユーザサーバの開始処理完了の報告)
960      *********************************************************
970      *
980       CALL 'CBLDCADM' USING ADM-ARG.
990           IF STATUS-CODE OF ADM-ARG NOT = '00000' THEN
1000             DISPLAY 'CLIENT: ADM-COMPLETE FAILED. CODE = '
1010                      STATUS-CODE OF ADM-ARG
1020             GO TO PROG-END
1030           END-IF.
1040      *
1050      *********************************************************
1060      * TPACALL(サービスの要求 (SVHOTEL))
1070      *********************************************************
1080      *
1090      ***** set parameters *****
1100      *
1110      ***** set up HOTELDEF-REC *****
1120      *
1130       MOVE LOW-VALUES            TO HOTELDEF-REC.
1140       MOVE "SVHOTEL"             TO SERVICE-NAME OF HOTELDEF-REC.
1150      *
1160      ***** set up HOTELTYPE-REC *****
1170      *
1180       MOVE "X_COMMON"            TO REC-TYPE    OF HOTELTYPE-REC.
1190       MOVE "hotel"               TO SUB-TYPE    OF HOTELTYPE-REC.
1200       COMPUTE LEN OF HOTELTYPE-REC = FUNCTION LENGTH(HOTEL-REQ).
1210      *
1220      ***** set up HOTEL-REQ *****
1230      *
1240       MOVE 940415                TO RDATE        OF HOTEL-REQ.
1250       MOVE "SAPPRO"              TO PLACE        OF HOTEL-REQ.
1260       MOVE "PRINCE"              TO HNAME        OF HOTEL-REQ.
1270       MOVE 0                     TO RSTATUS      OF HOTEL-REQ.
1280      *
1290      ***** CALL TPACALL *****
1300       CALL "TPACALL" USING
1310           HOTELDEF-REC HOTELTYPE-REC HOTEL-REQ STATUS-REC.
1320           IF NOT TPOK OF STATUS-REC THEN
1330             DISPLAY 'CLIENT: SVHOTEL SERVICE REQ WAS FAIL:ERROR = '
1340                      TP-STATUS OF STATUS-REC
1350             GO TO PROG-END
1360           END-IF.
1370      *
1380       DISPLAY 'CLIENT: SVHOTEL SERVICE REQ WAS SUCCESS '.
1390      *
1400      *
1410      *********************************************************
1420      * TPCALL(サービスの要求 (SVPLANE))
1430      *********************************************************
1440      *
1450      ***** set parameters *****
1460      *
1470      ***** set up PLANEDEF-REC *****
1480      *
1490       MOVE LOW-VALUES            TO PLANEDEF-REC.
1500       MOVE "SVPLANE"             TO SERVICE-NAME OF PLANEDEF-REC.
1510      *
1520      ***** set up PLANETYPE-REC *****
1530      *
1540       MOVE "X_COMMON"            TO REC-TYPE    OF PLANETYPE-REC.
1550       MOVE "plane"               TO SUB-TYPE    OF PLANETYPE-REC.
1560       COMPUTE LEN OF PLANETYPE-REC = FUNCTION LENGTH(PLANE-REQ).
1570      *
1580      ***** set up PLANE-REQ *****
1590      *
1600       MOVE 940415                TO RDATE        OF PLANE-REQ.
1610       MOVE "CHITOSE"             TO DEST         OF PLANE-REQ.
1620       MOVE 1540                  TO DEPARTURE    OF PLANE-REQ.
1630       MOVE 0                     TO RSTATUS      OF PLANE-REQ.
1640      *
1650      *
1660      ***** set up TYPE-REC *****
1670      *
1680       MOVE "X_COMMON"            TO REC-TYPE     OF TYPE-REC.
1690       MOVE "plane"               TO SUB-TYPE     OF TYPE-REC.
1700       COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA).
1710      *
1720      ***** CALL TPCALL *****
1730       CALL "TPCALL" USING PLANEDEF-REC PLANETYPE-REC PLANE-REQ
1740            TYPE-REC WK-AREA STATUS-REC.
1750      *
1760      * FAILURE CASE
1770      *
1780           IF NOT TPOK OF STATUS-REC THEN
1790             DISPLAY 'CLIENT: SVPLANE SERVICE REQ WAS FAILED'
1800             DISPLAY 'CLIENT: TPCALL WAS FAILED:ERROR='
1810                      TP-STATUS OF STATUS-REC
1820             IF TPESVCFAIL OF STATUS-REC THEN
1830               MOVE ERRMESSAGE IN ERRMSG-REP
1840                    TO ERRMESSAGE OF WERRMSG-REC
1850               DISPLAY 'CLIENT: USER  CODE = '
1860                        ERRMESSAGE OF WERRMSG-REC
1870               GO TO PROG-END
1880             END-IF
1890             GO TO PROG-END
1900           END-IF.
1910      *
1920      * SUCCESS CASE
1930      *
1940       DISPLAY 'CLIENT: SVPLANE SERVICE REQ WAS SUCCESS '.
1950           MOVE RSTATUS IN PLANE-REP TO WSTATUS.
1960           IF WSTATUS = 1 THEN
1970             DISPLAY 'CLIENT: NO BORDING TICKET'
1980           ELSE
1990             DISPLAY 'CLIENT: A BORDING TICKET WAS FOUND'
2000           END-IF.
2010      *
2020      *********************************************************
2030      * TPGETRPLY(応答メッセージの受信)
2040      *********************************************************
2050      *
2060      ***** set parameters *****
2070      *
2080      ***** set up TYPE-REC *****
2090      *
2100       MOVE "X_COMMON"            TO REC-TYPE    OF TYPE-REC.
2110       MOVE "hotel"               TO SUB-TYPE    OF TYPE-REC.
2120       COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA).
2130      *
2140      ***** CALL TPGETRPLY *****
2150       CALL "TPGETRPLY" USING HOTELDEF-REC TYPE-REC WK-AREA
2160            STATUS-REC.
2170      *
2180      * FAILURE CASE
2190      *
2200           IF NOT TPOK OF STATUS-REC THEN
2210             DISPLAY 'CLIENT: SVHOTEL SERVICE RSP WAS FAILED '
2220             DISPLAY 'CLIENT: TPGETRPLY WAS FAILED:ERROR='
2230                      TP-STATUS OF STATUS-REC
2240             IF TPESVCFAIL OF STATUS-REC THEN
2250               MOVE ERRMESSAGE IN ERRMSG-REP
2260                    TO ERRMESSAGE OF WERRMSG-REC
2270               DISPLAY 'CLIENT: USER  CODE = '
2280                        ERRMESSAGE OF WERRMSG-REC
2290               GO TO PROG-END
2300             END-IF
2310             GO TO PROG-END
2320           END-IF.
2330      *
2340      * SUCCESS CASE
2350      *
2360       DISPLAY 'CLIENT: SVHOTEL SERVICE RSP WAS SUCCESS '.
2370           MOVE RSTATUS IN HOTEL-REP TO WSTATUS.
2380           IF WSTATUS = 1 THEN
2390             DISPLAY 'CLIENT: NO ROOM'
2400           ELSE
2410             DISPLAY 'CLIENT: A ROOM WAS FOUND'
2420           END-IF.
2430      *
2440      *********************************************************
2450      * 処理の終了
2460      *********************************************************
2470      *
2480       PROG-END.
2490      *
2500       DISPLAY 'CLIENT: SEE YOU LATER'
2510      *
2520      *********************************************************
2530      * RPC-CLOSE(UAPの終了)
2540      *********************************************************
2550      *
2560       CALL 'CBLDCRPC' USING RPC-CL-ARG.
2570      *
2580       STOP RUN.

 10  #ユーザサービス定義の例(rrsupファイル)
 20  set  module              = "rrsup"
 30  set  receive_from        = none
 40  set  trn_expiration_time = 180
 50  set  trn_expiration_time_suspend = Y

(e) SPPの例

 10    /* XATMIインタフェース定義の例(rrsppcb.defファイル)*/
 20    X_COMMON hotel {
 30        long   rdate;
 40        char   place[128];
 50        char   hname[128];
 60        long   rstatus;
 70    };
 80    X_COMMON plane {
 90        long   rdate;
100        char   dest[128];
110        long   departure;
120        long   rstatus;
130    };
140    X_COMMON errmsg {
150        char   errmessage[128];
160    };
170    service SHOTEL(X_COMMON hotel) ;
180    service SPLANE(X_COMMON plane) ;

 10      *
 20      *********************************************************
 30      * SPPの例(rrspp.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID.     MAIN.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160       01  RPC-OP-ARG.
170           02  REQEST       PIC X(8) VALUE 'OPEN    '.
180           02  STATUS-CODE  PIC X(5) VALUE SPACE.
190           02  FILLER       PIC X(3).
200           02  FLAGS        PIC S9(9) COMP VALUE ZERO.
210      *
220       01  RPC-CL-ARG.
230           02  REQEST       PIC X(8) VALUE 'CLOSE   '.
240           02  STATUS-CODE  PIC X(5) VALUE SPACE.
250           02  FILLER       PIC X(3).
260           02  FLAGS        PIC S9(9) COMP VALUE ZERO.
270      *
280       01  RSV-ARG.
290           02  REQUEST      PIC X(8) VALUE 'MAINLOOP'.
300           02  STATUS-CODE  PIC X(5) VALUE SPACE.
310           02  FILLER       PIC X(3).
320           02  FLAGS        PIC S9(9) COMP VALUE ZERO.
330      *
340       PROCEDURE DIVISION.
350      *
360      *********************************************************
370      * RPC-OPEN(UAPの開始)
380      *********************************************************
390      *
400       CALL 'CBLDCRPC' USING RPC-OP-ARG.
410           IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN
420             DISPLAY 'SERVER: RPC-OPEN FAILED. CODE = '
430                      STATUS-CODE OF RPC-OP-ARG
440             GO TO PROG-END
450           END-IF.
460      *
470      *********************************************************
480      * RPC-MAINLOOP(SPPサービスの開始)
490      *********************************************************
500      *
510       DISPLAY 'SERVER: ENTERING MAINLOOP...'
520       CALL 'CBLDCRSV' USING RSV-ARG.
530           IF STATUS-CODE OF RSV-ARG NOT = '00000' THEN
540             DISPLAY 'SERVER: RPC-MAINLOOP FAILED. CODE = '
550                      STATUS-CODE OF RSV-ARG
560           END-IF.
570      *
580      *********************************************************
590      * プログラムの終わり
600      *********************************************************
610       PROG-END.
620      *
630      *********************************************************
640      * RPC-CLOSE(UAPの終了)
650      *********************************************************
660      *
670       CALL 'CBLDCRPC' USING RPC-CL-ARG.
680      *
690      *********************************************************
700      * 処理の終了
710      *********************************************************
720      *
730       STOP RUN.

リクエスト/レスポンス型サービスの例題で示すSPPのコーディング例(サービスプログラム)を次に示します。

<SVHOTELサービス用のコーディング例>

 10      *
 20      *********************************************************
 30      * SPPのサービス関数例(shotel.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID.     SHOTEL.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160      *
170      *********************************************************
180      * 変数の宣言
190      *********************************************************
200      *
210      * TPSVCDEF record
220      *
230       01  SVCDEF-REC.
240           COPY TPSVCDEF.
250      *
260      * TPTYPE record
270      *
280       01  TYPE-REC.
290           COPY TPTYPE.
300      *
310      * TPSTATUS record
320      *
330       01  STATUS-REC.
340           COPY TPSTATUS.
350      *
360      * TPSVCRET record
370      *
380       01  SVCRET-REC.
390           COPY TPSVCRET.
400      *
410      * WK-AREA is where service requests are read into
420      *
430       01  WK-AREA PIC X(264).
440      *
450       01  HOTEL-REC REDEFINES WK-AREA.
460           COPY HOTEL.
470      *
480      *********************************************************
490      * shotel processing
500      *********************************************************
510      *
520       PROCEDURE DIVISION.
530      *
540      ***** set length *****
550       COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA).
560      *
570      *********************************************************
580      * TPSVCSTART
590      *********************************************************
600      *
610       CALL "TPSVCSTART" USING
620            SVCDEF-REC TYPE-REC WK-AREA STATUS-REC.
630      *
640      * Shotel return status=0 if the specified hotel can be made
650      * a reservation. Shotel return status=1 if there are no room
660      * in that specified hotel.
670      *   In this case, shotel return status=1 because there are no
680      * room.
690      *
700        MOVE 1 TO RSTATUS IN HOTEL-REC.
710      *
720      *********************************************************
730      * TPRETURN
740      *********************************************************
750      *
760       SET TPSUCCESS OF SVCRET-REC TO TRUE.
770       MOVE 1 TO APPL-CODE OF SVCRET-REC.
780      *
790       COPY TPRETURN
800            REPLACING TPSVCRET-REC BY SVCRET-REC
810                      TPTYPE-REC BY TYPE-REC
820                      DATA-REC BY WK-AREA.
830      *
840      *********************************************************
850      * 処理の終了
860      *********************************************************
870      *
880      *
890       END PROGRAM SHOTEL.

<SVPLANEサービス用のコーディング例>

 10      *
 20      *********************************************************
 30      * SPPのサービス関数例(splane.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID.     SPLANE.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160      *
170      *********************************************************
180      * 変数の宣言
190      *********************************************************
200      *
210      * TPSVCDEF record
220      *
230       01  SVCDEF-REC.
240           COPY TPSVCDEF.
250      *
260      * TPTYPE record
270      *
280       01  TYPE-REC.
290           COPY TPTYPE.
300      *
310      * TPSTATUS record
320      *
330       01  STATUS-REC.
340           COPY TPSTATUS.
350      *
360      * TPSVCRET record
370      *
380       01  SVCRET-REC.
390           COPY TPSVCRET.
400      *
410      * WK-AREA is where service requests are read into
420      *
430       01  WK-AREA PIC X(264).
440      *
450       01  PLANE-REC REDEFINES WK-AREA.
460           COPY PLANE.
470      *
480      *********************************************************
490      * splane processing
500      *********************************************************
510      *
520       PROCEDURE DIVISION.
530      *
540      ***** set length *****
550       COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA).
560      *
570      *********************************************************
580      * TPSVCSTART
590      *********************************************************
600      *
610       CALL "TPSVCSTART" USING
620            SVCDEF-REC TYPE-REC WK-AREA STATUS-REC.
630      *
640      * Splane return status=0 if the specified plane can be made
650      * a reservation. Splane return status=1 if there aren't any
660      * ticket in that specified plane.
670      *   In this case, splane return status=1 because there are no
680      * room.
690      *
700        MOVE 1 TO RSTATUS IN PLANE-REC.
710      *
720      *********************************************************
730      * TPRETURN
740      *********************************************************
750      *
760       SET TPSUCCESS OF SVCRET-REC TO TRUE.
770       MOVE 0 TO APPL-CODE OF SVCRET-REC.
780      *
790       COPY TPRETURN
800            REPLACING TPSVCRET-REC BY SVCRET-REC
810                      TPTYPE-REC BY TYPE-REC
820                      DATA-REC BY WK-AREA.
830      *
840      *********************************************************
850      * 処理の終了
860      *********************************************************
870      *
880      *
890       END PROGRAM SPLANE.

 10  #ユーザサービス定義の例(rrsppファイル)
 20  set    service_group     = "rrspp_svg"
 30  set    module            = "rrspp"
 40  set    service           = "SVHOTEL=SHOTEL","SVPLANE=SPLANE"
 50  set    trn_expiration_time = 180
 60  set    trn_expiration_time_suspend = Y
 70  set    server_type = "xatmi_cbl"

(2) 会話型サービスの通信の例

(a) 処理の概要

ここで示す例題の処理概要を,次に説明します。

[説明] acctreq構造体の構造を持つ型付きバッファサービスでサービスプログラムを起動します。acctreqのメンバは口座番号の上限と下限を示します。サービスプログラムでは,この範囲にある口座データをacctreq構造体の構造を持つ型付きバッファに設定して,会話のオリジネータに送信します。

(b) UAPの構成

例題のUAPの構成を次の図に示します。

図6-5 会話型サービスの通信形態

[図データ]

(c) 通信に使う型付きバッファ

通信に使う型付きバッファの構造体を次に示します。

●サービスプログラム起動時のデータ

ACCTREQ.cbl
         05 UPPERNO          PIC S9(9) COMP-5.
         05 LOWERNO          PIC S9(9) COMP-5.

●会話型サービスの通信をするときのデータ

         05 ACCTNO           PIC S9(9) COMP-5.
         05 NAME             PIC X(128).
         05 AMOUNT           PIC S9(4) COMP-5.
         05 FILLER           PIC X(2).

(d) SUPの例

 10  /*  SUPのXATMIインタフェース定義の例(cvsupcb.defファイル)*/
 20  called_servers = { "cvsppcb.def" } ;

 10      *
 20      *********************************************************
 30      * SUPの例(convsup.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID. MAIN.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160      *********************************************************
170      * 定数の宣言
180      *********************************************************
190      *********************************************************
200      * 変数の宣言
210      *********************************************************
220      ***** typed record for INQUARY when inquary service *****
230       01  ACCTREQ-REC.
240           COPY ACCTREQ.
250      ***** type infomation for INQUARY *****
260       01  ACCTREQTYPE-REC.
270           COPY TPTYPE.
280      ***** service definition for INQUARY *****
290       01  ACCTREQDEF-REC.
300           COPY TPSVCDEF.
310      ***** return record *****
320       01  STATUS-REC.
330           COPY TPSTATUS.
340      ***** received record between INQUARY and CONVSUP
350       01  ACCTDATA-REQ.
360           COPY ACCTDATA.
370      **** type information received record between INQUARY and CONVSUP
380       01  ACCTDATATYPE-REC.
390           COPY TPTYPE.
400      ***** service definition for INQUARY *****
410       01  ACCTDATADEF-REC.
420           COPY TPSVCDEF.
430      ***** working area is used for replies *****
440       01  WK-AREA    PIC X(136).
450      ***** redefine working area 1 *****
460       01  ACCTREQ-REP REDEFINES WK-AREA.
470           COPY ACCTREQ.
480      ***** redefine working area 2 *****
490       01  ACCTDATA-REP REDEFINES WK-AREA.
500           COPY ACCTDATA.
510      ***** typed infomation  *****
520       01  TYPE-REC.
530           COPY TPTYPE.
540      ***** others *****
550       01  WSTATUS PIC S9(9) COMP-5.
560      ***** dc_rpc_open *****
570       01  RPC-OP-ARG.
580           02  REQEST        PIC X(8) VALUE 'OPEN    '.
590           02  STATUS-CODE   PIC X(5) VALUE SPACE.
600           02  FILLER        PIC X(3).
610           02  FLAGS         PIC S9(9) COMP VALUE ZERO.
620      ***** dc_rpc_close *****
630       01  RPC-CL-ARG.
640           02  REQEST        PIC X(8) VALUE 'CLOSE   '.
650           02  STATUS-CODE   PIC X(5) VALUE SPACE.
660           02  FILLER        PIC X(3).
670           02  FLAGS         PIC S9(9) COMP VALUE ZERO.
680      ***** dc_adm_complete ****
690       01  ADM-ARG.
700           02    REQUEST     PIC X(8) VALUE 'COMPLETE'.
710           02    STATUS-CODE PIC X(5) VALUE SPACE.
720           02    FILLER      PIC X(3).
730           02    FLAGS       PIC S9(9) COMP VALUE ZERO.
740           02    FILLER      PIC X(3).
750      *
760       01  FLAG              PIC S9(9) COMP VALUE ZERO.
770      *
780      ****** for TX interface *****
790      *
800       01  TX-RETURN-STATUS.
810           COPY TXSTATUS.
820      *
830       01  RS REDEFINES TX-RETURN-STATUS.
840           05 RSVAL         PIC S9(9) COMP-5.
850      *
860       01 TX-INFO-AREA.
870           COPY TXINFDEF.
880      *
890       PROCEDURE DIVISION.
900      *
910      *********************************************************
920      * RPC-OPEN(UAPの開始)
930      *********************************************************
940      *
950       CALL 'CBLDCRPC' USING RPC-OP-ARG.
960           IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN
970             DISPLAY 'CLIENT: RPC-OPEN FAILED. CODE = '
980                      STATUS-CODE OF RPC-OP-ARG
990             GO TO PROG-END
1000           END-IF.
1010      *
1020      *********************************************************
1030      * TXOPEN(リソースマネジャのオープン)
1040      *********************************************************
1050      *
1060       CALL "TXOPEN" USING TX-RETURN-STATUS.
1070           IF RSVAL OF RS NOT = 0 THEN
1080             DISPLAY 'CLIENT:TX-OPEN FAILED. CODE = '
1090             RSVAL OF RS
1100             GO TO PROG-END
1110           END-IF.
1120      *
1130      *********************************************************
1140      * TX-SET-TRANSACTION-TIMEOUT(トランザクション監視時間の設定)
1150      *********************************************************
1160      *
1170       MOVE 180 TO TRANSACTION-TIMEOUT OF TX-INFO-AREA.
1180       CALL "TXSETTIMEOUT" USING TX-INFO-AREA TX-RETURN-STATUS.
1190           IF RSVAL OF RS NOT = 0 THEN
1200             DISPLAY 'CLIENT:TX-SET-TRANSACTION-TIMEOUT FAILED. CODE = '
1210             RSVAL OF RS
1220             GO TO PROG-END
1230           END-IF.
1240      *
1250      *********************************************************
1260      * ADM-COMPLETE(ユーザサーバの開始処理完了の報告)
1270      *********************************************************
1280      *
1290       CALL 'CBLDCADM' USING ADM-ARG.
1300           IF STATUS-CODE OF ADM-ARG NOT = '00000' THEN
1310             DISPLAY 'CLIENT: ADM-COMPLETE FAILED. CODE = '
1320                      STATUS-CODE OF ADM-ARG
1330             GO TO PROG-END
1340           END-IF.
1350      *
1360      *********************************************************
1370      * TX-SET-TRANSACTION-CONTROL(非連鎖モード設定)
1380      *********************************************************
1390      *
1400       MOVE 0 TO TRANSACTION-CONTROL OF TX-INFO-AREA.
1410       CALL "TXSETTRANCTL" USING TX-INFO-AREA TX-RETURN-STATUS.
1420           IF RSVAL OF RS NOT = 0 THEN
1430             DISPLAY 'CLIENT:TX-SET-TRANSACTION-CONTROL FAILED. CODE ='
1440             RSVAL OF RS
1450           END-IF.
1460      *
1470      *********************************************************
1480      * TPXBEGIN(トランザクションの始まり)
1490      *********************************************************
1500      *
1510       CALL "TXBEGIN" USING TX-RETURN-STATUS.
1520           IF RSVAL OF RS NOT = 0 THEN
1530             DISPLAY 'CLIENT:TX-BEGIN FAILED. CODE ='
1540             RSVAL OF RS
1550             GO TO PROG-END
1560           END-IF.
1570      *
1580      *********************************************************
1590      * TPCONNECT(サービス要求 (INQUARY))
1600      *********************************************************
1610      *
1620      ***** set parameters *****
1630      *
1640      ***** set up ACCTREQDEF-REC *****
1650      *
1660       MOVE LOW-VALUES            TO ACCTREQDEF-REC.
1670       MOVE 1                     TO TPSENDRECV-FLAG OF ACCTREQDEF-REC.
1680       MOVE "INQUIRY"             TO SERVICE-NAME    OF ACCTREQDEF-REC.
1690      *
1700      ***** set up ACCTREQTYPE-REC *****
1710      *
1720       MOVE "X_COMMON"            TO REC-TYPE    OF ACCTREQTYPE-REC.
1730       MOVE "acctreq"             TO SUB-TYPE    OF ACCTREQTYPE-REC.
1740       COMPUTE LEN OF ACCTREQTYPE-REC = FUNCTION LENGTH(ACCTREQ-REC).
1750      *
1760      ***** set up ACCTREQ-REC *****
1770      *
1780       MOVE "100000000" TO LOWERNO OF ACCTREQ-REC.
1790       MOVE "200000000" TO UPPERNO OF ACCTREQ-REC.
1800      *
1810      ***** CALL TPCONNECT *****
1820       CALL "TPCONNECT" USING
1830           ACCTREQDEF-REC ACCTREQTYPE-REC ACCTREQ-REC STATUS-REC.
1840           IF NOT TPOK OF STATUS-REC THEN
1850             DISPLAY 'CLIENT: INQUARY SERVICE REQ WAS FAIL. CODE = '
1860                      TP-STATUS OF STATUS-REC
1870             DISPLAY  'CLIENT:TX-ROLLBACK STARTED'
1880             CALL "TXROLLBACK" USING TX-RETURN-STATUS
1890             DISPLAY  'CLIENT:TX-ROLLBACK ENDED'
1900             IF RSVAL OF RS NOT = 0 THEN
1910               DISPLAY 'CLIENT:TX-ROLLBACK FAILED. CODE ='
1920               RSVAL OF RS
1930             END-IF
1940             GO TO PROG-END
1950           END-IF.
1960      *
1970       DISPLAY 'CLIENT: INQUARY SERVICE REQ WAS SUCCESS '.
1980      *
1990      ***** set up ACCTDATA-REC *****
2000      *
2010       MOVE 0 TO TP-STATUS OF STATUS-REC.
2020       MOVE LOW-VALUES  TO ACCTDATADEF-REC.
2030       MOVE COMM-HANDLE OF ACCTREQDEF-REC TO
2040            COMM-HANDLE OF ACCTDATADEF-REC.
2050       MOVE "X_COMMON"            TO REC-TYPE    OF ACCTDATATYPE-REC.
2060       MOVE "acctdata"            TO SUB-TYPE    OF ACCTDATATYPE-REC.
2070       COMPUTE LEN OF ACCTDATATYPE-REC = FUNCTION LENGTH(ACCTDATA-REQ).
2080      *
2090       PERFORM WITH TEST AFTER UNTIL NOT TPOK OF STATUS-REC
2100      *
2110      *********************************************************
2120      * TPRECV(データの受信)
2130      *********************************************************
2140         MOVE 0 TO TP-STATUS OF STATUS-REC
2150         CALL "TPRECV" USING
2160             ACCTDATADEF-REC ACCTDATATYPE-REC WK-AREA STATUS-REC
2170             IF TPOK OF STATUS-REC THEN
2180               DISPLAY 'CLIENT: RECEIVED ACOUNT INFORMATION '
2190               DISPLAY 'CLIENT: ACCOUNT NUMBER ='
2200                       ACCTNO IN ACCTDATA-REP
2210               DISPLAY 'CLIENT: NAME =' ANAME IN ACCTDATA-REP
2220               DISPLAY 'CLIENT: AMOUNT =' AMOUNT IN ACCTDATA-REP
2230             END-IF
2240       END-PERFORM.
2250      *    
2260           IF TPEEVENT OF STATUS-REC THEN
2270             IF TPEV-SVCSUCC OF STATUS-REC THEN
2280               DISPLAY 'CLIENT:INQUARY SERVICE SUCCESS'
2290      *
2300      *********************************************************
2310      *   TX-COMMIT(トランザクションのコミット)
2320      *********************************************************
2330      *
2340               DISPLAY  'CLIENT:TX-COMMIT STARTED'
2350               CALL "TXCOMMIT" USING TX-RETURN-STATUS
2360               DISPLAY  'CLIENT:TX-COMMIT ENDED'
2370                 IF RSVAL OF RS NOT = 0 THEN
2380                   DISPLAY 'CLIENT:TX-COMMIT FAILED. CODE ='
2390                   RSVAL OF RS
2400                 END-IF
2410             ELSE
2420               DISPLAY 'CLIENT:EVENT OCCURED IN INQUARY SERVICE'
2430               DISPLAY 'CODE =' TPEVENT OF STATUS-REC
2440      *
2450      *********************************************************
2460      *   TX-ROLLBAK(トランザクションのロールバック)
2470      *********************************************************
2480      *
2490               DISPLAY  'CLIENT:TX-ROLLBACK STARTED'
2500               CALL "TXROLLBACK" USING TX-RETURN-STATUS
2510               DISPLAY  'CLIENT:TX-ROLLBACK ENDED'
2520               IF RSVAL OF RS NOT = 0 THEN
2530                 DISPLAY 'CLIENT:TX-ROLLBACK FAILED. CODE ='
2540                 RSVAL OF RS
2550               END-IF
2560             END-IF
2570           ELSE
2580             DISPLAY 'CLIENT:EVENT OCCURED IN INQUARY SERVICE'
2590             DISPLAY 'CODE =' TPEVENT OF STATUS-REC
2600      *
2610      *********************************************************
2620      *   TX-ROLLBAK(トランザクションのロールバック)
2630      *********************************************************
2640      *
2650             DISPLAY  'CLIENT:TX-ROLLBACK STARTED'
2660             CALL "TXROLLBACK" USING TX-RETURN-STATUS
2670             DISPLAY  'CLIENT:TX-ROLLBACK ENDED'
2680             IF RSVAL OF RS NOT = 0 THEN
2690               DISPLAY 'CLIENT:TX-ROLLBACK FAILED. CODE ='
2700               RSVAL OF RS
2710             END-IF
2720           END-IF.
2730      *
2740      *********************************************************
2750      * 処理の終了
2760      *********************************************************
2770      *
2780       PROG-END.
2790      *
2800       DISPLAY 'CLIENT: SEE YOU LATER'
2810      *
2820      *********************************************************
2830      * RPC-CLOSE(UAPの終了)
2840      *********************************************************
2850      *
2860       CALL 'CBLDCRPC' USING RPC-CL-ARG.
2870      *
2880       STOP RUN.

 10  #ユーザサービス定義の例(convsupファイル)
 20  set module              = "convsup"          #実行形式ファイル名
 30  set watch_time          = 180                #最大応答待ち時間
 40  set receive_from        = none               #受信方法
 50  set trn_expiration_time = 180
 60                           #トランザクションブランチ限界経過時間
 70  set trn_expiration_time_suspend = Y          #必ず Y を指定

(e) SPPの例

 10  /* SPPのXATMIインタフェース定義の例(cvsppcb.defファイル)*/
 20  X_COMMON acctreq {
 30      long   upperno;
 40      long   lowerno;
 50  };
 60  X_COMMON acctdata {
 70      long   acctno;
 80      char   aname[128];
 90      short  amount;
100  };
110  service INQUIRY(X_COMMON acctreq) ;

 10      *
 20      *********************************************************
 30      * SPPの例(convspp.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID.     MAIN.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160       01  RPC-OP-ARG.
170           02  REQEST       PIC X(8) VALUE 'OPEN    '.
180           02  STATUS-CODE  PIC X(5) VALUE SPACE.
190           02  FILLER       PIC X(3).
200           02  FLAGS        PIC S9(9) COMP VALUE ZERO.
210      *
220       01  RPC-CL-ARG.
230           02  REQEST       PIC X(8) VALUE 'CLOSE   '.
240           02  STATUS-CODE  PIC X(5) VALUE SPACE.
250           02  FILLER       PIC X(3).
260           02  FLAGS        PIC S9(9) COMP VALUE ZERO.
270      *
280       01  RSV-ARG.
290           02  REQUEST      PIC X(8) VALUE 'MAINLOOP'.
300           02  STATUS-CODE  PIC X(5) VALUE SPACE.
310           02  FILLER       PIC X(3).
320           02  FLAGS        PIC S9(9) COMP VALUE ZERO.
330      *
340       PROCEDURE DIVISION.
350      *
360      *********************************************************
370      * RPC-OPEN(UAPの開始)
380      *********************************************************
390      *
400       CALL 'CBLDCRPC' USING RPC-OP-ARG.
410           IF STATUS-CODE OF RPC-OP-ARG NOT = '00000' THEN
420             DISPLAY 'SERVER: RPC-OPEN FAILED. CODE = '
430                      STATUS-CODE OF RPC-OP-ARG
440             GO TO PROG-END
450           END-IF.
460      *
470      *********************************************************
480      * RPC-MAINLOOP(SPPサービスの開始)
490      *********************************************************
500      *
510       DISPLAY 'SERVER: ENTERING MAINLOOP...'
520       CALL 'CBLDCRSV' USING RSV-ARG.
530           IF STATUS-CODE OF RSV-ARG NOT = '00000' THEN
540             DISPLAY 'SERVER: RPC-MAINLOOP FAILED. CODE = '
550                      STATUS-CODE OF RSV-ARG
560           END-IF.
570      *
580      *********************************************************
590      * プログラムの終了
600      *********************************************************
610       PROG-END.
620      *
630      *********************************************************
640      * RPC-CLOSE(UAPの終了)
650      *********************************************************
660      *
670       CALL 'CBLDCRPC' USING RPC-CL-ARG.
680      *
690      *********************************************************
700      * 処理の終了
710      *********************************************************
720      *
730       STOP RUN.

 10      *
 20      *********************************************************
 30      * INQUIRY    サービスプログラム(convsvc.cblファイル)
 40      *********************************************************
 50      *
 60       IDENTIFICATION DIVISION.
 70      *
 80       PROGRAM-ID.     INQUIRY.
 90      *
100      *********************************************************
110      * データ領域の設定
120      *********************************************************
130      *
140       DATA DIVISION.
150       WORKING-STORAGE SECTION.
160      *
170      *********************************************************
180      * 変数の宣言
190      *********************************************************
200      *
210      * TPSVCDEF record
220      *
230       01  SVCDEF-REC.
240           COPY TPSVCDEF.
250      *
260      * TPTYPE record
270      *
280       01  TYPE-REC.
290           COPY TPTYPE.
300      *
310      * TPSTATUS record
320      *
330       01  STATUS-REC.
340           COPY TPSTATUS.
350      *
360      * TPSVCRET record
370      *
380       01  SVCRET-REC.
390           COPY TPSVCRET.
400      *
410      * WK-AREA is where service requests are read into
420      *
430       01  WK-AREA PIC X(136).
440      *
450       01  ACCTREQ-REC REDEFINES WK-AREA.
460           COPY ACCTREQ.
470      *
480       01  ACCTDATA-REC.
490           COPY ACCTDATA.
500      *
510      * TPSVCDEF record for TPSEND
520      *
530       01  ACCTDATADEF-REC.
540           COPY TPSVCDEF.
550      *
560      * TPTYPE record for TPSEND
570      *
580       01  ACCTDATATYPE-REC.
590           COPY TPTYPE.
600      *
610      *
620      *********************************************************
630      * 照会処理
640      *********************************************************
650      *
660       PROCEDURE DIVISION.
670      *
680      ***** set length *****
690       COMPUTE LEN OF TYPE-REC = FUNCTION LENGTH(WK-AREA).
700      *
710      *********************************************************
720      * TPSVCSTART
730      *********************************************************
740      *
750       CALL "TPSVCSTART" USING
760            SVCDEF-REC TYPE-REC WK-AREA STATUS-REC.
770      *
780      * find user data files between lower and upper account number.
790      * In this case 2 data was found, and was replied.
800      *
810      *********************************************************
820      * 送信データの設定
830      *********************************************************
840       MOVE LOW-VALUES        TO ACCTDATADEF-REC.
850       MOVE COMM-HANDLE OF SVCDEF-REC TO COMM-HANDLE OF ACCTDATADEF-REC.
860       MOVE "X_COMMON"        TO REC-TYPE OF ACCTDATATYPE-REC.
870       MOVE "acctdata"        TO SUB-TYPE OF ACCTDATATYPE-REC.
880       COMPUTE LEN OF ACCTDATATYPE-REC =
890               FUNCTION LENGTH(ACCTDATA-REC).
900      *
910      *********************************************************
920      * TPSEND(第1データの送信)
930      *********************************************************
940      *
950       MOVE "10000001"       TO ACCTNO  OF ACCTDATA-REC.
960       MOVE "HITACHI HANAKO" TO ANAME   OF ACCTDATA-REC.
970       MOVE "2000"           TO AMOUNT  OF ACCTDATA-REC.
980       CALL "TPSEND" USING ACCTDATADEF-REC ACCTDATATYPE-REC
990                           ACCTDATA-REC STATUS-REC.
1000           IF TPOK OF STATUS-REC THEN
1010             MOVE 0 TO TP-RETURN-VAL OF SVCRET-REC
1020           ELSE
1030             MOVE 1 TO TP-RETURN-VAL OF SVCRET-REC
1040             GO TO PROG-END
1050           END-IF
1060      *
1070      *********************************************************
1080      * TPSEND(第2データの送信)
1090      *********************************************************
1100      *
1110       MOVE "10000002"       TO ACCTNO  OF ACCTDATA-REC.
1120       MOVE "HITACHI TAROU"  TO ANAME   OF ACCTDATA-REC.
1130       MOVE "1000"           TO AMOUNT  OF ACCTDATA-REC.
1140       CALL "TPSEND" USING ACCTDATADEF-REC ACCTDATATYPE-REC
1150                           ACCTDATA-REC STATUS-REC.
1160           IF TPOK OF STATUS-REC THEN
1170             MOVE 0 TO TP-RETURN-VAL OF SVCRET-REC
1180           ELSE
1190             MOVE 1 TO TP-RETURN-VAL OF SVCRET-REC
1200             GO TO PROG-END
1210           END-IF
1220      *
1230      *********************************************************
1240      * TPRETURN(受信プログラムの終了)
1250      *********************************************************
1260      *
1270       SET TPSUCCESS OF SVCRET-REC TO TRUE.
1280       MOVE 1 TO APPL-CODE OF SVCRET-REC.
1290      *
1300       PROG-END.
1310      *
1320       MOVE "        "         TO REC-TYPE OF TYPE-REC.
1330       MOVE "                " TO SUB-TYPE OF TYPE-REC.
1340       MOVE 0 TO  LEN OF TYPE-REC.
1350       COPY TPRETURN
1360            REPLACING TPSVCRET-REC BY SVCRET-REC
1370                      TPTYPE-REC BY TYPE-REC
1380                      DATA-REC BY WK-AREA.
1390      *
1400      *********************************************************
1410      * 処理の終了
1420      *********************************************************
1430      *
1440      *
1450       END PROGRAM INQUIRY.

 10  # ユーザサービス定義の例(convsppファイル)
 20    set  service_group     = "convspp_svg"    #サービスグループ名
 30    set  module            = "convspp"        #実行形式ファイル名
 40    set  service = "INQUIRY=INQUIRY"
 50                            #サービス名=エントリポイント名
 60    set  watch_time        = 180              #最大応答待ち時間
 70    set  trn_expiration_time   =  240
 80                            #トランザクションブランチ限界経過時間
 90    set  trn_expiration_time_suspend = Y      #必ず Y を指定
100    set  server_type = "xatmi_cbl"                #サーバタイプ
110    set  receive_from = "socket"              #受信方法