R U N S Q L
                          ===============                Version 1.7

   This is designed to make problem diagnosis much easier for SQL
   run using DSNREXX.  It provides comprehensive ERROR information in
   the case of a bad SQLCODE, and it can also provide a useful TRACE
   facility to check particular SQL statements as they run, or to write
   warning messages whenever +ve SQLCODEs occur.  Those features are
   particularly useful for Rexx programs with complex SQL code, or with
   variable substitution or host variables in their SQL.

   It can also provide standarised SQL error handling - which you can
   utilise to make it much quicker to write new new Rexx/SQL programs,
   simpler to code and read, but providing thorough SQL diagnostics.

   If it is run online the output goes to the terminal, but if it runs
   in batch (or as a stored procedure) it defaults to writing to a
   DDNAME which is the same as the name of the exec.


 IMPLEMENTATION:
 --------------
   You implement it in an existing Rexx exec by changing statements
   like:  address DSNREXX "EXECSQL sql_statement"
   to:    rc = RUNSQL("sql_statement")

   Then you copy some Rexx code (a group of procedures) to the end of
   existing exec.  More detailed instuctions follow below.

   The exec can then be run as normal and will perform exactly the same
   as before until there is a bad SQLCODE, whereupon it will produce
   detailed diagnostic information.  Otherwise, SQL error handling is
   unchanged from whatever was already present in the exec, unless you
   specify that RUNSQL should handle that too.


 SQL ERROR:
 ---------
   Here is an example to show the layout of SQL Error output created
   when an SQL error occurs.  It shows a FETCH statement which failed
   because it had specified one more host variable than was in the
   SELECT statement prepared for that cursor (C4).

================================== SQL Error ===========================
  RONS.EXEC(SELDB)  Line 97                       4 Sep 2008  18:54:31

Running on system QAOS      Connected to DQC0

FETCH C4 INTO :rba, :icdsn, :icjobn, :extra_hostvar

DSNT408I SQLCODE = -104, ERROR:  ILLEGAL SYMBOL ",". SOME SYMBOLS THAT
         MIGHT BE LEGAL ARE: <END-OF-STATEMENT>
DSNT418I SQLSTATE   = 42601 SQLSTATE RETURN CODE
DSNT415I SQLERRP    = DSNTZNTO SQL PROCEDURE DETECTING ERROR
DSNT416I SQLERRD    = 0  0  0  -1  0  0 SQL DIAGNOSTIC INFORMATION
DSNT416I SQLERRD    = X'00000000'  X'00000000'  X'00000000'  X'FFFFFFFF'
         X'00000000'  X'00000000' SQL DIAGNOSTIC INFORMATION

Failing SQL statement text
--------------------------
SELECT START_RBA, DSNAME, JOBNAME
  FROM LOCDB2A.SYSIBM.SYSCOPY A
  WHERE A.ICTYPE = 'F' AND A.DBNAME = ? AND A.TSNAME = ?
    AND A.START_RBA = (SELECT MAX(B.START_RBA)
      FROM LOCDB2A.SYSIBM.SYSCOPY B
      WHERE B.ICTYPE = 'F' AND B.START_RBA < ?
        AND A.DBNAME = B.DBNAME AND A.TSNAME = B.TSNAME)

REXX host variable values
--------------------------
                DB = 'GHWRBSZZ'
                TS = 'SHWAUPR'
            HEXRBA = ''B宜 ''

========================================================================

   Error output starts by identifying the location of the failing RUNSQL
   statement showing its SQL text (after Rexx variable substitutions),
   followed by diagnostic information formatted by the DSNTIAR program.

   Next comes a list of all the relevant Rexx input variables and their
   values, possibly including related "Failing SQL statement text" (in
   this example - the SQL text that was prepared for that fetch).  If
   long SQL statement text is shown in the output, it is formatted into
   multiple lines of up to 72 bytes in order to be easy to cut and paste
   it for separate testing (eg. in SPUFI).  The programmer can influence
   the formatting by including multiple blanks at the start of each
   line, as in the following example Rexx statement:

   selectic = "SELECT" icopy_columns,
              " FROM" locn]]"."]]icopy_tbl "A",
              " WHERE A.ICTYPE = 'F' AND A.DBNAME = ? AND A.TSNAME = ?",
              "   AND A.START_RBA = (SELECT MAX(B.START_RBA)",
              "     FROM" locn]]"."]]icopy_tbl "B",
              "     WHERE B.ICTYPE = 'F' AND B.START_RBA < ?",
              "       AND A.DBNAME = B.DBNAME AND A.TSNAME = B.TSNAME)"

   The SQL Error example was an invalid FETCH from a cursor prepared
   from the above statement.  Note that the SQL Error output shows that
   statement after Rexx variable substitution, and on the following
   lines it identifies each of the host variables which correspond to
   the ? characters plus their values at the time the FETCH statement
   failed.

   This level of detail should make it much easier for you to resolve
   any errors because the runtime values of all variables are shown.


 WHAT IS AN SQL ERROR?
 ---------------------
   But what exactly is an SQL error?  That is up to you.
   Some negative SQL codes for particular statements may be already
   handled by your main Rexx program and can therefore considered to be
   "acceptable".  Other (unexpected) SQL codes will be treated by RUNSQL
   as errors and hence diagnosis messages will be generated for them.

   By default any negative SQL code is considered to be an SQL error:
      rc = RUNSQL("sql_statement")      /* use default '>=0' */
   but you can specify your own list of acceptable SQLCODE conditions
   in any RUNSQL statement like:
      rc = RUNSQL("sql_statement",'list_of_codes')

   The default list_of_codes is: '>=0', but you could suppress error
   output unconditionally by specifying something like: '<9999', or
   suppress error output for some specific codes like: '-904,-905,>=0'.
   A comma between two conditions is treated as logical 'OR', therefore
   each condition is tested until one successfully matches the sqlcode,
   and if no match is found - error diagnostic messages are generated.
   For more complex requirements you can even specify conditions using
   ']' or '&' like in the following: '>=0 & ^=335'.


 SQL ERROR HANDLING:
 ------------------
   By default RUNSQL only writes diagnostics and does no error handling.
   But if you insert a Rexx statement into the original code like:
      runsql_abend = 'YES'
   then RUNSQL handle will handle any SQL error by outputting the
   diagnostic information then doing a ROLLBACK, followed by abending
   the exec with return code 99.

   That feature can be utilised to simplify the writing of new Rexx/SQL
   code by providing a standard abend process.


 TRACE:
 -----
   A RUNSQL trace can make it easy to check the flow of SQL statements
   and their inputs/outputs, without using a Rexx trace.  Here is a
   sample of some trace output to show the format for a variety of SQL
   statements:

---------------------------- Start Trace -------------------------------
  RONS.EXEC(SELDB)                                4 Sep 2008  18:44:36

CONNECT DQC0
  Line 7   Sqlcode = 0   Elapsed = 0.037889 sec

UPDATE PLAN_TABLE
   SET APPLNAME = 'BLUE'
   WHERE QUERYNO >= 666
     AND APPLNAME = 'BLEU'
  Line 9   Sqlcode = 0   Rows = 4   Elapsed = 0.054409 sec

