**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 - Send Messages
ctl-opt nomain aut(*use) extbinint(*yes) option(*nodebugio) debug;
//====================================================================
//& Exports
//  Application Error Handlers - Module 02
//  EXPORT SYMBOL(ERR10  )        /* DIAG Message
//  EXPORT SYMBOL(ERR11  )        /* ESCAPE Message
//  EXPORT SYMBOL(ERR12  )        /* INFO Message to *EXT
//  EXPORT SYMBOL(ERR13  )        /* STATUS Message to *EXT
//  EXPORT SYMBOL(ERR14  )        /* INFO to *SYSOPR
//====================================================================
//& Prototypes
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   QMHSNDM        extpgm('QMHSNDM');
          MsgId         char(7)   const;
          MsgFile       char(20)  const;
          MsgData       char(128) const options(*varsize);
          MsgDataLen     int(10)  const;
          MsgType       char(10)  const;
          MsgQ          char(20)  const;
          MsgQNo         int(10)  const;
          RplMsgQ       char(20)  const;
          MsgKey        char(4)        ;
          ErrorCode               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    MK        char(4);
dcl-s    MFL       char(20)    inz('ERRMSGF   *LIBL');
dcl-s    CSC        int(10)    inz(1);
dcl-s    CSEntQ    char(20)    inz('*NONE     *NONE');
dcl-s    MDD       char(2048)  inz(' ');
dcl-s    MDL        int(10)    inz(0);
//& ========================================================
//& ERR10: Send *DIAG Message
dcl-proc ERR10     export;
    dcl-pi    *n;
         MI    char(7)       const;
         MF    char(10)      const options(*omit:*nopass);
         MD    varchar(2048) const options(*omit:*nopass);
         MT    char(1)       const options(*nopass);
    end-pi;
//==========================================================
monitor;
   //=======================================================
   if %parms = 1;
      CSC = GetCSE1();
      QMHSNDPM(MI:MFL:' ':1:'*DIAG':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 2;
      CSC = GetCSE1();
      QMHSNDPM(MI:MF+'*LIBL':' ':1:'*DIAG':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 3;
      if %addr(MF) <> *NULL;
         MFL = MF+'*LIBL';
      else;
         reset MFL;
      endif;
      CSC = GetCSE1();
      MDD = MD;
      MDL = %len(MD);
      QMHSNDPM(MI:MFL:MDD:MDL:'*DIAG':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 4;
      if %addr(MF) <> *NULL;
         MFL = MF+'*LIBL';
      else;
         reset MFL;
      endif;
      if %addr(MD) <> *NULL;
         MDD = MD;
         MDL = %len(MD);
      else;
         MDD = *blank;
         MDL = 1;
      endif;
      CSC = GetCSE1(MT);
      QMHSNDPM(MI:MFL:MDD:MDL:'*DIAG':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
on-error;
endmon;
//==========================================================
end-proc;
//====================================================================
//& ERR11: Send *ESCAPE Message
dcl-proc ERR11     export;
    dcl-pi    *n;
         MI    char(7)       const;
         MF    char(10)      const options(*omit:*nopass);
         MD    varchar(2048) const options(*omit:*nopass);
         MT    char(1)       const options(*nopass);
    end-pi;
//==========================================================
monitor;
   //=======================================================
   if %parms = 1;
      CSC = GetCSE1();
      QMHSNDPM(MI:MFL:' ':1:'*ESCAPE':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 2;
      CSC = GetCSE1();
      QMHSNDPM(MI:MF+'*LIBL':' ':1:'*ESCAPE':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 3;
      if %addr(MF) <> *NULL;
         MFL = MF+'*LIBL';
      else;
         reset MFL;
      endif;
      CSC = GetCSE1();
      MDD = MD;
      MDL = %len(MD);
      QMHSNDPM(MI:MFL:MDD:MDL:'*ESCAPE':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 4;
      if %addr(MF) <> *NULL;
         MFL = MF+'*LIBL';
      else;
         reset MFL;
      endif;
      if %addr(MD) <> *NULL;
         MDD = MD;
         MDL = %len(MD);
      else;
         MDD = *blank;
         MDL = 1;
      endif;
      CSC = GetCSE1(MT);
      QMHSNDPM(MI:MFL:MDD:MDL:'*ESCAPE':'*':CSC:MK:EC);
      return;
   endif;
   //=======================================================
on-error;
endmon;
//==========================================================
end-proc;
//====================================================================
//& ERR12: Send *INFO Message to *EXT
dcl-proc ERR12     export;
    dcl-pi    *n;
         MI    char(7)       const;
         MF    char(10)      const options(*omit:*nopass);
         MD    varchar(2048) const options(*nopass);
    end-pi;
//==========================================================
monitor;
   //=======================================================
   if %parms = 1;
      QMHSNDPM(MI:MFL:' ':1:'*INFO':'*EXT':0:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 2;
      QMHSNDPM(MI:MF+'*LIBL':' ':1:'*INFO':'*EXT':0:MK:EC);
      return;
   endif;
   //=======================================================
   if %addr(MF) <> *NULL;
      MFL = MF+'*LIBL';
   else;
      reset MFL;
   endif;
   //=======================================================
   MDD = MD;
   MDL = %len(MD);
   QMHSNDPM(MI:MFL:MDD:MDL:'*INFO':'*EXT':0:MK:EC);
   //=======================================================
on-error;
endmon;
//==========================================================
end-proc;
//====================================================================
//& ERR13: Send *STATUS Message to *EXT
dcl-proc ERR13     export;
    dcl-pi    *n;
         MI    char(7)       const;
         MF    char(10)      const options(*omit:*nopass);
         MD    varchar(2048) const options(*nopass);
    end-pi;
//==========================================================
monitor;
   //=======================================================
   if %parms = 1;
      QMHSNDPM(MI:MFL:' ':1:'*STATUS':'*EXT':0:MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 2;
      QMHSNDPM(MI:MF+'*LIBL':' ':1:'*STATUS':'*EXT':0:MK:EC);
      return;
   endif;
   //=======================================================
   if %addr(MF) <> *NULL;
      MFL = MF+'*LIBL';
   else;
      reset MFL;
   endif;
   //=======================================================
   MDD = MD;
   MDL = %len(MD);
   QMHSNDPM(MI:MFL:MDD:MDL:'*STATUS':'*EXT':0:MK:EC);
   //=======================================================
on-error;
endmon;
//==========================================================
end-proc;
//====================================================================
//& ERR14: Send *INFO to *SYSOPR
dcl-proc ERR14     export;
    dcl-pi    *n;
         MI    char(7)       const;
         MF    char(10)      const options(*omit:*nopass);
         MD    varchar(2048) const options(*nopass);
    end-pi;
//==========================================================
monitor;
   //=======================================================
   if %parms = 1;
      QMHSNDM(MI:MFL:' ':1:'*INFO':'*SYSOPR':1:' ':MK:EC);
      return;
   endif;
   //=======================================================
   if %parms = 2;
      QMHSNDM(MI:MF+'*LIBL':' ':1:'*INFO':'*SYSOPR':1:' ':MK:EC);
      return;
   endif;
   //=======================================================
   if %addr(MF) <> *NULL;
      MFL = MF+'*LIBL';
   else;
      reset MFL;
   endif;
   //=======================================================
   MDD = MD;
   MDL = %len(MD);
   QMHSNDM(MI:MFL:MDD:MDL:'*INFO':'*SYSOPR':1:' ':MK:EC);
   //=======================================================
on-error;
endmon;
//==========================================================
end-proc;
//& ==================================================================