OpenTP1 Version 7 Programming Reference COBOL Language

[Contents][Index][Back][Next]

6.4.1 XATMI interface samples

Organization of this subsection
(1) Request/response service paradigm sample
(2) Conversational service paradigm sample

(1) Request/response service paradigm sample

(a) Outline of processing

The processing of the sample here is outlined below.

A service for checking hotel room availability and a service for checking airplane seat availability are called from the SUP. The first service receives responses asynchronously, whereas the second service receives responses synchronously.

(b) UAP configuration

The following figure shows the configuration of the sample UAP.

Figure 6-4 Communication of request/response services receiving responses synchronously

[Figure]

(c) Typed records used

The following shows the structure of typed buffers used for communication.

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 sample
  10  /* Example of XATMI interface definition of SUP  *
  15   * (cvsupcb.def file)                            */
  20  called_servers = { "cvsppcb.def" };
  10      *
  20      ***********************************************
  30      * Example of SUP (rrsup.cbl file)             *
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID.  MAIN.
  90      *
 100      ***********************************************
 110      * Set the data area
 120      ***********************************************
 130      *
 140       DATA DIVISION.
 150       WORKING-STORAGE SECTION.
 160      ***********************************************
 170      * Declare variables
 180      ***********************************************
 190      ***** typed record for SVHOTEL *****
 200       01  HOTEL-REQ.
 210           COPY HOTEL.
 220      ***** type information for SVHOTEL *****
 230       01  HOTELTYPE-REC.
 240           COPY TPTYPE.
 250      ***** typed record for SVPLANE *****
 260       01  PLANE-REQ.
 270           COPY PLANE.
 280      ***** type information 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 information  *****
 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 (start the 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 (report completion of user     *
 955      * server start processing)                    *
 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 (service request (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 (service request (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 (receive response messages)
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      * Terminate processing
2460      ***********************************************
2470      *
2480       PROG-END.
2490      *
2500       DISPLAY 'CLIENT: SEE YOU LATER'
2510      *
2520      ***********************************************
2530      * RPC-CLOSE (terminate the UAP)
2540      ***********************************************
2550      *
2560       CALL 'CBLDCRPC' USING RPC-CL-ARG.
2570      *
2580       STOP RUN.
  10  # Example of user service definition (rrsup file)
  20  set  module              = "rrsup"
  30  set  receive_from        = none
  40  set  trn_expiration_time = 180
  50  set  trn_expiration_time_suspend = Y
(e) SPP sample
  10  /* Example of XATMI interface definition         *
  15   * (rrsppcb.def file)                            */
  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      * Example of SPP (rrspp.cbl file)
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID.     MAIN.
  90      *
 100      ***********************************************
 110      * Set the data area
 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 (start the 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 (start the SPP service)
 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      * End of program
 600      ***********************************************
 610       PROG-END.
 620      *
 630      ***********************************************
 640      * RPC-CLOSE (terminate the UAP)
 650      ***********************************************
 660      *
 670       CALL 'CBLDCRPC' USING RPC-CL-ARG.
 680      *
 690      ***********************************************
 700      * Terminate the processing
 710      ***********************************************
 720      *
 730       STOP RUN.
(f) SPP coding sample (service program)

The following shows a coding example (service program) of the SPP that was presented in the example of the request/response service.

  10      *
  20      ***********************************************
  30      * Example of SPP service functions (shotel.cbl file)
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID.     SHOTEL.
  90      *
 100      ***********************************************
 110      * Set the data area
 120      ***********************************************
 130      *
 140       DATA DIVISION.
 150       WORKING-STORAGE SECTION.
 160      *
 170      ***********************************************
 180      * Declare variables
 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 returns status=0 if the specified hotel
 650      * can makea reservation. Shotel returns status=1
 660      * if there are no rooms in the specified hotel.
 670      * In this case, shotel return status=1 because
 680      * there are no rooms.
 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      * Terminate processing
 860      ***********************************************
 870      *
 880      *
 890       END PROGRAM SHOTEL.
 
  10      *
  20      ***********************************************
  30      * Example of SPP service functions (splane.cbl file)
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID.     SPLANE.
  90      *
 100      ***********************************************
 110      * Set the data area
 120      ***********************************************
 130      *
 140       DATA DIVISION.
 150       WORKING-STORAGE SECTION.
 160      *
 170      ***********************************************
 180      * Declare variables
 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 returns status=0 if a seat on the specified flight
 650      * can be ticketed. Splane returns status=1 if there aren't any
 660      * seats on the specified flight.
 670      *   In this case, splane returns status=1 because there are no
 680      * seats.
 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      * Terminate processing
 860      ***********************************************
 870      *
 880      *
 890       END PROGRAM SPLANE.
  10  # Example of user service definition (rrspp file)
  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"

(2) Conversational service paradigm sample

(a) Outline of processing

The processing of the sample here is outlined below.

The service program is activated through a typed record having data of ACCTREQ. The members of ACCTREQ indicate the upper and lower limits of the account numbers. The service program sets account data in this range in the typed record having data of ACCTDAT and sends the data to the originator of the conversation.

(b) UAP configuration

The following figure shows the configuration of the sample UAP.

Figure 6-5 Communication of conversational service

[Figure]

(c) Typed records used

The structures of typed records used are shown below.

Data for activating the service program
    ACCTREQ.cbl
              05 UPPERNO          PIC S9(9) COMP-5.
              05 LOWERNO          PIC S9(9) COMP-5. 

Data for communication with the conversational service
              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 sample
  10  /*  Example of XATMI interface definition (rrsupcb.def file) */
  20  called_servers = { "rrsppcb.def" } ;
  10      *
  20      ***********************************************
  30      * Example of SUP (convsup.cbl file)
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID. MAIN.
  90      *
 100      ***********************************************
 110      * Set the data area
 120      ***********************************************
 130      *
 140       DATA DIVISION.
 150       WORKING-STORAGE SECTION.
 160      ***********************************************
 170      * Declare constants
 180      ***********************************************
 190      ***********************************************
 200      * Declare variables
 210      ***********************************************
 220      ***** typed record for INQUIRY when inquiry service *****
 230       01  ACCTREQ-REC.
 240           COPY ACCTREQ.
 250      ***** type information for INQUIRY *****
 260       01  ACCTREQTYPE-REC.
 270           COPY TPTYPE.
 280      ***** service definition for INQUIRY *****
 290       01  ACCTREQDEF-REC.
 300           COPY TPSVCDEF.
 310      ***** return record *****
 320       01  STATUS-REC.
 330           COPY TPSTATUS.
 340      ***** received record between INQUIRY and CONVSUP
 350       01  ACCTDATA-REQ.
 360           COPY ACCTDATA.
 370      **** type information received record between INQUIRY and CONVSUP
 380       01  ACCTDATATYPE-REC.
 390           COPY TPTYPE.
 400      ***** service definition for INQUIRY *****
 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 information  *****
 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 (start the 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 (open the resource manager)
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                  *
          * (set the transaction monitoring interval)   *
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 (report completion of          *
1265      * user server start processing)               *
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
1375      * (unchained mode settings)
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 (start transaction)
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 (request service (INQUIRY))
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: INQUIRY 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 (receive data)
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 (commit transaction)
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 OCCURRED IN INQUIRY SERVICE'
2430               DISPLAY 'CODE =' TPEVENT OF STATUS-REC
2440      *
2450      ***********************************************
2460      *   TX-ROLLBAK (roll back transaction)
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 (roll back transaction)
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      * Terminate processing
2760      ***********************************************
2770      *
2780       PROG-END.
2790      *
2800       DISPLAY 'CLIENT: SEE YOU LATER'
2810      *
2820      ***********************************************
2830      * RPC-CLOSE (terminate the UAP)
2840      ***********************************************
2850      *
2860       CALL 'CBLDCRPC' USING RPC-CL-ARG.
2870      *
2880       STOP RUN.
  10  # Example of user service definition (convsup file)
  20  set module     "convsup" # Name of executable file
  30  set watch_time = 180     # Maximum time to wait
                               # for a response
  40  set receive_from = none   # Receiving method
  50  set trn_expiration_time = 180
  60            # Expiry time in transaction branch
  70  set trn_expiration_time_suspend = Y # Always specify Y
(e) SPP sample
  10  /* Example of XATMI interface definition of      *
  15   * SPP (cvsppcb.def file)                        */
  20  X_COMMON acctreq {
  30      long   upperno;
  40      long   lowerno;
  50  };
  60  X_COMMON acctdata {
  70      long   acctno;
  80      char   name[128];
  90      short  amount;
 100  };
 110  service INQUIRY(X_COMMON acctreq) ;
  10      *
  20      ***********************************************
  30      * Example of SPP (convspp.cbl file)
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID.     MAIN.
  90      *
 100      ***********************************************
 110      * Set the data area
 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 (start the 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 (start the SPP service)
 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      * Terminate the program
 600      ***********************************************
 610       PROG-END.
 620      *
 630      ***********************************************
 640      * RPC-CLOSE (terminate the UAP)
 650      ***********************************************
 660      *
 670       CALL 'CBLDCRPC' USING RPC-CL-ARG.
 680      *
 690      ***********************************************
 700      * Terminate processing
 710      ***********************************************
 720      *
 730       STOP RUN.
  10      *
  20      ***********************************************
  30      * INQUIRY    service program (convsvc.cbl file)
  40      ***********************************************
  50      *
  60       IDENTIFICATION DIVISION.
  70      *
  80       PROGRAM-ID.     INQUIRY.
  90      *
 100      ***********************************************
 110      * Set the data area
 120      ***********************************************
 130      *
 140       DATA DIVISION.
 150       WORKING-STORAGE SECTION.
 160      *
 170      ***********************************************
 180      * Declare variables
 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      * Inquiry processing
 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      * Set the send data
 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 (send the first data)
 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 (send the second data)
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 (terminate the receive program)
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      * Terminate processing
1420      ***********************************************
1430      *
1440      *
1450       END PROGRAM INQUIRY.
  10  # Example of user service definition (convspp file)
  20    set  service_group = "convspp_svg"
  25                          # Service group name
  30    set  module = "convspp" # Name of executable file
  40    set  service = "INQUIRY=inquiry"
  50               # Service name = entry point name
  60    set  watch_time = 180  # Maximum time to wait
  65                           # for a response
  70    set  trn_expiration_time =  240
  80             # Expiry time in transaction branch
  90    set  trn_expiration_time_suspend = Y # Always
  95                                         # specify Y
 100    set  server_type = "xatmi" # Server type
 110    set  receive_from = "socket"  # Receiving method