Delete from PLAN_TABLE where applname = 'BLEU'
  Line 12   Sqlcode = +100   Sqlstate = 02000   Elapsed = 0.137609 sec
--------------------------
  NOT FOUND:  ROW NOT FOUND FOR FETCH, UPDATE, OR DELETE,
  OR THE RESULT OF A QUERY IS AN EMPTY TABLE

COMMIT
  Line 13   Sqlcode = 0   Elapsed = 0.023975 sec

EXECUTE IMMEDIATE :stmt
  Line 17   Sqlcode = 0   Rows = 812   Elapsed = 0.179263 sec
--------------------------
              STMT = 'DELETE FROM PLAN_TABLE WHERE APPLNAME = ' ''

ROLLBACK
  Line 18   Sqlcode = 0   Elapsed = 0.214269 sec

DECLARE C4 CURSOR FOR S4
  Line 80   Sqlcode = 0   Elapsed = 0.007782 sec

PREPARE S4 FROM :selectic
  Line 83   Sqlcode = 0   Elapsed = 0.006895 sec
--------------------------
SELECT START_RBA, DSNAME, JOBNAME
  FROM LOCDB2A.SYSIBM.SYSCOPY A
  WHERE A.ICTYPE = 'F' AND A.DBNAME = ? AND A.TSNAME = ?
    AND A.START_RBA = (SELECT MAX(B.START_RBA)
      FROM LOCDB2A.SYSIBM.SYSCOPY B
      WHERE B.ICTYPE = 'F' AND B.START_RBA < ?
        AND A.DBNAME = B.DBNAME AND A.TSNAME = B.TSNAME)

OPEN C4 USING :db, :ts, :hexrba
  Line 86   Sqlcode = 0   Elapsed = 0.008645 sec
--------------------------
                DB = 'GHWRBSZZ'
                TS = 'SHWAUPR'
            HEXRBA = ''B宜 ''

FETCH C4 INTO :rba1, :icdsn1, :icjobn
  Line 91   Sqlcode = 0   Fetch 1   Elapsed = 0.014632 sec
--------------------------
              RBA1 = 'B ?V館'
            ICDSN1 = 'TTDM.GHWRBSZZ.SHWAUPR.CPI00000.G0001V00     '
            ICJOBN = 'TTDMU6CP'

DECLARE C3 CURSOR FOR S3
  Line 22   Sqlcode = 0   Elapsed = 0.006779 sec

PREPARE S3 INTO :S3sqlda FROM :sqlstmt
  Line 23   Sqlcode = 0   Elapsed = 0.010167 sec
--------------------------
Select NAME, CREATOR, STGROUP, BPOOL, INDEXBP
   From SYSIBM.SYSDATABASE
    Where NAME LIKE 'DF%'
--------------------------
  SQLDA data in S3SQLDA:
 VARCHAR(24)              NAME  = ''
 VARCHAR(128)          CREATOR  = ''
 VARCHAR(128)          STGROUP  = ''
 CHAR(8)                 BPOOL  = ''
 CHAR(8)               INDEXBP  = ''

OPEN C3
  Line 24   Sqlcode = 0   Elapsed = 0.006749 sec

FETCH C3 INTO DESCRIPTOR :S3sqlda
  Line 29   Sqlcode = 0   Fetch 1   Elapsed = 0.011415 sec
--------------------------
  SQLDA data in S3SQLDA:
 VARCHAR(24)              NAME  = 'DFADB2  '
 VARCHAR(128)          CREATOR  = 'GSYSADMT'
 VARCHAR(128)          STGROUP  = 'SGFA    '
 CHAR(8)                 BPOOL  = 'BP49    '
 CHAR(8)               INDEXBP  = 'BP49    '

FETCH C3 INTO DESCRIPTOR :S3sqlda
  Line 29   Sqlcode = 0   Fetch 2   Elapsed = 0.020866 sec
--------------------------
  SQLDA data in S3SQLDA:
 VARCHAR(24)              NAME  = 'DFALCOMB'
 VARCHAR(128)          CREATOR  = 'DQCDMADM'
 VARCHAR(128)          STGROUP  = 'GDM01'
 CHAR(8)                 BPOOL  = 'BP2     '
 CHAR(8)               INDEXBP  = 'BP3     '

FETCH C3 INTO DESCRIPTOR :S3sqlda
  Line 29   Sqlcode = +100   Sqlstate = 02000   Elapsed = 0.008946 sec

CLOSE C3
  Line 51   Sqlcode = 0   Elapsed = 0.006895 sec
--------------------------
  There were 2 successful fetches from this cursor

CLOSE C4
  Line 52   Sqlcode = 0   Elapsed = 0.031386 sec
--------------------------
  There were 1 successful fetches from this cursor

DISCONNECT
  Line 53   Sqlcode = 0   Elapsed = 0.012541 sec
