***************************************************************
* MHP SERVICE PROGRAM *
***************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. SVRA.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
***************************************************************
* WORKING STORAGE *
***************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
***************************************************************
* DATA AREA FOR MCF-RECEIVE *
***************************************************************
01 RECV-PARM1.
02 RECV-A PIC X(8) VALUE 'RECEIVE '.
02 RECV-B PIC X(5).
02 FILLER PIC X(3).
02 RECV-C PIC X(4) VALUE 'FRST'.
02 RECV-D PIC X(4) VALUE SPACE.
02 RECV-E PIC 9(8).
02 RECV-F PIC 9(8).
02 RECV-G PIC 9(9) COMP VALUE 1024.
02 RECV-H PIC X(4) VALUE SPACE.
02 RECV-I PIC X(4) VALUE SPACE.
02 RECV-J PIC X(4) VALUE SPACE.
02 RECV-K PIC X(4) VALUE SPACE.
02 RECV-L PIC X(8) VALUE SPACE.
02 RECV-M1 PIC X(4) VALUE SPACE.
02 RECV-M2 PIC X(8) VALUE SPACE.
02 RECV-M3 PIC X(4) VALUE SPACE.
02 RECV-M4 PIC 9(9) COMP VALUE ZERO.
02 RECV-M5 PIC 9(9) COMP VALUE ZERO.
02 RECV-M6 PIC X(1) VALUE SPACE.
02 RECV-M7 PIC X(1) VALUE SPACE.
02 RECV-N PIC X(14) VALUE LOW-VALUE.
01 RECV-PARM2.
02 RECV-O PIC X(4) VALUE SPACE.
02 RECV-P PIC X(8).
02 RECV-Q PIC X(8) VALUE SPACE.
02 RECV-R PIC X(8) VALUE SPACE.
02 RECV-T PIC X(28) VALUE LOW-VALUE.
01 RECV-PARM3.
02 RECV-U PIC 9(9) COMP.
02 RECV-V PIC X(8).
02 RECV-W PIC X(1024).
***************************************************************
* DATA AREA FOR MCF-EXECAP *
***************************************************************
01 EXEC-PARM1.
02 EXEC-A PIC X(8) VALUE 'EXECAP '.
02 EXEC-B PIC X(5).
02 FILLER PIC X(3).
02 EXEC-C PIC X(4) VALUE SPACE.
02 EXEC-D PIC X(4) VALUE SPACE.
02 EXEC-E PIC 9(8).
02 EXEC-F PIC 9(8).
02 EXEC-G PIC 9(9) COMP VALUE ZERO.
02 EXEC-H PIC X(4) VALUE 'EMI '.
02 EXEC-I PIC X(4) VALUE SPACE.
02 EXEC-J PIC X(4) VALUE SPACE.
02 EXEC-K PIC X(4) VALUE SPACE.
02 EXEC-L PIC X(8) VALUE '00000000'.
02 EXEC-M PIC X(4) VALUE SPACE.
02 EXEC-N PIC X(8) VALUE 'APL01 '.
02 EXEC-O1 PIC X(4) VALUE 'JUST'.
02 EXEC-O2 PIC 9(9) COMP VALUE ZERO.
02 EXEC-O3 PIC 9(9) COMP VALUE ZERO.
02 EXEC-O4 PIC X(1) VALUE SPACE.
02 EXEC-O5 PIC X(1) VALUE SPACE.
02 EXEC-P PIC X(14) VALUE LOW-VALUE.
01 EXEC-PARM2.
02 EXEC-Q PIC X(4) VALUE SPACE.
02 EXEC-R PIC X(8) VALUE SPACE.
02 EXEC-S PIC X(8) VALUE SPACE.
02 EXEC-T PIC X(6) VALUE SPACE.
02 EXEC-U PIC X(2) VALUE SPACE.
02 EXEC-V PIC X(28) VALUE LOW-VALUE.
01 EXEC-PARM3.
02 EXEC-W PIC 9(9) COMP VALUE 25.
02 EXEC-X PIC X(8).
02 EXEC-Y1 PIC X(9) VALUE SPACE.
02 EXEC-Y2 PIC X(16) VALUE 'SVRA EXECAP DATA'.
***************************************************************
* DATA AREA FOR MCF-SEND *
***************************************************************
01 SEND-PARM1.
02 SEND-A PIC X(8) VALUE 'SEND '.
02 SEND-B PIC X(5).
02 FILLER PIC X(3).
02 SEND-C PIC X(4) VALUE SPACE.
02 SEND-D PIC X(4) VALUE SPACE.
02 SEND-E PIC 9(8).
02 SEND-F PIC 9(8).
02 SEND-G PIC 9(9) COMP VALUE ZERO.
02 SEND-H PIC X(4) VALUE 'EMI '.
02 SEND-I PIC X(4) VALUE SPACE.
02 SEND-J PIC X(4) VALUE SPACE.
02 SEND-K PIC X(4) VALUE SPACE.
02 SEND-L PIC X(8) VALUE SPACE.
02 SEND-M1 PIC X(4) VALUE SPACE.
02 SEND-M2 PIC X(8) VALUE SPACE.
02 SEND-M3 PIC X(4) VALUE SPACE.
02 SEND-M4 PIC 9(9) COMP VALUE ZERO.
02 SEND-M5 PIC 9(9) COMP VALUE ZERO.
02 SEND-M6 PIC X(1) VALUE SPACE.
02 SEND-M7 PIC X(1) VALUE SPACE.
02 SEND-N PIC X(14) VALUE LOW-VALUE.
01 SEND-PARM2.
02 SEND-O PIC X(4) VALUE 'OUT '.
02 SEND-P PIC X(8) VALUE 'NFLE02 '.
02 SEND-Q PIC X(8) VALUE SPACE.
02 SEND-R PIC X(8) VALUE SPACE.
02 SEND-T PIC X(28) VALUE LOW-VALUE.
01 SEND-PARM3.
02 SEND-U PIC 9(9) COMP VALUE 25.
02 SEND-V PIC X(8).
02 SEND-W1 PIC X(9) VALUE X'C1D7D3F0F240404040'.
02 SEND-W2 PIC X(16) VALUE 'SVRA SEND DATA'.
***************************************************************
* DATA AREA FOR MCF-ROLLBACK *
***************************************************************
01 RBK-PARM1.
02 RBK-A PIC X(8) VALUE 'ROLLBACK'.
02 RBK-B PIC X(5).
02 FILLER PIC X(3).
02 RBK-C PIC X(4) VALUE 'NRTN'.
02 RBK-D PIC X(12) VALUE LOW-VALUE.
PROCEDURE DIVISION.
***************************************************************
* MCF-RECEIVE(RECEIVE OF MESSAGE) *
***************************************************************
CALL 'CBLDCMCF' USING RECV-PARM1 RECV-PARM2 RECV-PARM3.
IF RECV-B IS NOT EQUAL TO '00000'
***************************************************************
* MCF-ROLLBACK(ERROR PROCESSING) *
***************************************************************
CALL 'CBLDCMCF' USING RBK-PARM1.
***************************************************************
* MCF-EXECAP(APPLICATION PROGRAM BOOTING) *
***************************************************************
CALL 'CBLDCMCF' USING EXEC-PARM1 EXEC-PARM2 EXEC-PARM3.
IF EXEC-B IS NOT EQUAL TO '00000'
***************************************************************
* MCF-ROLLBACK(ERROR PROCESSING) *
***************************************************************
CALL 'CBLDCMCF' USING RBK-PARM1.
***************************************************************
* MCF-SEND(SEND OF MESSAGE) *
***************************************************************
CALL 'CBLDCMCF' USING SEND-PARM1 SEND-PARM2 SEND-PARM3.
IF SEND-B IS NOT EQUAL TO '00000'
***************************************************************
* MCF-ROLLBACK(ERROR PROCESSING) *
***************************************************************
CALL 'CBLDCMCF' USING RBK-PARM1.
***************************************************************
* END PROCESSING *
***************************************************************
EXIT PROGRAM.