************************************************************************* 
      ** 
      ** Source File Name = checkerr.cbl  
      ** 
      ** Licensed Materials - Property of IBM 
      ** 
      ** (C) COPYRIGHT International Business Machines Corp. 1995, 2000 
      ** All Rights Reserved. 
      ** 
      ** US Government Users Restricted Rights - Use, duplication or 
      ** disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
      ** 
      ** 
      ** PURPOSE: a common utility program which outputs the error message 
      **          associated with the SQLCODE, if any. 
      ** 
      **    APIs USED : 
      **       GET SQLSTATE MESSAGE                   sqlggstt() 
      **       GET ERROR MESSAGE                      sqlgintp() 
      ** 
      ** 
      ** For more information about these samples see the README file. 
      ** 
      ** For more information on Programming in COBOL, see the: 
      **    -  "Programming in COBOL" section of the Application Development Guide. 
      ** 
      ** For more information on Building COBOL Applications, see the: 
      **    - "Building COBOL Applications" section of the Application Building Guide. 
      ** 
      ** For more information on the SQL language see the SQL Reference. 
      ** 
      ************************************************************************* 

       Identification Division.
       Program-ID. "checkerr".

       Data Division.
       Working-Storage Section.

       copy "sql.cbl".

      * Local variables 
       77 error-rc        pic s9(9) comp-5.
       77 state-rc        pic s9(9) comp-5.

      * Variables for the GET ERROR MESSAGE API 
      * Use application specific bound instead of BUFFER-SZ 
      * 77 buffer-size     pic s9(4) comp-5 value BUFFER-SZ. 
      * 77 error-buffer    pic x(BUFFER-SZ). 
      * 77 state-buffer    pic x(BUFFER-SZ). 
       77 buffer-size     pic s9(4) comp-5 value 1024.
       77 line-width      pic s9(4) comp-5 value 80.
       77 error-buffer    pic x(1024).
       77 state-buffer    pic x(1024).

       Linkage Section.
       copy "sqlca.cbl" replacing ==VALUE "SQLCA   "== by == ==
                                  ==VALUE 136==        by == ==.
       01 errloc          pic x(80).

       Procedure Division using sqlca errloc.
       Checkerr Section.
           if SQLCODE equal 0
              go to End-Checkerr.

           display "--- error report ---".
           display "ERROR occurred : ", errloc.
           display "SQLCODE : ", SQLCODE.

      ******************************** 
      * GET ERROR MESSAGE API called * 
      ******************************** 
           call "sqlgintp" using
                                 by value     buffer-size
                                 by value     line-width
                                 by reference sqlca
                                 by reference error-buffer
                           returning error-rc.

      ************************ 
      * GET SQLSTATE MESSAGE * 
      ************************ 
           call "sqlggstt" using
                                 by value     buffer-size
                                 by value     line-width
                                 by reference sqlstate
                                 by reference state-buffer
                           returning state-rc.

           if error-rc is greater than 0
              display error-buffer.

           if state-rc is greater than 0
              display state-buffer.

           if state-rc is less than 0
              display "return code from GET SQLSTATE =" state-rc.

           if SQLCODE is less than 0
              display "--- end error report ---"
              go to End-Prog.

           display "--- end error report ---"
           display "CONTINUING PROGRAM WITH WARNINGS!".
       End-Checkerr. exit program.
       End-Prog. stop run.