________________________________________________________________________

   A trace can be used to check particular statemenets, or just to give
   warnings.

   The trace can be turned on to check interesting statements and turned
   off to ignore repetitive ones like fetches in a loop.  If you insert
   a Rexx statement into the original code like:
      runsql_trace = 'YES'
   it will produce a trace of each SQL statement that follows until a:
      runsql_trace = 'NO'
   statement turns the trace off again.

   Each trace entry begins with the statement invoked, shows all the
   related Rexx variables (and their values) which are input or output
   for the statement, and is followed by a blank line.  The trace output
   is ideal for checking the SQL processing during the development of a
   new Rexx/DB2 exec, because it gives all the information you need in a
   convenient format and avoids using a normal Rexx trace.

   Warnings:
   Sometimes when SQL runs successfully there is a warning generated.
   If any SQL statement returns a non-zero SQLCODE or SQLSTATE that is
   not considered an SQL error - the trace output will include a text
   explanation.  That is done for all the non-zero codes except for any
   FETCH returning SQLCODE = +100 after at least 1 successful fetch.

   The WARN trace option can be chosen to create trace output only for
   statements which have such warning texts, as follows:
      runsql_trace = 'WARN'
   The WARN option could be a good general choice for programs to show
   warnings which are not normally reported, or for programs calling
   stored procedures which occasionally return warning sqlstate codes.


 RUNSQL OUTPUT:
 -------------
   The RUNSQL output is passed (via a Rexx stack) to the RSQLMSGS exec
   to format and write it to the desired DDNAME.  If a file is already
   allocated it will be written to, and if not the DDNAME will be
   dynamically allocated to SYSOUT (or the terminal for online TSO).

   The default DDNAME is the same as the member name of the exec that is
   running, but the desired name can be specified either:
       a) rc = RUNSQL("sql_statement",,'ddname')
   or it can be set via a separate statement like:
       b) runsql_ddname = 'MYDD'    /* write to DDNAME = MYDD */
   and it will continue using that ddname for any subsequent output,
   until the end of the exec or another statement which changes the name
   of the ddname.

   If the ddname is set to SYSTSPRT the output will be be mixed with any
   normal Rexx trace output, and any long output lines will be wrapped
   at column 80.


 DETAILED IMPLEMENTATION INSTRUCTIONS:
 ------------------------------------

 1) Components:
 --------------

   RUNSQL   (exec)  is actually a group of Rexx procedures starting
                    with RUNSQL (in member RUNSQL) which must be
                    copied to the end of each existing DSNREXX exec
                    which will use it.
              Executes SQL, tracks variables/names & passes info to
              the RSQLMSGS function to create output.  Note that it
              tries to avoid variable name conflicts by only using
              names that start with "runsql_".

   RSQLMSGS (exec)  to be located in the same exec library, or some
                    other library in SYSEXEC/SYSPROC allocation.
              Writes ERROR or TRACE report to console or to a ddname.
              This runs as an external function to avoid Rexx variable
              name conflict.

   DSNTIAR  (load)  in a load library, usually xxxx.SDSNLOAD which
                    must be allocated when RUNSQL is run.
              Standard IBM program to produce SQL error diagnostic text.


 2) RUNSQL statements:
 --------------------

   a) trace the SQL statements
     runsql_trace = 'NO'         /* 'NO' is the default  */
     runsql_trace = 'YES'        /* trace all statements */
     runsql_trace = 'WARN'       /* show warnings only   */

   b) ROLLBACK and force abend if SQL error
     runsql_abend = 'NO'         /* 'NO' is the default  */
     runsql_abend = 'YES'        /* abend with rc = 99   */

   c) specify RUNSQL output destination
     runsql_ddname = 'ddname'    /* default is name of exec */
     runsql_ddname = 'SYSTSPRT'  /* output to terminal      */

   d) connect to DB2
     rc = RUNSQL("CONNECT" ssid)

   e) for each SQL statement
     rc = RUNSQL("sql_statement")  /* 0 & +ve sqlcodes are OK */
     rc = RUNSQL("sql_statement",'list_of_codes')

   f) connect to DB2
     rc = RUNSQL("DISCONNECT")


 3) Converting old code:
 ---------------------

   a) Replace EXECSQL statements:
         c 'address DSNREXX "EXECSQL ' 'rc = RUNSQL("' all
         c '"EXECSQL ' 'rc = RUNSQL("' all

         If none of them are continued onto the next line do this:
         x all;f RUNSQL all

         Add a right bracket to end each changed line or to the end
         of the last line of a multi-line SQL statement, so that each
         is like:  rc = RUNSQL("sql_statement")


    b) Convert CONNECT & DISCONNECT
         You can change: address DSNREXX "CONNECT" ssid
                     to: rc = RUNSQL("CONNECT" ssid)

         You can change: address DSNREXX "DISCONNECT"
                     to: rc = RUNSQL("DISCONNECT")

         Then you can remove anything like the following:
          a) address TSO "SUBCOM DSNREXX"
             if rc then s_rc = RXSUBCOM('ADD','DSNREXX','DSNREXX')
          b) address DSNREXX


    c) Add the following, near the top of the exec
         runsql_trace = 'NO'         /* 'NO' is the default */

       - Optionally add these two as well:
         runsql_abend = 'NO'         /* 'NO' is the default */
         runsql_ddname = 'ddname'    /*  defaults to name of exec */

       - Note: If you have set these variables, their values must be
               current when RUNSQL is called.  Hence if RUNSQL is in
               a procedure with the 'expose' keyword, make sure those
               variables are also in the 'expose' list.


    d) Copy the RUNSQL member to the end of the exec
         It includes the following procedures
           RUNSQL             - main
           RUNSQL_SAVE_INFO   - maintain SQL cross-reference arrays
           RUNSQL_FIND_NO     - used by RUNSQL_SAVE_INFO
           RUNSQL_CONDS       - handle boolean sqlcode conditions
           RUNSQL_MSGS        - put output information msgs in stack
           RUNSQL_RUN_DSNTIAR - create DSNTIAR formatted messages
         Don't change any of that code.


    e) Ensure RSQLMSGS member is in same library (or at least in the
         SYSEXEC or SYSPROC allocations)

    f) Ensure that the appropriate SDSNLOAD library is allocated in
         the Linklist, STEPLIB, a tasklib, or ISPLLIB.


 SUPPORT:
 -------
   For any queries about this please contact Ron Brown by email at
     Ronek.Consulting@gmail.com


------------------------------------------------------------------------
 RUNSQL MEMBER:
 =============

