![[Contents]](FIGURE/CONTENT.GIF)
OpenTP1 Version 7 Programming Reference COBOL Language
![[Index]](FIGURE/INDEX.GIF)
![[Back]](FIGURE/FRONT.GIF)
![[Next]](FIGURE/AFTER.GIF)
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.
The following figure shows the configuration of the sample UAP.
Figure 6-4 Communication of request/response services receiving responses synchronously
![[Figure]](FIGURE/ZU061200.GIF)
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.
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
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.
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"
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.
The following figure shows the configuration of the sample UAP.
Figure 6-5 Communication of conversational service
![[Figure]](FIGURE/ZU062100.GIF)
The structures of typed records used are shown below.
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).
|
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
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
All Rights Reserved. Copyright (C) 2006, 2010, Hitachi, Ltd.