*=================================================================================== * MIT License * Copyright (c) 2016 TEMBO Technology Labs (Pty) Ltd. * Author: Tommy Atkins - Chief Development Officer * * Permission is hereby granted, free of charge, to any person obtaining a copy of this * software and associated documentation files (the "Software"), to deal in the Software * without restriction, including without limitation the rights to use, copy, modify, * merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit * persons to whom the Software is furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in all copies * or substantial portions of the Software. * ================================================================================== * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, * INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR * PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE * FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR * OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * DEALINGS IN THE SOFTWARE. *=================================================================================== h nomain aut(*use) *=================================================================================== * Application Error Handlers - Module 01 * ERR00: Clear Current Message Queue * ERR01: Move *DIAG Messages * ERR02: Re-Send *ESCAPE Message * ERR03: Move *DIAG and Re-Send *ESCAPE Messages * ERR04: Retrieve *LAST Message Id * ERR05: Move *DIAG and *ESCAPE Messages * ERR06: Move *ESCAPE Messages Only *=============================================================== d EC ds d ByteIn 9b 0 inz(0) d ByteOut 9b 0 inz(0) d ErrorId 7 inz(' ') d Resvd1 1 inz(' ') d ErrorDta 20 inz(' ') *=============================================================== d ERR00 pr d ERR01 pr d MT 1 const options(*nopass) d ERR02 pr d MT 1 const options(*nopass) d ERR03 pr d MT 1 const options(*nopass) d ERR04 pr 7 d ERR05 pr d MT 1 const options(*nopass) d ERR06 pr d MT 1 const options(*nopass) *=============================================================== * Remove Program Messages (QMHRMVPM) API d QMHRMVPM pr extpgm('QMHRMVPM') d CSEntry 10 const d CSCounter 10i 0 const d MsgKey 4 const d MsgRmv 10 const d ErrCode like(EC) *=============================================================== * Move Program Messages (QMHMOVPM) API d QMHMOVPM pr extpgm('QMHMOVPM') d MsgKey 4 const d MsgTypes 10 const d NoTypes 10i 0 const d ToCSE 10 const d ToCSE# 10i 0 const d ErrorCode like(EC) * Optional Parameter Group 1: d ToCSELen 10i 0 const d ToCSEQual 20 const * Optional Parameter Group 2: d ToCSEDataType 10 const d FromCSEAddr 16 const d FromCSECount 10i 0 const * ++++++++++++ d CSE s 10i 0 inz(1) *=============================================================== * Resend *ESCAPE Message (QMHRSNEM) API d QMHRSNEM pr extpgm('QMHRSNEM') d MsgKey 4 const d ErrorCode like(EC) * Optional Parameter Group: d ToCSE 10 const options(*varsize) d ToCSELen 10i 0 const d CSEFormat 8 const d FromCSEAddr 16 const d FromCSECount 10i 0 const * ++++++++++++ d RSNM0100 ds d ToCSE# 10i 0 inz(2) d ToCSEQual 20 inz('*NONE *NONE') d ToCSEIdLen 10i 0 inz(10) d ToCSEId 10 inz('*') * ++++++++++++ d ToCSELen 10i 0 inz(%len(RSNM0100)) *=============================================================== * Receive Program Message (QMHRCVPM) API d QMHRCVPM pr extpgm('QMHRCVPM') d Msg_Inf 2048 options(*varsize) d Msg_Inf_Len 10i 0 const d Msg_Format 8 const d Call_Stack_E 10 const d Call_Stack_# 10i 0 const d Msg_Types 10 const d Msg_Key 4 const d Wait_Time 10i 0 const d Msg_Action 10 const d Error_Code like(EC) *=============================================================== d MsgL s 10i 0 inz(%size(Msg)) d Msg ds qualified d BR 10i 0 d BA 10i 0 d Sev 10i 0 d Id 7 d Type 2 d Key 4 d R1 7 d CCSID1 10i 0 d CCSID2 10i 0 d RDR 10i 0 d RDA 10i 0 d RD 2048 *=============================================================== d CallStkEnt pr 10i 0 d MT 1 const options(*nopass) *=============================================================== * ERR00: Clear Current Message Queue *=============================================================== p ERR00 b export *=========================================== /free QMHRMVPM('*':1:' ':'*ALL':EC); /end-free *=========================================== p ERR00 e *=============================================================== * ERR01: Move *DIAG Messages <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p ERR01 b export d ERR01 pi d MT 1 const options(*nopass) *=========================================== /free //========================================= if %parms < 1; ToCSE# = CallStkEnt(); else; ToCSE# = CallStkEnt(MT); endif; //========================================= QMHMOVPM(' ':'*DIAG':1:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); //========================================= /end-free p ERR01 e *=============================================================== * ERR02: Re-Send *ESCAPE Message <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p ERR02 b export d ERR02 pi d MT 1 const options(*nopass) *=========================================== /free //========================================= if %parms < 1; ToCSE# = CallStkEnt(); else; ToCSE# = CallStkEnt(MT); endif; //========================================= QMHRSNEM(' ':EC:RSNM0100:ToCSELen:'RSNM0100':'*':1); //========================================= /end-free p ERR02 e *=============================================================== * ERR03: Move *DIAG and Re-Send *ESCAPE Messages <<<<<<<<<<<<<<< *=============================================================== p ERR03 b export d ERR03 pi d MT 1 const options(*nopass) *===================================================== /free //=================================================== if %parms < 1; ToCSE# = CallStkEnt(); else; ToCSE# = CallStkEnt(MT); endif; //================================================ QMHMOVPM(' ':'*DIAG':1:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); QMHRSNEM(' ':EC:RSNM0100:ToCSELen:'RSNM0100':'*':1); //=================================================== /end-free p ERR03 e *=============================================================== * ERR04: Retrieve *LAST Message Id <<<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p ERR04 b export d ERR04 pi 7 *===================================================== /free //=================================================== QMHRCVPM(Msg:MsgL:'RCVM0100':'*':1:'*LAST':' ':0:'*SAME':EC); return Msg.Id; //=================================================== /end-free p ERR04 e *=============================================================== * ERR05: Move *DIAG and *ESCAPE Messages <<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p ERR05 b export d ERR05 pi d MT 1 const options(*nopass) *===================================================== d MTypes s 20 inz('*DIAG *ESCAPE') *===================================================== /free //=================================================== if %parms < 1; ToCSE# = CallStkEnt(); else; ToCSE# = CallStkEnt(MT); endif; //=================================================== QMHMOVPM(' ':MTypes:2:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); //=================================================== /end-free p ERR05 e *=============================================================== * ERR06: Move *ESCAPE Messages Only <<<<<<<<<<<<<<<<<<<<<<<<<<<< *=============================================================== p ERR06 b export d ERR06 pi d MT 1 const options(*nopass) *===================================================== d MTypes s 10 inz('*ESCAPE') *===================================================== /free //=================================================== if %parms < 1; ToCSE# = CallStkEnt(); else; ToCSE# = CallStkEnt(MT); endif; //=================================================== QMHMOVPM(' ':MTypes:1:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); //=================================================== /end-free p ERR06 e *===============================================================