**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 - Convert SQLSTATE to Error Message
ctl-opt nomain aut(*use) extbinint(*yes) option(*nodebugio) debug;
//====================================================================
//& Exports
//  Application Error Handlers - Module 06
//  EXPORT SYMBOL(ERR50  )        /* Convert SQLSTATE to Error Message
//====================================================================
//& Prototypes
/include *LIBL/SRCCPY,ERR11       Send *ESCAPE Message
//====================================================================
//& Data Definitions
/include *LIBL/SRCCPY,API_EC      API Error Code Data Structure
//==========================================================
dcl-s    CAPtr     pointer;
dcl-ds   SQLCA     based(CAPtr);
          SQLAID   char( 8);
          SQLABC    int(10);
          SQLCODE   int(10);
          SQLMSGL   int( 5);
          SQLMSGD  char(70);
          SQLERRP  char( 8);
          SQLERRD   int(10)  dim(6);
          SQLWARN  char( 1)  dim(11);
          SQLSTATE char( 5);
end-ds;
//& ==================================================================
//& ERR50: Convert SQLSTATE to Error Message
dcl-proc ERR50     export;
    dcl-pi    *n    ind;
         P          pointer  const;
    end-pi;
//==========================================================
dcl-ds   SQLMSG    len(7);
          C3       char(1)   pos(3);
end-ds;
//==========================================================
monitor;
   //=======================================================
   CAPtr = P;
   //=======================================================
   select;
      when SQLCODE = 0;
           return *off;
      when SQLCODE = 100;
           return *on;
      when SQLCODE > 0;
           return *off;
   endsl;
   //=======================================================
   SQLMSG = 'SQ' + %subst(%editc(%abs(SQLCODE):'X'):6:5);
   if C3 = '0';
      C3 = 'L';
   endif;
   //=======================================================
   ERR11(SQLMSG:'QSQLMSG':%subst(SQLMSGD:1:SQLMSGL));
   //=======================================================
   return *off;
   //=======================================================
on-error;
endmon;
//==========================================================
end-proc;
//& ==================================================================