6.4.2 TX interface sample

This subsection shows a coding example for an SUP that uses the X/Open TX interface. This SUP uses TX-interfaced transaction control for processing that was described in 6.1 Coding samples for client/server UAPs (SUP, SPP DAM access). See 6.1 Coding samples for client/server UAPs (SUP, SPP DAM access) for the process configuration and details of the SPP to which the service request is addressed. However, TX-RETURN-STATUS at line numbers 460 and 470 are redefined as RS REDEFINES TX-RETURN-STATUS because it cannot be correctly referenced if it is directly invoked from the process.

 10  *
 20  ***************************************************
 30  * SUP01                                           *
 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-ARG1.
170       02 REQUEST      PIC X(8) VALUE SPACE.
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-ARG2.
230       02 REQUEST      PIC X(8) VALUE SPACE.
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       02 DESCRIPTOR   PIC S9(9) COMP VALUE ZERO.
280       02 S-NAME       PIC X(32) VALUE SPACE.
290       02 G-NAME       PIC X(32) VALUE SPACE.
300  *
310   01  RPC-ARG3.
320       02  SEND-DATA-LENG  PIC S9(9) COMP VALUE ZERO.
330       02  SEND-DATA       PIC X(32) VALUE SPACE.
340  *
350   01  RPC-ARG4.
360       02  RECEIVE-DATA-LENG PIC S9(9) COMP VALUE ZERO.
370       02  RECEIVE-DATA      PIC X(32) VALUE SPACE.
380  *
390   01  ADM-ARG1.
400       02  REQUEST      PIC X(8) VALUE SPACE.
410       02  STATUS-CODE  PIC X(5) VALUE SPACE.
420       02  FILLER       PIC X(3).
430       02  FLAGS        PIC S9(9) COMP VALUE ZERO.
440       02  FILLER       PIC X(3).
450  *
460   01  TX-RETURN-STATUS.
470       COPY TXSTATUS.
480  *
490   01  RS REDEFINES TX-RETURN-STATUS.
500       05 RSVAL         PIC S9(9) COMP-5.
510  *
520   01  TX-INFO-AREA.
530       COPY TXINFDEF.
540  *
550   PROCEDURE DIVISION.
560  *
570  ***************************************************
580  * RPC-OPEN (start the UAP)                        *
590  ***************************************************
600  *
610   MOVE 'OPEN' TO REQUEST OF RPC-ARG1.
620   MOVE ZERO   TO FLAGS  OF RPC-ARG1.
630   CALL 'CBLDCRPC' USING RPC-ARG1.
640       IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN
650         DISPLAY 'SUP01:RPC-OPEN FAILED. CODE = '
660         STATUS-CODE OF RPC-ARG1
670         GO TO PROG-END
680       END-IF.
690  *
700  ***************************************************
710  * TX-OPEN (open the resource manager)             *
720  ***************************************************
730  *
740   CALL 'TXOPEN' USING TX-RETURN-STATUS.
750       IF RSVAL OF RS NOT = 0 THEN
760         DISPLAY 'SUP01:TX-OPEN FAILED. CODE = '
770         RSVAL OF RS
780         GO TO PROG-END
790       END-IF.
800  *
810  ***************************************************
820  * TX-SET-TRANSACTION-TIMEOUT                      *
     * (set the transaction monitoring interval)       *
830  ***************************************************
840  *
850   MOVE 180 TO TRANSACTION-TIMEOUT OF TX-INFO-AREA.
860   CALL 'TXSETTIMEOUT' USING TX-INFO-AREA TX-RETURN-STATUS.
870       IF RSVAL OF RS NOT = 0 THEN
880         DISPLAY 'SUP01:TX-SET-TRANSACTION-TIMEOUT FAILED. CODE = '
890         RSVAL OF RS
900         GO TO PROG-END
910       END-IF.
920  *
930  ***************************************************
940  * ADM-COMPLETE (report completion of user         *
     * server start processing)                        *
