**free //& Apache License ============================================================* // Copyright © 2008-2021 TEMBO Technology Lab (Pty) Ltd. * // Created by AO Foundation - www.adsero-optima.com * // Original TEMPLATE author: Tommy Atkins - Chief Development Officer * // * // Licensed under the Apache License, Version 2.0 (the "License"); * // you may not use this file except in compliance with the License. * // You may obtain a copy of the License at * // http://www.apache.org/licenses/LICENSE-2.0 * // * // Unless required by applicable law or agreed to in writing, software * // distributed under the License is distributed on an "AS IS" BASIS, * // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * // See the License for the specific language governing permissions and * // limitations under the License. * // * // The above copyright notice and this permission notice shall be included in * // all copies or substantial portions of the Software. * // https://www.i-nterprise.org/ * // https://www.adsero-optima.com/ * //=============================================================================* //& Error Handler Services - Clear, Move, Retrieve and Resend ctl-opt nomain aut(*use) extbinint(*yes) option(*nodebugio) debug; //==================================================================== //& Exports // Application Error Handlers - Module 01 // EXPORT SYMBOL(ERR00 ) /* Clear Current Message Queue // EXPORT SYMBOL(ERR00A ) /* Clear All Inactive Message Queues // EXPORT SYMBOL(ERR01 ) /* Move *DIAG Messages // EXPORT SYMBOL(ERR02 ) /* Re-Send *ESCAPE Message // EXPORT SYMBOL(ERR03 ) /* Move *DIAG and Re-Send *ESCAPE Messages // EXPORT SYMBOL(ERR04 ) /* Retrieve *LAST Message Id // EXPORT SYMBOL(ERR05 ) /* Move *DIAG and *ESCAPE Messages // EXPORT SYMBOL(ERR06 ) /* Move *ESCAPE Messages Only // EXPORT SYMBOL(ERR07 ) /* Receive *LAST Message Id. & Text with *REMOVE // EXPORT SYMBOL(ERR08 ) /* Receive Target Program Messages to USP Pointer //==================================================================== //& Prototypes dcl-pr QMHRMVPM extpgm('QMHRMVPM'); CSEntry char(10) const; CSCounter int(10) const; MsgKey char(4) const; MsgRmv char(10) const; ErrCode like(EC); end-pr; //========================================================== dcl-pr QMHMOVPM extpgm('QMHMOVPM'); MsgKey char(4) const; MsgTypes char(10) const; NoTypes int(10) const; ToCSE char(10) const; ToCSE# int(10) const; ErrorCode like(EC); // Optional Parameter Group 1: ToCSELen int(10) const; ToCSEQual char(20) const; // Optional Parameter Group 2: ToCSEDataType char(10) const; FromCSEAddr char(16) const; FromCSECount int(10) const; end-pr; //========================================================== dcl-pr QMHRSNEM extpgm('QMHRSNEM'); MsgKey char(4) const; ErrorCode like(EC); // Optional Parameter Group: ToCSE char(10) const options(*varsize); ToCSELen int(10) const; CSEFormat char(8) const; FromCSEAddr char(16) const; FromCSECount int(10) const; end-pr; //========================================================== dcl-pr QMHSNDPM extpgm('QMHSNDPM'); MsgId char(7) const; MsgFile char(20) const; MsgData char(128) const options(*varsize); MsgDataLen int(10) const; MsgType char(10) const; CallStkEnt char(10) const; CSECount int(10) const; MsgKey char(4) ; ErrorCode like(EC); end-pr; //========================================================== dcl-pr QMHRCVPM extpgm('QMHRCVPM'); // Receive Program Message (QMHRCVPM) API Msg_Inf char(2048) options(*varsize); Msg_Inf_Len int(10) const; Msg_Format char(8) const; Call_Stack_E char(10) const; Call_Stack_# int(10) const; Msg_Types char(10) const; Msg_Key char(4) const; Wait_Time int(10) const; Msg_Action char(10) const; Error_Code like(EC); end-pr; //========================================================== dcl-pr GetCSE1 int(10); MT char(1) const options(*nopass); end-pr; //==================================================================== //& Data Definitions /include *LIBL/SRCCPY,API_EC API Error Code Data Structure //========================================================== dcl-s CSE int(10) inz(1); dcl-s MTypes char(20) inz('*DIAG *ESCAPE'); //========================================================== dcl-s ToCSELen int(10) inz(%len(RSNM0100)); dcl-ds RSNM0100; ToCSE# int(10) inz(2); ToCSEQual char(20) inz('*NONE *NONE'); ToCSEIdLen int(10) inz(10); ToCSEId char(10) inz('*'); end-ds; //========================================================== dcl-s RCVM0200P pointer inz(%addr(RCVM0200)); dcl-s RCVM0200L int(10); dcl-ds RCVM0200 len(4096); BR200 int(10); BA200 int(10); end-ds; //========================================================== dcl-s MsgL int(10) inz(%size(Msg)); dcl-ds Msg qualified; BR int(10); BA int(10); Sev int(10); Id char(7) ; Type char(2) ; Key char(4) ; R1 char(7) ; CCSID1 int(10); CCSID2 int(10); RDR int(10); RDA int(10); RD char(2048); end-ds; //========================================================== dcl-s MsgLP pointer; dcl-ds MsgLA based(MsgLP); RplLenR int(10); RplLenA int(10); MsgLenR int(10); MsgLenA int(10); HlpLenR int(10); HlpLenA int(10); end-ds; //========================================================== dcl-s MsgIdP pointer; dcl-s MsgId char(7) based(MsgIdP); //========================================================== dcl-s MsgTxtP pointer; dcl-s MsgTxt char(132) based(MsgTxtP); //& ================================================================== //& ERR00: Clear Current Message Queue dcl-proc ERR00 export; //========================================================== monitor; QMHRMVPM('*':1:' ':'*ALL':EC); on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR00A: Clear All Inactive Message Queues dcl-proc ERR00A export; //========================================================== monitor; QMHRMVPM('*ALLINACT':1:' ':'*ALL':EC); on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR01: Move *DIAG Messages dcl-proc ERR01 export; dcl-pi *n; MT char(1) const options(*nopass); end-pi; //========================================================== monitor; if %parms < 1; ToCSE# = GetCSE1(); else; ToCSE# = GetCSE1(MT); endif; QMHMOVPM(' ':'*DIAG':1:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR02: Re-Send *ESCAPE Message dcl-proc ERR02 export; dcl-pi *n; MT char(1) const options(*nopass); end-pi; //========================================================== monitor; if %parms < 1; ToCSE# = GetCSE1(); else; ToCSE# = GetCSE1(MT); endif; QMHRSNEM(' ':EC:RSNM0100:ToCSELen:'RSNM0100':'*':1); on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR03: Move *DIAG and Re-Send *ESCAPE Messages <<<<<<<<<<<<<<< dcl-proc ERR03 export; dcl-pi *n; MT char(1) const options(*nopass); end-pi; //========================================================== monitor; //======================================================= if %parms < 1; ToCSE# = GetCSE1(); else; ToCSE# = GetCSE1(MT); endif; //======================================================= if Cst_Error(); return; endif; //======================================================= QMHMOVPM(' ':'*DIAG':1:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); QMHRSNEM(' ':EC:RSNM0100:ToCSELen:'RSNM0100':'*':1); //======================================================= on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR04: Retrieve *LAST Message Id dcl-proc ERR04 export; dcl-pi *n char(7) end-pi; //========================================================== monitor; QMHRCVPM(Msg:MsgL:'RCVM0100':'*':1:'*LAST':' ':0:'*SAME':EC); return Msg.Id; on-error; return 'ERROR'; endmon; //========================================================== end-proc; //==================================================================== //& ERR05: Move *DIAG and *ESCAPE Messages dcl-proc ERR05 export; dcl-pi *n; MT char(1) const options(*nopass); end-pi; //========================================================== monitor; if %parms < 1; ToCSE# = GetCSE1(); else; ToCSE# = GetCSE1(MT); endif; QMHMOVPM(' ':MTypes:2:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR06: Move *ESCAPE Messages Only dcl-proc ERR06 export; dcl-pi *n; MT char(1) const options(*nopass); end-pi; //========================================================== monitor; if %parms < 1; ToCSE# = GetCSE1(); else; ToCSE# = GetCSE1(MT); endif; QMHMOVPM(' ':'*ESCAPE':1:'*':ToCSE#:EC:10:ToCSEQual:'*CHAR':'*':1); on-error; endmon; //========================================================== end-proc; //==================================================================== //& ERR07: Receive *LAST Message Id. & Text with *REMOVE dcl-proc ERR07 export; dcl-pi *n ind; MI char(7); MD char(132); MT char(1) const options(*nopass); end-pi; //========================================================== if %parms > 2; ToCSE# = GetCSE1(MT); else; ToCSE# = GetCSE1(); endif; //========================================================== QMHRCVPM(RCVM0200:4096:'RCVM0200':'*':ToCSE#:'*LAST':' ':0:'*REMOVE':EC); //========================================================== if BA200 = 0; return *off; endif; //========================================================== MsgIdP = RCVM0200P + 12; MsgLP = RCVM0200P + 152; MsgTxtP = RCVM0200P + 176 + RplLenR; //========================================================== MI = MsgId; MD = %subst(MsgTxt:1:MsgLenR); return *on; //========================================================== end-proc; //==================================================================== //& ERR08: Receive Target Program Messages to USP Pointer dcl-proc ERR08 export; dcl-pi *n; USPP pointer value; MT char(1) const options(*nopass); end-pi; //========================================================== dcl-ds USP len(4174) based(USPP); // Capacity 30 Messages NoMsg uns(10); end-ds; //========================================================== dcl-s MsgEP pointer; dcl-s MsgEL int(10) inz(%size(MsgE)); dcl-ds MsgE based(MsgEP); MsgI char(7); MsgT char(132); end-ds; //========================================================== if %parms > 1; ToCSE# = GetCSE1(MT); else; ToCSE# = GetCSE1(); endif; //========================================================== NoMsg = 0; MsgEP = USPP + 4; //========================================================== QMHRCVPM(RCVM0200:4096:'RCVM0200':'*':ToCSE#:'*LAST':' ':0:'*REMOVE':EC); //========================================================== dow BA200 <> 0 and NoMsg <= 30; //====================================================== MsgIdP = RCVM0200P + 12; MsgLP = RCVM0200P + 152; MsgTxtP = RCVM0200P + 176 + RplLenR; //====================================================== MsgI = MsgId; MsgT = %subst(MsgTxt:1:MsgLenR); //====================================================== NoMsg += 1; MsgEP += MsgEL; //====================================================== QMHRCVPM(RCVM0200:4096:'RCVM0200':'*':ToCSE#:'*LAST':' ':0:'*REMOVE':EC); //====================================================== enddo; //========================================================== end-proc; //& ================================================================== //& Constraint Error dcl-proc Cst_Error; dcl-pi *n ind end-pi; //========================================================== dcl-f AOFCMLF disk usage(*input) keyed; //========================================================== dcl-ds CMLR likerec(AOFCMLFR); //========================================================== dcl-ds MD qualified; Id char(7); CstN char(25); end-ds; //========================================================== dcl-s MI char(7) inz('CST0000'); dcl-s MF char(20) inz('CSTMSGF *LIBL'); dcl-s MDL int(10) inz(32); dcl-s MT char(10) inz('*ESCAPE'); dcl-s CSE char(10) inz('*'); dcl-s CSC int(10) Inz(1); dcl-s MK char(4); //========================================================== dcl-ds CPF503A; V1 char(176); CstName char(258); V3 char(34) ; end-ds; //========================================================== monitor; //======================================================== QMHRCVPM(Msg:MsgL:'RCVM0100':'*':2:'*LAST':' ':0:'*SAME':EC); //======================================================== if Msg.Id <> 'RNX1022'; return *off; endif; //======================================================== dou Msg.Id = 'CPF502D' or Msg.Id = 'CPF502E' or Msg.Id = 'CPF503A'; QMHRCVPM(Msg:MsgL:'RCVM0100':'*':2:'*PRV':Msg.Key:0:'*SAME':EC); enddo; //======================================================== CPF503A = %subst(Msg.RD:1:Msg.RDA); //======================================================== QMHMOVPM(' ':'*DIAG':1:'*':ToCSE#+1:EC:10:ToCSEQual:'*CHAR':'*':2); //======================================================== if not %open(AOFCMLF); open AOFCMLF; endif; //======================================================== chain (CstName:Msg.Id) AOFCMLF CMLR; if %found; MI = CMLR.MSGID; else; reset MI; endif; //======================================================== MD.Id = Msg.Id; MD.CstN = CstName; QMHRMVPM('*':ToCSE#:' ':'*ALL':EC); QMHSNDPM(MI:MF:MD:MDL:MT:CSE:ToCSE#+1:MK:EC); //======================================================== return *on; on-error; endmon; //========================================================== end-proc; //& ==================================================================