Retrieve SQL Message

This subprocedure, when given SQLCOD and SQLERM parameters, will return the appropriate error message text from message file QSYS/QSQLMSG.

NOTE: On my system, the source resides in library TOOLSSRC. The AS/400 I use runs V4R5.

Retrieve SQL Message definition:


     d RtvSqlMsg       pr         32000a   varying
     d  sqlcod                        5p 0 const
     d  sqlerm                       70a   value

Example usage

Example 1:


      *-- Prototypes
      /copy toolssrc/servicepgm,sptoolspr

     d sql             s            100a   inz('select count(*) from +
     d                                     NOTAFILE')
     d sql2            s            100a   inz('select count(*) from qsys2/+
     d                                     systables')
     d sqlmessage      s            200a   inz varying

      *=========================================================================

      *-------------------------------------------------------------------------
      *-- Test rtvsqlmsg

      *-- Should give error messages

     c/exec sql prepare p1 from :sql
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'NOTAFILE in *LIBL type *FILE not found.'

     c/exec sql declare c1 cursor for p1
     c/end-exec
     c/exec sql open c1
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'Prepared statement P1 not found.'

     c/exec sql fetch c1 into :mycount
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'Cursor C1 not open.'

     c/exec sql close c1
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'Cursor C1 not open.'

      *-------------------------------------------------------------------------

      *-- Should give OK messages

     c/exec sql prepare p2 from :sql2
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'The SQL statement has run successfully.'

     c/exec sql declare c2 cursor for p2
     c/end-exec
     c/exec sql open c2
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'The SQL statement has run successfully.'

     c/exec sql fetch c2 into :mycount
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'The SQL statement has run successfully.'
      *-- Var mycount should be > 0
      *-- On my system it's over 16000

     c/exec sql close c2
     c/end-exec

     c                   eval      sqlmessage = rtvsqlmsg( sqlcod : sqlerm )

      *-- Result should be 'The SQL statement has run successfully.'

      *=========================================================================

     c                   eval      *inlr = *on
     c                   return

Example 2:


      *-- This example was taken from an internal web report using CGIDEV2.

      * SQL stuff
     d SQLNOCURSOR     c                   '24501'
     d SQLNORECORDS    c                   '02000'

      *-- [snip]

      *-- [The next section reads dynamic SQL from a compile-time array.
      *-- I left it in for illustration.]

      *-- Get scrap for the reporting period
     c                   clear                   sql
     c                   eval      xmax = %elem(scrapsql)
     c     1             do        xmax          x
     c                   eval      sql = sql + ' ' + %trim(scrapsql(x))
     c                   enddo
     c                   callp     updhtmlvar('sql1':sql)

      *-- [Throughout this section of the program, I output various SQL
      *-- things to the web browser to act as debugging or confirmation
      *-- tools.]

     c/exec sql prepare p1 from :sql
     c/end-exec

     c                   callp     updhtmlvar('preparesqlcod':
     c                             %editc(sqlcod:'J'))
     c                   callp     updhtmlvar('preparesqlstt':sqlstt)
     c                   callp     updhtmlvar('preparesqlmsg':
     c                             %trim(rtvsqlmsg(sqlcod:sqlerm)))

     c/exec sql declare c1 cursor for p1
     c/end-exec
     c/exec sql open c1 using :enddate, :startdate, :enddate, :deptworksql
     c/end-exec

     c                   callp     updhtmlvar('opensqlcod':
     c                             %editc(sqlcod:'J'))
     c                   callp     updhtmlvar('opensqlstt':sqlstt)
     c                   callp     updhtmlvar('opensqlmsg':
     c                             %trim(rtvsqlmsg(sqlcod:sqlerm)))

     c/exec sql fetch c1 into :sqlscrap
     c/end-exec

      *-- [I always evaluate the first fetch before going into the
      *-- processing loop.]

     c                   callp     updhtmlvar('fetchsqlcod':
     c                             %editc(sqlcod:'J'))
     c                   callp     updhtmlvar('fetchsqlstt':sqlstt)
     c                   callp     updhtmlvar('fetchsqlmsg':
     c                             %trim(rtvsqlmsg(sqlcod:sqlerm)))

     c                   if        sqlstt = SQLNORECORDS
     c/exec sql close c1
     c/end-exec
     c                   callp     wrtsection('norecords')
     c                   callp     wrtsection('bottom')
     c                   exsr      finish
     c                   endif

     c                   eval      x = 1
     c                   dow       sqlstt <> SQLNOCURSOR and
     c                             sqlstt <> SQLNORECORDS and
     c                             x <= %elem(scrap)
     c                   eval      scr_dept(x) = sqlscr_dept
     c                   eval      scr_code(x) = sqlscr_code

      *-- [... bulk of processing loop snipped ...]

     c                   eval      x = x + 1
     c/exec sql fetch c1 into :sqlscrap
     c/end-exec
     c                   enddo
     c                   eval      scrapmax = x - 1
     c                   callp     updhtmlvar('scrapmax':
     c                             %editc(scrapmax:'Z'))
     c                   callp     updhtmlvar('scrappossible':
     c                             %editc(%elem(scrap):'Z'))

     c/exec sql close c1
     c/end-exec

Making it work

Retrieve SQL Message prototype:


     d RtvSqlMsg       pr         32000a   varying
     d  sqlcod                        5p 0 const
     d  sqlerm                       70a   value

Retrieve SQL Message procedure:


      *-- For service program modules, start here.
     h nomain

      *-- For /copy subprocedure use, make sure you get these in your program.
      /copy toolssrc/servicepgm,sptoolspr
      /copy toolssrc/formats,errorcode
      /copy toolssrc/apiibm,apimsg

      *-- For /copy or inline subprocedure use, start here.
     p RtvSqlMsg       b                   export

     d RtvSqlMsg       pi         32000a   varying
     d  sqlcod                        5p 0 const
     d  sqlerm                       70a   value

     d sqlabs          s              5p 0 inz
     d sqlchar         s              6a   inz
     d sqlmsgid        s              7a   inz

     d sqlmsgf         ds            20
     d  sqlmsgfile                   10a   inz('QSQLMSG') overlay(sqlmsgf:1)
     d  sqlmsglib                    10a   inz('QSYS') overlay(sqlmsgf:11)

     d returnval       s          32000a   inz varying

     d SUCCESS         c                   'The SQL statement has run +
     d                                     successfully.'

     c                   if        sqlcod = 0
     c                   eval      returnval = SUCCESS
     c                   return    returnval
     c                   endif

     c                   eval      sqlabs = %abs(sqlcod)
     c                   eval      sqlchar = %editw(sqlabs:'0     ')

     c                   eval      sqlmsgid = 'SQ' + %subst(sqlchar:2:5)
     c                   if        %subst(sqlmsgid:3:1) = '0'
     c                   eval      %subst(sqlmsgid:3:1) = 'L'
     c                   endif

     c                   callp     RtvMsg(
     c                             rtvm0100 :
     c                             %size(rtvm0100) :
     c                             'RTVM0100' :
     c                             sqlmsgid :
     c                             sqlmsgf :
     c                             sqlerm  :
     c                             %size(sqlerm) :
     c                             '*YES' :
     c                             '*NO' :
     c                             errc0100
     c                             )

     c                   eval      returnval = %subst(rtvm01_data:1:
     c                             rtvm01_msgret)

     c                   return    returnval

     p RtvSqlMsg       e

API error code formats:


      *-- These formats are for return error codes from API calls. Most of the
      *-- time, the error code format used will be ERRC0100.

     d errc0100        ds
     d  errc01bytpro                 10i 0                                      Bytes provided
     d  errc01bytava                 10i 0                                      Bytes available
     d  errc01excid                   7a                                        Exception ID
     d  errc01resaaa                  1a                                        Reserved
     d  errc01excdta                 40a                                        Exception data

     d errc0200        ds
     d  errc02key                    10i 0                                      Key
     d  errc02bytpro                 10i 0                                      Bytes provided
     d  errc02bytava                 10i 0                                      Bytes available
     d  errc02excid                   7a                                        Exception ID
     d  errc02resaaa                  1a                                        Reserved
     d  errc02ccsid                  10i 0                                      CCSID of data
     d  errc02excoff                 10i 0                                      Exception offset
     d  errc02exclen                 10i 0                                      Exception length
     d  errc02excdta              32767a                                        Exception data

Retrieve Message API:


     d RtvMsg          pr                  extpgm('QMHRTVM')
     d  messageinfo               32000a
     d  messageinfol                 10i 0 const
     d  format                        8a   const
     d  msgid                         7a   const
     d  msgfile                      20a   const                                FileLib
     d  replaceval                32000a   const options(*varsize)
     d  replacevall                  10i 0 const
     d  substitute                   10a   const
     d  rtnfmtctrl                   10a   const
     d  errorcode                   272a   options(*varsize)
      *
     d  rtvoption                    10a   const options(*nopass)
     d  ccsidconvert                 10i 0 const options(*nopass)
     d  ccsidreplace                 10i 0 const options(*nopass)

     d rtvm0100        ds
     d  rtvm01_bytret                10i 0
     d  rtvm01_bytava                10i 0
     d  rtvm01_msgret                10i 0
     d  rtvm01_msgava                10i 0
     d  rtvm01_hlpret                10i 0
     d  rtvm01_hlpava                10i 0
     d  rtvm01_data               32000a

Version history: