OpenTP1 Version 7 Programming Reference COBOL Language

[Contents][Index][Back][Next]

6.3 Coding samples for message exchange UAPs (MHP)

The figure below shows an example of a message exchange UAP.

Figure 6-3 Message exchange UAP configuration sample (MHP)

[Figure]

This section presents a coding example based on the configuration sample shown in the figure.

Organization of this section
(1) MHP sample (main program)
(2) MHP sample (service program)
(3) MHP sample (service program in DML)

(1) MHP sample (main program)

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.

(2) MHP sample (service program)

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.

(3) MHP sample (service program in DML)

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.