/**********************************************************************
 ** RUNSQL: Run SQL statement & show error/trace msgs    Version 1.7 **
 **------------------------------------------------------------------**
 ** Usage(1): runsql_trace = 'NO' /* only show msgs if error */      **
 **           rc = RUNSQL(parms)                                     **
 **                                                                  **
 ** Usage(2): runsql_trace = 'YES' /* show msgs for each sqlstmt */  **
 **           rc = RUNSQL(parms)                                     **
 **                                                                  **
 ** Usage(3): runsql_trace = 'WARN' /* only show warning msgs */     **
 **           rc = RUNSQL(parms)                                     **
 **                                                                  **
 ** Returns:  rc is set to same value as the rc for "EXECSQL"        **
 **           unless: runsql_abend = 'YES' is coded and the sqlcode  **
 **           is an error; then it does "ROLLBACK" and EXIT 99       **
 **                                                                  **
 ** Parms:    sql_statement , sql_code_list , ddname                 **
 **           only sql_statement is required,the others are optional **
 **           sql_code_list = codes which do not need error msgs     **
 **           ddname = sets or resets output DDNAME                  **
 **                                                                  **
 **           Rexx like:  runsql_ddname = 'MYDD' can also be used to **
 **           set the ddname, and if it is not already allocated it  **
 **           will be dynamically allocated by RSQLMSGS exec         **
 **                                                                  **
 ** External: RSQLMSGS (exec to format and write the output)         **
 **           DSNTIAR  (load module to create SQL diagnostic text)   **
 **------------------------------------------------------------------**
 ** Written by Ron Brown: 03 Jun 2008      Last updated: 11 Sep 2008 **
 **********************************************************************/
 RUNSQL:
   Trace O                          /* stop any trace from the caller */
   runsql_exec_line = ' Line' SIGL  /* where did I come from? */
   /* get parameters, setting defaults if necessary */
   Parse Arg runsql_statement , runsql_code_list , runsql_ddname_arg
   runsql_statement = Strip(runsql_statement)
   If runsql_code_list = '' Then    /* not specified */
      runsql_code_list = '>=0'      /* set default OK SQL code */
   Else If Verify(runsql_code_list,' 0123456789+-<>^/=,&]') > 0 Then Do
      Say ' '
      Say "RUNSQL Error: invalid list of OK SQLCODES specified:",
             "'"]] runsql_code_list ]]"'"
      Say "  It must be sqlcodes or conditions, separated",
                  "by commas (eg. '>=0,-904,-905' )"
      Say "  Conditions can include ']' or '&' characters",
                  "(eg. '>= 0 & ^= +335' )"
      Say ' '
      sqlcode = -999
      Return -1
      End
   If runsql_ddname_arg <> '' Then runsql_ddname = runsql_ddname_arg
   Else If Symbol('runsql_ddname') = 'LIT' Then Do /* set default */
           Parse Source . . runsql_exec_name .
           If runsql_exec_name <> '?'
              Then runsql_ddname = runsql_exec_name
              Else runsql_ddname = 'SYSTSPRT'  /* default ddname */
           End

   /* save csrname, stmtname, stmttext, locname and/or varnames */
   /* as appropriate into stems so that function RSQLMSGS can   */
   /* create output messages with all the related information   */
   If runsql_laststmt <> runsql_statement Then Do
      runsql_laststmt = runsql_statement
      Call RUNSQL_SAVE_INFO
      End

   /* run the SQL */
   If runsql_trace = 'YES' ] runsql_trace = 'WARN' Then
      runsql_timer = Time('R')
   If runsql_firstwd = 'CONNECT' ] runsql_firstwd = 'DISCONNECT' Then Do
      Address TSO "SUBCOM DSNREXX"
      If rc Then
         runsql_rxsubcom_rc = RXSUBCOM('ADD','DSNREXX','DSNREXX')
      Address DSNREXX runsql_stmtu
      runsql_execsql_rc = rc
      If runsql_execsql_rc = 0 Then
         Parse Var runsql_stmtu runsql_verb runsql_connect
      End
   Else Do
      Address DSNREXX "EXECSQL" runsql_statement
      runsql_execsql_rc = rc
      If runsql_firstwd = 'FETCH' & sqlcode = 0 Then
         runsql_fetches.runsql_no = runsql_fetches.runsql_no + 1
      End
   If runsql_trace = 'YES' ] runsql_trace = 'WARN' Then
      runsql_timer = Time('R')

   /* test if it matches desired sqlcode */
   Parse Var runsql_code_list runsql_cond.1 ',' runsql_cond.2 ',' ,
            runsql_cond.3 ',' runsql_cond.4 ',' runsql_cond.5 ',' ,
            runsql_cond.6 ',' runsql_cond.7 ',' runsql_cond.8
   runsql_ok = 'NO'
   Do runsql_i = 1 to 8 /* check until 1st matching sqlcode condition */
      If runsql_cond.runsql_i = '' Then Leave
      If Pos(Left(Strip(runsql_cond.runsql_i),1),'=<>^/') = 0
         Then runsql_c = '=' runsql_cond.runsql_i
         Else runsql_c = runsql_cond.runsql_i
      If Verify(runsql_c,']&','M') > 0 Then
         /* prepare complex conditions for interpret */
         Call RUNSQL_CONDS
      Interpret "If sqlcode "runsql_c" Then runsql_ok = 'YES'"
      If runsql_ok = 'YES' Then Leave runsql_i
      End

   /* WRITE TRACE: output every SQL statement if trace is 'YES' */
   If runsql_trace = 'YES' & runsql_ok = 'YES' Then
      Call RUNSQL_MSGS('TRACE')
      /* & WARN output if sqlcode non-zero, except +100 for a FETCH */
   If (runsql_trace = 'WARN' & runsql_ok = 'YES',
        & (sqlstate <> '00000' ] sqlcode <> 0 )),
      & (runsql_firstwd <> 'FETCH' ] sqlcode <> 100 ],
         runsql_fetches.runsql_no = 0 ) Then
      Call RUNSQL_MSGS('TRACE')

   /* bad sqlcode: write diagnostic information */
   If runsql_ok = 'NO' Then Do
      Call RUNSQL_MSGS('ERROR')
      /* abend the main exec */
      If runsql_abend = 'YES' Then Do     /* cleanup, then exit rc=99 */
         If Wordpos(runsql_firstwd,'CONNECT DISCONNECT') = 0,
          & runsql_execsql_rc <> -3 Then
            rc = RUNSQL("ROLLBACK",'<99999')  /* calling recursively! */
         ZISPFRC = 99           /* set return code for batch ISPF too */
         Address ISPEXEC "VPUT (ZISPFRC) SHARED"
         Exit zispfrc
         End
      End

   Return runsql_execsql_rc /* return same as EXECSQL would have done */

 /*********************************************************************/
 RUNSQL_SAVE_INFO:
   Trace O                          /* stop any trace from the caller */
   runsql_stmtu = Translate(runsql_statement)  /* -> upper case */
   runsql_firstwd = Word(runsql_stmtu,1)
   runsql_stmt = runsql_firstwd    /* default value, usually replaced */
   runsql_sqlda = ''
   If Symbol('runsql_count') = 'LIT' Then Do  /* if uninitialised */
      runsql_exec_name  = ''
      runsql_connect    = ''
      runsql_csrname.   = ''
      runsql_stmtname.  = ''
      runsql_stmttext.  = ''
      runsql_varnames.  = ''
      runsql_outvars.   = ''
      runsql_locname.   = ''
      runsql_fetches.   = 0
      runsql_count = 0
      End
   Select
     /* "DECLARE Cnn ... CURSOR FOR Snn" */
     When runsql_firstwd = 'DECLARE' Then Do
        Parse Var runsql_stmtu ,
           'DECLARE ' runsql_csr . ' FOR ' runsql_stmt .
        runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
        runsql_csrname.runsql_no = Strip(runsql_csr)
        End

     /* "PREPARE Snn FROM :sqltext" */
     /* "PREPARE Snn INTO :sqlda FROM :sqltext" */
     When runsql_firstwd = 'PREPARE' Then Do
        Parse Var runsql_stmtu ,
           'PREPARE ' runsql_stmt . 'FROM' . ':' runsql_text .
        runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
        If Pos(' INTO ',runsql_stmtu) > 0 Then
           Parse Var runsql_stmtu . 'INTO' . ':' runsql_sqlda .
        runsql_stmttext.runsql_no = Value(runsql_text)
        End


     /* "EXECUTE Snn USING :var1 :var2 ...."  */
     /* "EXECUTE Snn USING DESCRIPTOR :sqlda" */
     /* "EXECUTE IMMEDIATE :stmttext"         */
     When runsql_firstwd = 'EXECUTE' Then Do
        Parse Var runsql_stmtu ,
           'EXECUTE ' runsql_stmt . 'USING ' runsql_vars
        runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
        If runsql_stmt = 'IMMEDIATE' Then
           Parse Var runsql_stmtu . 'IMMEDIATE ' runsql_vars
        If Word(runsql_vars,1) = 'DESCRIPTOR' Then Do
           Parse Var runsql_stmtu . 'DESCRIPTOR' . ':' runsql_sqlda .
           runsql_vars = ''
           End
        Else
           runsql_vars = Space(Translate(runsql_vars,'    ',':(),'))
        runsql_varnames.runsql_no = runsql_vars
        End

     /* "OPEN Cnnn ..... USING :var1 :var2 :var3 ..." */
     /* "OPEN Cnnn ..... USING DESCRIPTOR :sqlda"    */
     When runsql_firstwd = 'OPEN' Then Do
        Parse Var runsql_stmtu ,
           'OPEN ' runsql_csr . 'USING ' runsql_vars
        runsql_no = RUNSQL_FIND_NO('runsql_csr' runsql_csr)
        If Word(runsql_vars,1) = 'DESCRIPTOR' Then Do
           Parse Var runsql_stmtu . 'DESCRIPTOR' . ':' runsql_sqlda .
           runsql_vars = ''
           End
        Else
           runsql_vars = Space(Translate(runsql_vars,'    ',':(),'))
        runsql_varnames.runsql_no = runsql_vars
        runsql_fetches.runsql_no = 0
        End

     /* "FETCH Cnnn ..... INTO :var1 var2 :var3 ..." */
     /* "FETCH Cnnn ..... INTO DESCRIPTOR :sqlda"    */
     /* "FETCH Cnnn ..... USING DESCRIPTOR :sqlda"   */
     When runsql_firstwd = 'FETCH' Then Do
        Parse Var runsql_stmtu ,
           'FETCH' runsql_csr . 'INTO ' runsql_vars
        runsql_no = RUNSQL_FIND_NO('runsql_csr' runsql_csr)
        If Pos(' DESCRIPTOR ',runsql_stmtu) > 0 Then
           Parse Var runsql_stmtu . 'DESCRIPTOR' . ':' runsql_sqlda .
        Else Do    /* normal host output variables */
           runsql_vars = Space(Translate(runsql_vars,'    ',':(),'))
           runsql_outvars.runsql_no = runsql_vars
           End
        /* runsql_fetches.runsql_no = runsql_fetches.runsql_no + 1 */
        End

     /* "CLOSE Cnnn" */
     When runsql_firstwd = 'CLOSE' Then Do
        runsql_csr = Word(runsql_stmtu,2)
        runsql_no = RUNSQL_FIND_NO('runsql_csr' runsql_csr)
        End

     /* "CALL storprocname (:var1 :var2 :var3 ...)" */
     /* "CALL storprocname USING DESCRIPTOR :sqlda" */
     When runsql_firstwd = 'CALL' Then Do
        Parse Var runsql_stmtu ,
           'CALL ' runsql_stmt '(' runsql_vars
        If Left(runsql_stmt,1) = ':'  /* get actual storprocname */
           Then runsql_stmt = Value(Substr(runsql_stmt,2))
        runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
        If Word(runsql_vars,1) = 'DESCRIPTOR' Then Do
           Parse Var runsql_stmtu . 'DESCRIPTOR' . ':' runsql_sqlda .
           runsql_vars = ''
           End
        Else
           runsql_vars = Space(Translate(runsql_vars,'    ',':(),'))
        runsql_varnames.runsql_no = runsql_vars
        runsql_stmttext.runsql_no = runsql_stmtu
        End

     /* "ASSOCIATE LOCATORS (:loc1 :loc2 ..) WITH PROCEDURE name" */
     When runsql_firstwd = 'ASSOCIATE' Then Do
        Parse Var runsql_stmtu ,
           'ASSOCIATE ' . '(' runsql_locs ')' . ,
           'PROCEDURE ' runsql_stmt .
        If Left(runsql_stmt,1) = ':'  /* get actual storprocname */
           Then runsql_stmt = Value(Substr(runsql_stmt,2))
        /* get values saved for "CALL" statement */
        runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
        runsql_calltext = runsql_stmttext.runsql_no
        runsql_vars = runsql_varnames.runsql_no
        /* create/update entries for each locator variable */
        runsql_locs = Space(Translate(runsql_locs,'    ',':(),'))
        Do runsql_loccnt = 1 to Words(runsql_locs)
           runsql_loc = Word(runsql_locs,runsql_loccnt)
           runsql_no = RUNSQL_FIND_NO('runsql_loc' runsql_loc)
           runsql_stmtname.runsql_no = Strip(runsql_stmt)
           runsql_stmttext.runsql_no = runsql_calltext
           runsql_varnames.runsql_no = runsql_vars
           End
        End

     /* "ALLOCATE Cnnn CURSOR FOR RESULT SET :locator" */
     When runsql_firstwd = 'ALLOCATE' Then Do
        Parse Var runsql_stmtu ,
           'ALLOCATE ' runsql_csr ' CURSOR ' . 'SET' ':' runsql_loc .
        runsql_no = RUNSQL_FIND_NO('runsql_loc' runsql_loc)
        runsql_csrname.runsql_no = Strip(runsql_csr)
        End

     /* "DESCRIBE Snn INTO :sqlda"                 */
     /* "DESCRIBE CURSOR :cursorname INTO :sqlda"  */
     /* "DESCRIBE INPUT Snn INTO :sqlda"           */
     /* "DESCRIBE PROCEDURE :procname INTO :sqlda" */
     /* "DESCRIBE TABLE :tablename INTO :sqlda"    */
     When runsql_firstwd = 'DESCRIBE' Then Do
        Parse Var runsql_stmtu ,
           'DESCRIBE ' runsql_stmt . 'INTO' . ':' runsql_sqlda
        runsql_stmt = Strip(runsql_stmt)
        Select
          When Pos(runsql_stmt,'CURSOR TABLE') > 0 Then Do
             runsql_csr = Word(runsql_stmtu,3)
             Parse Var runsql_csr ':' runsql_vars
             If Left(runsql_csr,1) = ':'  /* get actual csrname */
                Then runsql_csr = Value(runsql_vars)
             runsql_no = RUNSQL_FIND_NO('runsql_csr' runsql_csr)
             runsql_varnames.runsql_no = runsql_vars
             End
          When Pos(runsql_stmt,'INPUT PROCEDURE') > 0 Then Do
             runsql_stmt = Word(runsql_stmtu,3)
             Parse Var runsql_stmt ':' runsql_vars
             If Left(runsql_stmt,1) = ':'  /* get actual name */
                Then runsql_stmt = Value(runsql_vars)
             runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
             runsql_varnames.runsql_no = runsql_vars
             End
          Otherwise
             runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
             runsql_varnames.runsql_no = ''
          End
        End

     /* "INSERT .......", "UPDATE .....", "DELETE .....", etc. */
     Otherwise
        runsql_no = RUNSQL_FIND_NO('runsql_stmt' runsql_stmt)
     End
     Return

 /*********************************************************************/
 RUNSQL_FIND_NO: Procedure Expose  runsql_count ,
                 runsql_csrname. runsql_stmtname.  runsql_locname.
   Trace O                          /* stop any trace from the caller */
   Arg Var value .
   Do i = 1 to runsql_count
      Interpret 'If 'var'name.i = value Then Return i'
      End
   runsql_count = runsql_count + 1
   Interpret var'name.runsql_count = value'
   Return runsql_count

 /*********************************************************************/
 RUNSQL_CONDS:
   Trace O                          /* stop any trace from the caller */
   runsql_char = ']'
   Do 2  /* inserting 'sqlcode' after ']' or '&' characters */
      runsql_pos = 0
      Do runsql_loop = 1 to 9 Until runsql_cp = 0
         runsql_cp = Pos(runsql_char,runsql_c,runsql_pos+1)
         If runsql_cp > runsql_pos Then Do
            runsql_c = Insert(' sqlcode',runsql_c,runsql_cp)
            runsql_pos = runsql_cp
            End
         End
      runsql_char = '&'   /* now do it again for '&' */
      End
   Return

 /*********************************************************************/
 RUNSQL_MSGS:
   Trace O                          /* stop any trace from the caller */
   Arg runsql_mode
   Address TSO "Newstack"
   If Left(runsql_ddname,1) <> '>' ] runsql_mode = 'ERROR' Then Do
      /* get name of this exec, and possibly the library name  */
      Parse Source . . runsql_exec_name . runsql_library .
      If runsql_exec_name = '?' Then
         runsql_exec_name = runsql_library
      Else If runsql_library <> '?' Then
         runsql_exec_name = runsql_library'('runsql_exec_name')'
      Queue runsql_ddname runsql_mode runsql_exec_name runsql_exec_line
      End
   Else Queue runsql_ddname runsql_mode
   If runsql_mode = 'ERROR' Then
      Queue runsql_connect                /* connection status        */
   Queue runsql_statement                 /* (failing) SQL statement  */
   If runsql_mode = 'TRACE' Then Do
      /* sqlcode, sqlstate, num rows, elapse secs, fetches, exec line */
      Queue SQLCODE SQLSTATE SQLERRD.3 runsql_timer ,
            runsql_fetches.runsql_no runsql_exec_line
      /* get diagnostic text if non-zero SQLCODE/SQLSTATE */
      If (SQLCODE <> 0 ] SQLSTATE <> '00000' ),
      & (runsql_firstwd <> 'FETCH' ] SQLCODE <> 100 ],
         runsql_fetches.runsql_no = 0 ) Then Do
         Call RUNSQL_RUN_DSNTIAR
         Queue Substr(runsql_errmsg,3)    /* just message text */
         End
      /* prepared sql statement text */
      If Pos(runsql_firstwd,'PREPARE ASSOCIATE') > 0 Then
         Queue runsql_stmttext.runsql_no
      End
   If runsql_mode = 'ERROR' Then Do
      Call RUNSQL_RUN_DSNTIAR
      Queue Substr(runsql_errmsg,3)    /* just message text */
      Queue runsql_stmttext.runsql_no  /* prepared sql statement text */
      End
   If runsql_firstwd = 'CLOSE' & sqlcode >= 0 Then
      Queue '  There were' runsql_fetches.runsql_no,
            'successful fetches from this cursor'
   /* host variables used */
   If runsql_firstwd = 'ALLOCATE' Then Do
      If runsql_loc <> '' Then
         Queue Right(runsql_loc,18) "= '"Value(runsql_loc)"'"
      End
   If runsql_firstwd = 'ASSOCIATE' Then
      Do runsql_varno = 1 to Words(runsql_locs)
         runsql_var = Word(runsql_locs,runsql_varno)
         Queue Right(runsql_var,18) "= '"Value(runsql_var)"'"
         End
   If (runsql_firstwd = 'FETCH' & runsql_mode = 'ERROR' ),
    ] (Pos(runsql_firstwd,'CALL EXECUTE OPEN DESCRIBE') > 0 ,
       ] runsql_mode = 'ERROR' ) Then
      Do runsql_varno = 1 to Words(runsql_varnames.runsql_no)
         runsql_var = Word(runsql_varnames.runsql_no,runsql_varno)
         Queue Right(runsql_var,18) "= '"Value(runsql_var)"'"
         End
   /* host output variables */
   If runsql_firstwd = 'FETCH' & sqlcode >= 0 & sqlcode <> 100 Then
      Do runsql_varno = 1 to Words(runsql_outvars.runsql_no)
         runsql_var = Word(runsql_outvars.runsql_no,runsql_varno)
         Queue Right(runsql_var,18) "= '"Value(runsql_var)"'"
         End
   /* SQLDA variables */
   If (runsql_sqlda <> '' & sqlcode >= 0),
   & (runsql_firstwd <> 'FETCH' ] sqlcode <> 100) Then Do
      Queue '  SQLDA data in' runsql_sqlda':'
      Interpret 'runsql_columns = 'runsql_sqlda'.SQLD'
      If Datatype(runsql_columns) = 'NUM' Then
      Do runsql_colno = 1 to runsql_columns
         runsql_stem = runsql_sqlda'.'runsql_colno
         Interpret 'runsql_var = 'runsql_stem'.SQLNAME'
         If runsql_var = '' Then runsql_var = '?????   '
         Interpret 'runsql_typ = 'runsql_stem'.SQLTYPE'
         Interpret 'runsql_len = 'runsql_stem'.SQLLEN'
         Interpret 'runsql_pre = 'runsql_stem'.SQLLEN.SQLPRECISION'
         Interpret 'runsql_sca = 'runsql_stem'.SQLLEN.SQLSCALE'
         If Symbol(runsql_stem'.SQLDATA') = 'LIT'
            Then  runsql_val = ''
            Else Interpret "runsql_val = "runsql_stem".SQLDATA"
         Select
           When Pos(runsql_typ,'384 385') > 0 Then
                runsql_t = ' DATE'
           When Pos(runsql_typ,'388 389') > 0 Then
                runsql_t = ' TIME'
           When Pos(runsql_typ,'392 393') > 0 Then
                runsql_t = ' TIMESTAMP'
           When Pos(runsql_typ,'404 405') > 0 Then
                runsql_t = ' BLOB'
           When Pos(runsql_typ,'408 409') > 0 Then
                runsql_t = ' CLOB'
           When Pos(runsql_typ,'412 413') > 0 Then
                runsql_t = ' DBCLOB'
           When Pos(runsql_typ,'448 449 456 457') > 0 Then
                runsql_t = ' VARCHAR('runsql_len')'
           When Pos(runsql_typ,'452 453') > 0 Then
                runsql_t = ' CHAR('runsql_len')'
           When Pos(runsql_typ,'464 465 472 473') > 0 Then
                runsql_t = ' VARGRAPHIC('runsql_len')'
           When Pos(runsql_typ,'468 469') > 0 Then
                runsql_t = ' GRAPHIC('runsql_len')'
           When Pos(runsql_typ,'480 481') > 0 Then
                runsql_t = ' FLOAT'
           When Pos(runsql_typ,'484 485') > 0 Then
                runsql_t = ' DECIMAL('runsql_pre','runsql_scale')'
           When Pos(runsql_typ,'492 493') > 0 Then
                runsql_t = ' BIGINT'     /* DB2 9 */
           When Pos(runsql_typ,'496 497') > 0 Then
                runsql_t = ' INTEGER'
           When Pos(runsql_typ,'500 501') > 0 Then
                runsql_t = ' SMALLINT'
           When Pos(runsql_typ,'988 989') > 0 Then
                runsql_t = ' XML'        /* DB2 9 */
           Otherwise runsql_t = ''
           End
         runsql_off = 30 - Length(runsql_var) /* offset in output */
         Queue Overlay(' 'runsql_var,Left(runsql_t,30),runsql_off),
            " = '"runsql_val"'"
         End
      End
   runsql_ddname = RSQLMSGS()          /* format the output as needed */
   Address TSO "Delstack"
   Return runsql_ddname             /* ddname will be prefixed by '>' */

 /*********************************************************************/