950  ***************************************************
960  *
970   MOVE 'COMPLETE' TO REQUEST OF ADM-ARG1.
980   CALL 'CBLDCADM' USING ADM-ARG1.
990       IF STATUS-CODE OF ADM-ARG1 NOT = '00000' THEN
1000         DISPLAY 'SUP01:ADM-COMPLETE FAILED. CODE = '
1010         STATUS-CODE OF ADM-ARG1
1020         GO TO PROG-END
1030       END-IF.
1040  *
1050  ***************************************************
1060  * TX-BEGIN (start the transaction)                *
1070  ***************************************************
1080  *
1090   CALL 'TXBEGIN' USING TX-RETURN-STATUS.
1100       IF RSVAL OF RS NOT = 0 THEN
1110         DISPLAY 'SUP01:TX-BEGIN FAILED. CODE = '
1120         RSVAL OF RS
1130         GO TO TRAN-END
1140       END-IF.
1150  *
1160  ***************************************************
1170  * TX-INFO (acquire transaction information)       *
1180  ***************************************************
1190  *
1200   CALL 'TXINFORM' USING TX-INFO-AREA TX-RETURN-STATUS.
1210       IF RSVAL OF RS <= 0 THEN
1220         DISPLAY 'SUP01:NOT IN TRANSACTION. CODE = '
1230         RSVAL OF RS
1240         GO TO PROG-END
1250       ELSE
1260         IF RSVAL OF RS = 1 THEN
1270           DISPLAY 'SUP01:RETURN = ' COMMIT-RETURN
1280           DISPLAY 'SUP01:CONTROL = ' TRANSACTION-CONTROL
1290           DISPLAY 'SUP01:TIMEOUT = ' TRANSACTION-TIMEOUT
1300           DISPLAY 'SUP01:STATE = ' TRANSACTION-STATE
1310         END-IF
1320       END-IF.
1330  ***************************************************
1340  * RPC-CALL (request a remote service)             *
1350  ***************************************************
1360  *
1370   MOVE 'CALL' TO REQUEST OF RPC-ARG2.
1380   MOVE 'SVR01' TO G-NAME OF RPC-ARG2.
1390   MOVE 'SVR01' TO S-NAME OF RPC-ARG2.
1400   MOVE 'SUP01:DATA OpenTP1' TO SEND-DATA OF RPC-ARG3.
1410   MOVE 32 TO SEND-DATA-LENG OF RPC-ARG3.
1420   MOVE 32 TO RECEIVE-DATA-LENG OF RPC-ARG4.
1430   CALL 'CBLDCRPC' USING RPC-ARG2 RPC-ARG3 RPC-ARG4.
1440       IF STATUS-CODE OF RPC-ARG2 NOT = '00000' THEN
1450         DISPLAY 'SUP01:RPC-CALL RETURN CODE = '
1460         STATUS-CODE OF RPC-ARG2
1470  *       GO TO TRAN-END
1480       END-IF.
1490   DISPLAY 'SERVICE FUNCTION RETURN = ' RECEIVE-DATA.
1500   TRAN-END.
1510  *
1520  ***************************************************
1530  * TX-SET-TRANSACTION-CONTROL (set the unchained    *
1535  * mode)                                           *
1540  ***************************************************
1550  *
1560   MOVE 0 TO TRANSACTION-CONTROL OF TX-INFO-AREA.
1570   CALL 'TXSETTRANCTL' USING TX-INFO-AREA TX-RETURN-STATUS.
1580       IF RSVAL OF RS NOT = 0 THEN
1590         DISPLAY 'SUP01:TX-SET-TRANSACTION-CONTROL FAILED. CODE = '
1600         RSVAL OF RS
1610       END-IF.
1620  *
1630  ***************************************************
1640  * TX-COMMIT (commit in unchained mode)            *
1650  ***************************************************
1660  *
1670   CALL 'TXCOMMIT' USING TX-RETURN-STATUS.
1680       IF RSVAL OF RS NOT = 0 THEN
1690         DISPLAY 'SUP01:TX-COMMIT FAILED. CODE = '
1700         RSVAL OF RS
1710       END-IF.
1720   PROG-END.
1730  *
1740  ***************************************************
1750  * RPC-CLOSE (terminate the UAP)                   *
1760  ***************************************************
1770  *
1780   MOVE 'CLOSE' TO REQUEST OF RPC-ARG1.
1790   MOVE ZERO    TO FLAGS  OF RPC-ARG1.
1800   CALL 'CBLDCRPC' USING RPC-ARG1.
1810   DISPLAY 'SUP01:SUP PROCESS ENDED'.
1820   STOP RUN.