6.3 メッセージ送受信形態のUAPのコーディング例(MHP)

メッセージ送受信形態のUAP構成例を次の図に示します。

図6-3 メッセージ送受信形態のUAP構成例(MHP)

[図データ]

ここでは,図に示した構成例のコーディング例を示します。

<この節の構成>
(1) MHPの例(メインプログラム)
(2) MHPの例(サービスプログラム)
(3) MHPの例(サービスプログラム DMLの例)

(1) MHPの例(メインプログラム)

MHPのメインプログラムのコーディング例を次に示します。

 10       *
 20       ********************************************************
 30       * MHP メインプログラム                                 *
 40       ********************************************************
 50       *
 60        IDENTIFICATION DIVISION.
 70
 80        PROGRAM-ID. CBMAIN.
 90
100        ENVIRONMENT DIVISION.
110        CONFIGURATION SECTION.
120       *
130       ********************************************************
140       *     ワーク変数                                       *
150       ********************************************************
160       *
170        DATA DIVISION.
180        WORKING-STORAGE SECTION.
190       *
200       ********************************************************
210       *  RPC-OPEN データ領域                                 *
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 データ領域                                 *
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 データ領域                             *
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 データ領域                                 *
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 データ領域                                 *
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(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(MCF環境のオープン)                        *
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(MHPのサービス開始)                    *
920        ********************************************************
930        *
940           CALL 'CBLDCMCF' USING MAIN-PARM1.
950        *
960        ********************************************************
970        *  MCF-CLOSE(MCF環境のクローズ)                        *
980        ********************************************************
990        *
1000           CALL 'CBLDCMCF' USING MCLSE-PARM1.
1010        *
1020        ********************************************************
1030        *  RPC-CLOSE(UAPの終了)                                *
1040        ********************************************************
1050        *
1060         RCLOS.
1070           CALL 'CBLDCRPC' USING RCLSE-PARM1.
1080        *
1090        ********************************************************
1100        *      終了処理                                        *
1110        ********************************************************
1120        *
1130           STOP RUN.

(2) MHPの例(サービスプログラム)

MHPのサービスプログラムのコーディング例を次に示します。

 10       *
 20       ********************************************************
 30       *    MHPサービスプログラム                             *
 40       ********************************************************
 50       *
 60        IDENTIFICATION DIVISION.
 70
 80        PROGRAM-ID. SVRA.
 90      
100        ENVIRONMENT DIVISION.
110        CONFIGURATION SECTION.
120       *
130       ********************************************************
140       *    ワーク変数                                        *
150       ********************************************************
160       *
170        DATA DIVISION.
180        WORKING-STORAGE SECTION.
190       *
200       ********************************************************
210       *    MCF-RECEIVEデータ領域                             *
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 データ領域                             *
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 データ領域                              *
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 データ領域                           *
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 (メッセージの受信)                    *
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 (エラー処理)                         *
1530       ********************************************************
1540       *
1550        CALL 'CBLDCMCF' USING RBK-PARM1.
1560       *
1570       ********************************************************
1580       *    MCF-EXECAP (アプリケーションプログラム起動)       *
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 (エラー処理)                         *
1660       ********************************************************
1670       *
1680        CALL 'CBLDCMCF' USING RBK-PARM1.
1690       *
1700       ********************************************************
1710       *    MCF-REPLY (応答メッセージの送信)                  *
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 (エラー処理)                         *
1790       ********************************************************
1800       *
1810        CALL 'CBLDCMCF' USING RBK-PARM1.
1820       *
1830       ********************************************************
1840       *    終了処理                                          *
1850       ********************************************************
1860       *
1870        EXIT PROGRAM.

(3) MHPの例(サービスプログラム DMLの例)

MHPのサービスプログラムをデータ操作言語(DML)で作成した場合のコーディング例を次に示します。

 10       *
 20       ********************************************************
 30       *    MHPサービスプログラム                             *
 40       ********************************************************
 50       *
 60        IDENTIFICATION DIVISION.
 70
 80        PROGRAM-ID. SVRA.
 90
100        ENVIRONMENT DIVISION.
110        CONFIGURATION SECTION.
120       *
130       ********************************************************
140       *    ワーク変数                                        *
150       ********************************************************
160       *
170        DATA DIVISION.
180        WORKING-STORAGE SECTION.
190       *
200       ********************************************************
210       *    メッセージ受信領域                                *
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       *    アプリケーション起動メッセージ領域                *
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       *    応答メッセージ送信領域                            *
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       *    通信記述項                                        *
490       ********************************************************
500       *
510        COMMUNICATION SECTION.
520       *
530       ********************************************************
540       *    メッセージの受信                                  *
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        *    アプリケーションプログラム起動                    *
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        *    応答メッセージの送信                              *
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        *    メッセージの受信                                  *
870        ********************************************************
880        *
890           RECEIVE RECV-INF
900                   FIRST SEGMENT
910                   INTO RECV-AREA.
920           IF RE-STATUS IS NOT EQUAL '00000'
930        *
940        ********************************************************
950        *    部分回復                                          *
960        ********************************************************
970        *
980           ROLLBACK WITH STOPPING.
990        *
1000        ********************************************************
1010        *    アプリケーションプログラム起動                    *
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        *    部分回復                                          *
1120        ********************************************************
1130        *
1140           ROLLBACK WITH STOPPING.
1150        *
1160        ********************************************************
1170        *    応答メッセージの送信                              *
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        *    部分回復                                          *
1270        ********************************************************
1280        *
1290           ROLLBACK WITH STOPPING.
1300        *
1310        ********************************************************
1320        *    終了処理                                          *
1330        ********************************************************
1340        *
1350           EXIT PROGRAM.