RUNSQL_RUN_DSNTIAR:
   Trace O                          /* stop any trace from the caller */
   Numeric Digits 12
   /* If DSNREXX never succesfully initialised there is no SQLCA data */
   If SQLCODE = 'SQLCODE' ] runsql_execsql_rc = -3 Then Do
      runsql_m1 = Left('   DSNREXX error',82)
      runsql_m2 = Left(' -------------',80)
      runsql_m3 = Left(' DSNREXX not functioning correctly, rc =',
               runsql_execsql_rc,80)
      runsql_m4 = Left(' Ensure that the SDSNLOAD library is',
               'allocated in Linklist, STEPLIB or ISPLLIB,',80)
      runsql_m5 = Left(' then DSNREXX host command environment can be',
               'made available and SQL run.',80)
      runsql_errmsg = runsql_m1]]runsql_m2]]runsql_m3]]runsql_m4]],
                      runsql_m5
      Return
      End
   /* Build normal SQLCA for DSNTIAR from Rexx variables */
   runsql_SQLCA = 'SQLCA   ']]D2C(136,4),   /* 136 = length of SQLCA */
           ]]D2C(SQLCODE,4),
           ]]D2C(70,2)]]Left(SQLERRMC,70),  /* message tokens */
           ]]Left(SQLERRP,8),  /* (or set to 'DSN     ' to suppress) */
           ]]D2C(SQLERRD.1,4)]]D2C(SQLERRD.2,4)]]D2C(SQLERRD.3,4),
           ]]D2C(SQLERRD.4,4)]]D2C(SQLERRD.5,4)]]D2C(SQLERRD.6,4),
           ]]Left(SQLWARN.0,1)]]Left(SQLWARN.1,1)]]Left(SQLWARN.2,1),
           ]]Left(SQLWARN.3,1)]]Left(SQLWARN.4,1)]]Left(SQLWARN.5,1),
           ]]Left(SQLWARN.6,1)]]Left(SQLWARN.7,1)]]Left(SQLWARN.8,1),
           ]]Left(SQLWARN.9,1)]]Left(SQLWARN.10,1)]]Left(SQLSTATE,5)
   runsql_msglen = 80  /* Message line length ( 72 to 240 allowed) */
   runsql_msglen12 = runsql_msglen * 12  /* up to 12 lines of msgs */
   runsql_errmsg = D2C(runsql_msglen12,2)]]Copies(' ',runsql_msglen12)
   runsql_errlen = D2C(runsql_msglen,4)
   /* run DSNTIAR passing SQLCA to it & getting message text returned */
   Address LINKPGM "DSNTIAR runsql_SQLCA runsql_errmsg runsql_errlen"
   If rc <> 0 Then Do  /* this should not happen, but just in case... */
      runsql_m7 = Left(' Error message text not available because',
                       'invocation of DSNTIAR failed, rc =' rc,80)
      runsql_m1 = Left('   Fields from Rexx SQLCA',82)
      runsql_m2 = Left(' ----------------------',80)
      runsql_m3 = Left(' Sqlcode =' SQLCODE '  ',
               ' Sqlstate =' SQLSTATE '   Sqlerrp =' SQLERRP,80)
      runsql_m4 = Left(' Tokens =' Translate(SQLERRMC,',','FF'x),80)
      runsql_m5 = Left(' Sqlerrd =' SQLERRD.1]]',']]SQLERRD.2]]',',
         SQLERRD.3]]',']]SQLERRD.4]]',']]SQLERRD.5]]','SQLERRD.6,80)
      runsql_m6 = Left(' Sqlwarn =' SQLWARN.0]]',',
         SQLWARN.1]]',']]SQLWARN.2]]',']]SQLWARN.3]]','SQLWARN.4]]',',
         SQLWARN.5]]',']]SQLWARN.6]]',']]SQLWARN.7]]','SQLWARN.8]]',',
         SQLWARN.9]]','SQLWARN.10,80)
      runsql_errmsg = runsql_m1]]runsql_m2]]runsql_m3]]runsql_m4,
                    ]]runsql_m5]]runsql_m6]]runsql_m7
      End
   Return

