分散トランザクション処理機能 OpenTP1 プロトコル TP1/NET/OSAS-NIF編
*************************************************************** * 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.
All Rights Reserved. Copyright (C) 2009, Hitachi, Ltd.