The figure below shows an example of a message exchange UAP.
Figure 6-3 Message exchange UAP configuration sample (MHP)
This section presents a coding example based on the configuration sample shown in the figure.
The following shows a coding example for the MHP main program.
10 *
20 **********************************************
30 * MHP main program *
40 **********************************************
50 *
60 IDENTIFICATION DIVISION.
70
80 PROGRAM-ID. CBMAIN.
90
100 ENVIRONMENT DIVISION.
110 CONFIGURATION SECTION.
120 *
130 **********************************************
140 * Work variable *
150 **********************************************
160 *
170 DATA DIVISION.
180 WORKING-STORAGE SECTION.
190 *
200 **********************************************
210 * RPC-OPEN data area *
220 **********************************************
230 *
240 01 ROPEN-PARM1.
250 02 ROPEN-NAME PIC X(8) VALUE 'OPEN '.
260 02 ROPEN-STATUS PIC X(5).
270 02 FILLER PIC X(3).
280 02 RO-FLG PIC S9(9) COMP VALUE ZERO.
290 *
300 **********************************************
310 * MCF-OPEN data area *
320 **********************************************
330 *
340 01 MOPEN-PARM1.
350 02 MOPEN-NAME PIC X(8) VALUE 'OPEN '.
360 02 MOPEN-STATUS PIC X(5).
370 02 FILLER PIC X(3).
380 02 MO-FLG1 PIC S9(9) COMP VALUE ZERO.
390 02 MO-RSV PIC X(12) VALUE LOW-VALUE.
400 *
410 **********************************************
420 * MCF-MAINLOOP data area *
430 **********************************************
440 *
450 01 MAIN-PARM1.
460 02 MAIN-NAME PIC X(8) VALUE 'MAINLOOP'.
470 02 MAIN-STATUS PIC X(5).
480 02 FILLER PIC X(3).
490 02 M-RSV PIC X(16) VALUE LOW-VALUE.
500 *
510 **********************************************
520 * MCF-CLOSE data area *
530 **********************************************
540 *
550 01 MCLSE-PARM1.
560 02 MCLSE-NAME PIC X(8) VALUE 'CLOSE '.
570 02 MCLSE-STATUS PIC X(5).
580 02 MFILLER PIC X(3).
590 02 MC-FLG1 PIC S9(9) COMP VALUE ZERO.
600 02 MC-RSV PIC X(12) VALUE LOW-VALUE.
610 *
620 *********************************************
630 * RPC-CLOSE data area *
640 *********************************************
650 *
660 01 RCLSE-PARM1.
670 02 RCLSE-NAME PIC X(8) VALUE 'CLOSE '.
680 02 RCLSE-STATUS PIC X(5).
690 02 FILLER PIC X(3).
700 02 RC-FLG PIC S9(9) COMP VALUE ZERO.
710 *
720 PROCEDURE DIVISION.
730 *
740 *********************************************
750 * RPC-OPEN (start the UAP) *
760 *********************************************
770 *
780 CALL 'CBLDCRPC' USING ROPEN-PARM1.
790 IF ROPEN-STATUS IS NOT EQUAL TO '00000'
800 GO TO RCLOS.
810 *
820 *********************************************
830 * MCF-OPEN (open the MCF environment) *
840 *********************************************
850 *
860 CALL 'CBLDCMCF' USING MOPEN-PARM1.
870 IF MOPEN-STATUS IS NOT EQUAL TO '00000'
880 GO TO RCLOS.
890 *
900 *********************************************
910 * MCF-MAINLOOP (start the MHP service) *
920 *********************************************
930 *
940 CALL 'CBLDCMCF' USING MAIN-PARM1.
950 *
960 *********************************************
970 * MCF-CLOSE (close the MCF environment) *
980 *********************************************
990 *
1000 CALL 'CBLDCMCF' USING MCLSE-PARM1.
1010 *
1020 *********************************************
1030 * RPC-CLOSE (terminate the UAP) *
1040 *********************************************
1050 *
1060 RCLOS.
1070 CALL 'CBLDCRPC' USING RCLSE-PARM1.
1080 *
1090 **********************************************
1100 * Terminate processing *
1110 **********************************************
1120 *
1130 STOP RUN.
The following shows a coding example for the MHP service program.
10 *
20 **********************************************
30 * MHP service program *
40 **********************************************
50 *
60 IDENTIFICATION DIVISION.
70
80 PROGRAM-ID. SVRA.
90
100 ENVIRONMENT DIVISION.
110 CONFIGURATION SECTION.
120 *
130 **********************************************
140 * Work variable *
150 **********************************************
160 *
170 DATA DIVISION.
180 WORKING-STORAGE SECTION.
190 *
200 **********************************************
210 * MCF-RECEIVE data area *
220 **********************************************
230 *
240 01 RECV-PARM1.
250 02 RECV-NAME PIC X(8) VALUE 'RECEIVE '.
260 02 RECV-STATUS PIC X(5).
270 02 FILLER PIC X(3).
280 02 FRST-ID PIC X(4) VALUE 'FRST'
290 02 RE-RSV1 PIC X(4) VALUE SPACE.
300 02 DATE-ID PIC 9(8).
310 02 TIME-ID PIC 9(8).
320 02 RE-LENG PIC 9(9) COMP VALUE 1024.
330 02 RE-RSV2 PIC X(4) VALUE SPACE.
340 02 RE-RSV3 PIC X(4) VALUE SPACE.
350 02 RE-RSV4 PIC X(4) VALUE SPACE.
360 02 RE-RSV5 PIC X(4) VALUE SPACE.
370 02 RE-RSV6 PIC X(8) VALUE SPACE.
380 02 RE-RSV7 PIC X(4) VALUE SPACE.
390 02 RE-RSV8 PIC X(8) VALUE SPACE.
400 02 RE-RSV9 PIC X(4) VALUE SPACE.
410 02 RE-RSV10 PIC 9(9) COMP VALUE ZERO.
420 02 RE-RSV11 PIC 9(9) COMP VALUE ZERO.
430 02 RE-RSV12 PIC X(1) VALUE SPACE.
440 02 RE-RSV13 PIC X(1) VALUE '1'.
450 02 RE-RSV14 PIC X(14) VALUE LOW-VALUE.
460 01 RECV-PARM2.
470 02 RE-RSV15 PIC X(4) VALUE SPACE.
480 02 TERM-ID PIC X(8).
490 02 RE-RSV16 PIC X(8) VALUE SPACE.
500 02 RE-RSV17 PIC X(8) VALUE SPACE.
510 02 RE-RSV18 PIC X(28) VALUE LOW-VALUE.
520 01 RECV-PARM3.
530 02 RE-DATALENG PIC 9(9) COMP.
540 02 RE-RSV19 PIC X(8).
550 02 RE-DATA PIC X(1024).
560 *
570 **********************************************
580 * MCF-EXECAP data area *
590 **********************************************
600 *
610 01 EXEC-PARM1.
620 02 EXEC-NAME PIC X(8) VALUE 'EXECAP '.
630 02 EXEC-STATUS PIC X(5).
640 02 FILLER PIC X(3).
650 02 EX-RSV1 PIC X(4) VALUE SPACE.
660 02 EX-RSV2 PIC X(4) VALUE SPACE.
670 02 EX-RSV3 PIC 9(8).
680 02 EX-RSV4 PIC 9(8).
690 02 EX-RSV5 PIC 9(9) COMP VALUE ZERO.
700 02 EX-EMI PIC X(4) VALUE 'EMI '.
710 02 EX-RSV6 PIC X(4) VALUE SPACE.
720 02 EX-RSV7 PIC X(4) VALUE SPACE.
730 02 EX-RSV8 PIC X(4) VALUE SPACE.
740 02 EX-TIME PIC X(8) VALUE '00000000'.
750 02 EX-RSV9 PIC X(4) VALUE SPACE.
760 02 EX-RSV10 PIC X(8) VALUE 'aprepB '.
770 02 EX-EXEC PIC X(4) VALUE 'JUST'.
780 02 EX-RSV11 PIC 9(9) COMP VALUE ZERO.
790 02 EX-RSV12 PIC 9(9) COMP VALUE ZERO.
800 02 EX-RSV13 PIC X(1) VALUE SPACE.
810 02 EX-RSV14 PIC X(1) VALUE '1'.
820 02 EX-RSV15 PIC X(14) VALUE LOW-VALUE.
830 01 EXEC-PARM2.
840 02 EX-RSV16 PIC X(4) VALUE SPACE.
850 02 EX-RSV17 PIC X(8) VALUE SPACE.
860 02 EX-RSV18 PIC X(8) VALUE SPACE.
870 02 EX-RSV19 PIC X(8) VALUE SPACE.
880 02 EX-RSV20 PIC X(28) VALUE LOW-VALUE.
890 01 EXEC-PARM3.
900 02 EX-DATALENG PIC 9(9) COMP VALUE 16.
910 02 EX-RSV21 PIC X(8).
920 02 EX-DATA PIC X(16) VALUE 'SVRA EXECAP DATA'.
930 *
940 **********************************************
950 * MCF-REPLY data area *
960 **********************************************
970 *
980 01 RPLY-PARM1.
990 02 RPLY-NAME PIC X(8) VALUE 'REPLY '.
1000 02 RPLY-STATUS PIC X(5).
1010 02 FILLER PIC X(3).
1020 02 RP-RSV1 PIC X(4) VALUE SPACE.
1030 02 RP-RSV2 PIC X(4) VALUE SPACE.
1040 02 RP-RSV3 PIC 9(8).
1050 02 RP-RSV4 PIC 9(8).
1060 02 RP-RSV5 PIC 9(9) COMP VALUE ZERO.
1070 02 RP-EMI PIC X(4) VALUE'EMI '.
1080 02 RP-RSV6 PIC X(4) VALUE SPACE.
1090 02 RP-RSV7 PIC X(4) VALUE SPACE.
1100 02 RP-RSV8 PIC X(4) VALUE SPACE.
1110 02 RP-RSV9 PIC X(8) VALUE SPACE.
1120 02 RP-RSV10 PIC X(4) VALUE SPACE.
1130 02 RP-RSV11 PIC X(8) VALUE SPACE.
1140 02 RP-RSV12 PIC X(4) VALUE SPACE.
1150 02 RP-RSV13 PIC 9(9) COMP VALUE ZERO.
1160 02 RP-RSV14 PIC 9(9) COMP VALUE ZERO.
1170 02 RP-RSV15 PIC X(1) VALUE SPACE.
1180 02 RP-RSV16 PIC X(1) VALUE '1'.
1190 02 RP-RSV17 PIC X(14) VALUE LOW-VALUE.
1200 01 RPLY-PARM2.
1210 02 RP-RSV18 PIC X(4) VALUE SPACE.
1220 02 RP-RSV19 PIC X(8) VALUE SPACE.
1230 02 RP-RSV20 PIC X(8) VALUE SPACE.
1240 02 RP-RSV21 PIC X(8) VALUE SPACE.
1250 02 RP-RSV22 PIC X(28) VALUE LOW-VALUE.
1260 01 RPLY-PARM3.
1270 02 RP-DATALENG PIC 9(9) COMP VALUE 16.
1280 02 RP-RSV23 PIC X(8).
1290 02 RP-DATA PIC X(16) VALUE 'SVRA REPLY DATA1'.
1300 *
1310 **********************************************
1320 * MCF-ROLLBACK data area *
1330 **********************************************
1340 *
1350 01 RBK-PARM1.
1360 02 RBK-NAME PIC X(8) VALUE 'ROLLBACK'.
1370 02 RBK-STATUS PIC X(5).
1380 02 FILLER PIC X(3).
1390 02 RBK-ACTION PIC X(4) VALUE 'NRTN'.
1400 02 RBK-RSV1 PIC X(12) VALUE LOW-VALUE.
1410
1420 PROCEDURE DIVISION.
1430 *
1440 **********************************************
1450 * MCF-RECEIVE (receive messages) *
1460 **********************************************
1470 *
1480 CALL 'CBLDCMCF' USING RECV-PARM1 RECV-PARM2 RECV-PARM3.
1490 IF RECV-STATUS IS NOT EQUAL TO '00000'
1500 *
1510 **********************************************
1520 * MCF-ROLLBACK (error processing) *
1530 **********************************************
1540 *
1550 CALL 'CBLDCMCF' USING RBK-PARM1.
1560 *
1570 **********************************************
1580 * MCF-EXECAP (start the application program)*
1590 **********************************************
1600 *
1610 CALL 'CBLDCMCF' USING EXEC-PARM1 EXEC-PARM2 EXEC-PARM3.
1620 IF EXEC-STATUS IS NOT EQUAL TO '00000'
1630 *
1640 **********************************************
1650 * MCF-ROLLBACK (error processing) *
1660 **********************************************
1670 *
1680 CALL 'CBLDCMCF' USING RBK-PARM1.
1690 *
1700 **********************************************
1710 * MCF-REPLY (send a response message) *
1720 **********************************************
1730 *
1740 CALL 'CBLDCMCF' USING RPLY-PARM1 RPLY-PARM2 RPLY-PARM3.
1750 IF RPLY-STATUS IS NOT EQUAL TO '00000'
1760 *
1770 **********************************************
1780 * MCF-ROLLBACK (error processing) *
1790 **********************************************
1800 *
1810 CALL 'CBLDCMCF' USING RBK-PARM1.
1820 *
1830 **********************************************
1840 * Terminate processing *
1850 **********************************************
1860 *
1870 EXIT PROGRAM.
The following shows a coding example for the MHP service program written in the data manipulation language (DML).
10 *
20 **********************************************
30 * MHP service program *
40 **********************************************
50 *
60 IDENTIFICATION DIVISION.
70
80 PROGRAM-ID. SVRA.
90
100 ENVIRONMENT DIVISION.
110 CONFIGURATION SECTION.
120 *
130 **********************************************
140 * Work variable *
150 **********************************************
160 *
170 DATA DIVISION.
180 WORKING-STORAGE SECTION.
190 *
200 **********************************************
210 * Area for receiving messages *
220 **********************************************
230 *
240 01 RECV-AREA.
250 02 RE-DATALENG PIC 9(4) COMP VALUE 1028.
260 02 RE-RSV1 PIC X(2).
270 02 RE-DATA PIC X(1024).
280 *
290 **********************************************
300 * Application start message area *
310 **********************************************
320 *
330 01 SEND-PRO-AREA.
340 02 PRO-DATALENG PIC 9(4) COMP VALUE 20.
350 02 PRO-RSV1 PIC X(2).
360 02 PRO-DATA PIC X(16) VALUE 'SVRA EXECAP DATA'.
370 *
380 **********************************************
390 * Response message transmission area *
400 **********************************************
410 *
420 01 SEND-IO-AREA.
430 02 IO-DATALENG PIC 9(4) COMP VALUE 20.
440 02 IO-RSV1 PIC X(2).
450 02 IO-DATA PIC X(16) VALUE 'SVRA REPLY DATA1'.
460 *
470 **********************************************
480 * Communication description entry *
490 **********************************************
500 *
510 COMMUNICATION SECTION.
520 *
530 **********************************************
540 * Receive messages *
550 **********************************************
560 *
570 CD RECV-INF
580 FOR INPUT
590 STATUS KEY IS RE-STATUS
600 SYMBOLIC TERMINAL IS RE-TERMNAM
610 MESSAGE DATE IS RE-DATE
620 MESSAGE TIME IS RE-TIME.
630 *
640 *********************************************
650 * Start the application program *
660 *********************************************
670 *
680 CD SEND-PRO
690 FOR OUTPUT PROGRAM
700 STATUS KEY IS SE-STATUS-PRO
710 SYMBOLIC TERMINAL IS SE-TERMNAM-PRO.
720 *
730 *********************************************
740 * Send response messages *
750 *********************************************
760 *
770 CD SEND-IO
780 FOR I-O
790 STATUS KEY IS SE-STATUS-IO
800 SYNCHRONOUS MODE IS ASYNC.
810
820 PROCEDURE DIVISION.
830
840 *
850 *********************************************
860 * Receive messages *
870 *********************************************
880 *
890 RECEIVE RECV-INF
900 FIRST SEGMENT
910 INTO RECV-AREA.
920 IF RE-STATUS IS NOT EQUAL '00000'
930 *
940 *********************************************
950 * Partial recovery *
960 *********************************************
970 *
980 ROLLBACK WITH STOPPING.
990 *
1000 *********************************************
1010 * Start the application program *
1020 *********************************************
1030 *
1040 MOVE 'aprepB ' TO SE-TERMNAM-PRO
1050 SEND SEND-PRO
1060 FROM SEND-PRO-AREA
1070 WITH EMI.
1080 IF SE-STATUS-PRO IS NOT EQUAL '00000'
1090 *
1100 *********************************************
1110 * Partial recovery *
1120 *********************************************
1130 *
1140 ROLLBACK WITH STOPPING.
1150 *
1160 *********************************************
1170 * Send response messages *
1180 *********************************************
1190 *
1200 SEND SEND-IO
1210 FROM SEND-IO-AREA
1220 WITH EMI.
1230 IF SE-STATUS-IO IS NOT EQUAL '00000'
1240 *
1250 *********************************************
1260 * Partial recovery *
1270 *********************************************
1280 *
1290 ROLLBACK WITH STOPPING.
1300 *
1310 *********************************************
1320 * Terminate processing *
1330 *********************************************
1340 *
1350 EXIT PROGRAM.