![[Contents]](FIGURE/CONTENT.GIF)
OpenTP1 Version 7 Programming Reference COBOL Language
![[Index]](FIGURE/INDEX.GIF)
![[Back]](FIGURE/FRONT.GIF)
![[Next]](FIGURE/AFTER.GIF)
The figure below shows an example of a message exchange UAP.
Figure 6-3 Message exchange UAP configuration sample (MHP)
![[Figure]](FIGURE/ZU060800.GIF)
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.
All Rights Reserved. Copyright (C) 2006, 2010, Hitachi, Ltd.