------------------------------------------------------------------------
 RSQLMSGS MEMBER:
 ===============

/************************** REXX FUNCTION *****************************
 ** RSQLMSGS: Output SQL error or trace messages        Version 1.7  **
 **                                                                  **
 ** Usage:    called by RUNSQL procedure in many different execs     **
 **             which use DSNREXX interface.                         **
 **------------------------------------------------------------------**
 ** Written by Ron Brown: 03 Jun 2008     Last updated: 11 Sep 2008  **
 **********************************************************************/
RSQLMSGS:
 /* get: output DDNAME, 'ERROR'/'TRACE', exec name, exec line number */
 /*  or: output DDNAME, 'TRACE'          (if not ERROR or 1st TRACE) */
 Parse Pull ddname trace execname execline
 out. = '  '

 /* create output header */
 If trace = 'ERROR' Then Do
    out.2 = '================================== SQL Error',
            '=================================='
    out.3 = Right(Date()'  'Time('N') ,77)
    out.3 = Overlay(execname execline,out.3,3)
    /* DB2 connection status */
    out.5 = 'Running on system' Mvsvar('SYSNAME')
    Pull ssid .           /* has ssid if connected, otherwise blank */
    If ssid <> '' Then out.5 = out.5 '     Connected to' ssid
    line_no = 6
    End
 If trace = 'TRACE' Then Do
    If Left(ddname,1) <> '>' Then Do
       out.2 = '-------------------------------- Start Trace',
               '----------------------------------'
       out.3 = Right(Date()'  'Time('N') ,77)
       out.3 = Overlay(execname,out.3,3)
       line_no = 4
       End
    Else line_no = 0
    End

 /* output the current (failing?) SQL statement */
 Parse Pull sqlstmt
 sqlstmt = Strip(sqlstmt)
 If Length(sqlstmt) > 72 Then
    Call SQL72(sqlstmt)
 Else
    Call NEXTLINE sqlstmt

 /* output the sqlcode etc. for a TRACE */
 If trace = 'TRACE' Then Do
    firstwd = Word(Translate(sqlstmt),1)
    Parse Pull sqlcode sqlstate rows elapsed fetch exec_line
    If sqlcode > 0 Then sqlcode = '+']]sqlcode
    result_line = ' 'exec_line'   Sqlcode =' sqlcode
    If sqlstate > '00000' Then
       result_line = result_line '  Sqlstate =' sqlstate
    If rows > 0 & firstwd <> 'PREPARE' Then
       result_line = result_line '  Rows =' rows
    If fetch > 0 & firstwd = 'FETCH' & sqlcode = 0 Then
       result_line = result_line '  Fetch' fetch
    result_line = result_line '  Elapsed =' elapsed 'sec'
    Call NEXTLINE result_line
    End

 /* output DSNTIAR formatted error message */
 If (trace = 'TRACE' & (sqlcode <> 0 ] sqlstate <> 00000 ) ,
      & (firstwd <> 'FETCH' ] sqlcode <> 100 ] fetch = 0) ),
  ] trace = 'ERROR' Then Do
    Parse Pull SQLERRMSG
    errmsg. = ''
    Parse Var SQLERRMSG 2 errmsg.1 81  82 errmsg.2 161 162 errmsg.3 241,
                     242 errmsg.4 321 322 errmsg.5 401 402 errmsg.6 481,
                     482 errmsg.7 561 562 errmsg.8 641 642 errmsg.9 721
    If trace = 'TRACE' & Left(errmsg.1,6) = 'DSNT40' Then Do
       Call NEXTLINE '--------------------------'
       cpos = Pos(',',errmsg.1)
       errmsg.1 = Substr(errmsg.1,cpos+2) /* remove SQLCODE = ccccc, */
       Call NEXTLINE '  'errmsg.1
       Do msg_no = 2 to 9
          If Word(errmsg.msg_no,1) = 'DSNT418I' Then Leave
          Call NEXTLINE '  'Strip(errmsg.msg_no)
          End
       End
    If trace = 'ERROR' Then Do
       line_no = line_no + 1   /* leave blank line */
       Do msg_no = 1 to 9
          If errmsg.msg_no <> '' Then
             Call NEXTLINE errmsg.msg_no
          End
       line_no = line_no + 1   /* leave blank line */
       End
    End

 /* output the (failing) SQL statement */
 If trace = 'ERROR' ,
  ] Pos(Word(sqlstmt,1),'PREPARE ASSOCIATE') > 0 Then Do
    Parse Pull stmttext
    If stmttext <> '' Then Do
       stmttext = Strip(stmttext)
       If trace = 'ERROR' Then
          Call NEXTLINE 'Failing SQL statement text'
       Call NEXTLINE '--------------------------'
       If Length(stmttext) > 72 Then
          Call SQL72(stmttext)   /* format SQL text */
       Else
          Call NEXTLINE stmttext
       If trace = 'ERROR' Then
          line_no = line_no + 1   /* leave blank line */
       End
    End

 /* output any related REXX host variable values */
 If Queued() > 0 Then Do
    If trace = 'ERROR' Then
       Call NEXTLINE 'REXX host variable values'
    Call NEXTLINE '--------------------------'
    Do var_no = 1 to Queued()   /* already formatted in the stack */
       line_no = line_no + 1
       Parse Pull out.line_no
       End
    If trace = 'ERROR' Then
       line_no = line_no + 1   /* leave blank line */
    End

 If trace = 'ERROR' Then Do
    Call NEXTLINE '======================================',
             ]] '========================================'
    line_no = line_no + 1   /* leave blank line */
    End
 line_no = line_no + 1   /* leave blank line */

 /* write the output */
 If Left(ddname,1) = '>' Then       /* file has already been used */
    ddname = Substr(ddname,2)
 Else Do             /* check file allocated before writing to it */
    If ddname <> 'SYSTSPRT' Then Do
       x = LISTDSI(ddname 'FILE')
       If x > 4 & SYSREASON <> 3 Then
          Address TSO "ALLOC FILE("ddname") DSNAME(*)"
       End
    End
 If ddname <> 'SYSTSPRT' Then Do
    execio_cmd = "EXECIO" line_no "DISKW" ddname "(STEM out. OPEN"
    Address TSO execio_cmd
    ec_rc = rc
    If ec_rc > 1 Then Do      /* rc=1 for DISKW if data truncated */
       Say ' '
       Say 'RUNSQL Error: Command "'execio_cmd'"'
       Say '              abended with rc =' ec_rc
       Say '       Switching output to terminal (SYSTSPRT)'
       Say ' '
       ddname = 'SYSTSPRT'
       End
    End
 If ddname = 'SYSTSPRT' Then Do l = 1 to line_no
    Say out.l
    End
 Return '>']]ddname


/*====================================================================*/
NEXTLINE:
  Parse Arg lineout
  line_no = line_no + 1
  out.line_no = lineout
  Return

/*====================================================================*/
/* SQL72: Split a long SQL statement into multiple 72 byte lines      */
/*        That output should be directly usable in SPUFI or DSNTEP2.  */
/*--------------------------------------------------------------------*/
/* Notes: Ideally for readability - any multi-line SQL should be      */
/*        coded in the Rexx variable with some blanks at the start of */
/*        each new line, and only single blanks elsewhere in the SQL. */
/*        The offsets from the leading blanks will be preserved when  */
/*        the reformatting is done, hence it can look the same as in  */
/*        the original multi-line Rexx assignment statement.          */
/*--------------------------------------------------------------------*/
SQL72:
  Trace O                           /* stop any trace from the caller */
  Parse Arg sql
  total_quotes = 0
  start = line_no + 1
  Do line_no = start to 9999 While sql <> ''
     /* break line at first '  ' */
     sp = Wordindex(sql,1)
     Do i = 1 to 50 While sp <= 73
        p = Pos('  ',sql,sp)
        If p > 0 & p < 73 Then Do
           sql_string = Left(sql,p-1)
           num_quotes = Count_Quotes(sql_string)
           If (total_quotes + num_quotes) // 2 = 1 Then Do
              sp = sp + 2
              Iterate i
              End
           Else Do
              out.line_no = sql_string
              sql = Substr(sql,p)
              total_quotes = total_quotes + num_quotes
              Iterate line_no
              End
           End
        End
     /* if shorter than 72 it does not need to be broken up */
     If Length(sql) <= 72 Then Do
        out.line_no = sql
        Leave line_no
        End
     /* break line at last ) , ' ' or ' */
     sp = 72
     Do j = 1 to 50 While sp >= 1
        br = LastPos(')',sql,sp)
        co = LastPos(',',sql,sp)
        bl = LastPos(' ',sql,sp)
        qu = LastPos("'",sql,sp)
        p = Max(br,co,bl,qu)
        If p > 0 & p < 73 Then Do
           sql_string = Left(sql,p-1)
           num_quotes = Count_Quotes(sql_string)
           If (total_quotes + num_quotes) // 2 = 1 Then Do
              sp = sp - 1
              Iterate j
              End
           Else Do
              out.line_no = sql_string
              sql = Substr(sql,p)
              total_quotes = total_quotes + num_quotes
              Iterate line_no
              End
           End
        End
     /* no easy break point found */
     sql_string = Left(sql,72)
     out.line_no = sql_string
     sql = Substr(sql,73)
     num_quotes = Count_Quotes(sql_string)
     total_quotes = total_quotes + num_quotes
     End
  Return 0

Count_Quotes:  Procedure
  Arg sql_string
  sqlleng = Length(sql_string)
  sp = 1
  string_quotes = 0
  Do While sp <= sqlleng
    x = Pos("'",sql_string,sp)
    If x = 0 Then Leave
    string_quotes = string_quotes + 1
    sp = x + 1
    End
  Return string_quotes

-----------------------------------------------------------------------