* Program: TESTSQL
      *
      * Compile: CRTSQLRPGI OBJ(OBJLIB/TESTSQL) SRCFILE(SRCLIB/TESTSQL)
      *                     OBJTYPE(*PGM) COMMIT(*NONE)
      *
      *
      * 
      * Stored Procedure Definition:
      * 
      * CREATE PROCEDURE TESTSQL
      * EXTERNAL 
      * LANGUAGE RPGLE
      * READS SQL DATA            
      * RESULT SETS 1             
      * SIMPLE CALL     
      * 
      *
      *
      *
     H DftActGrp(*No) ActGrp(*Caller)

     D SQLErrorMsg     PR
      *================================================================
      * Prototype/variables for sending a program message
      *================================================================
     D QMHSNDPM        PR                  ExtPgm('QMHSNDPM')
     D  pMsgId                             Like(MsgID)     Const
     D  pMsgFile                           Like(MsgFile)   Const
     D  pMsgDta                            Like(MsgDta)    Const
     D  pMsgDtaLen                         Like(MsgDtaLen) Const
     D  pMsgType                           Like(MsgType)   Const
     D  pMsgStack                          Like(MsgStack)  Const
     D  pMsgStack#                         Like(MsgStack#) Const
     D  pMsgKey                            Like(MsgKey)
     D  pMsgError                          Like(dsErrCode)
      *
     D MsgId           s              7a
     D MsgFile         s             20a   Inz('QCPFMSG   *LIBL')
     D MsgDta          s            256
     D MsgType         s             10a
     D MsgStack        s             10a   Inz('*')
     D MsgKey          s              4a
     D MsgDtalen       s             10i 0
     D MsgStack#       s             10i 0 Inz(3)
      *==============================================================
      * Error Code Data Structure for API Calls
      *==============================================================
     DdsErrCode        ds
     D  BytesProvided                10i 0 Inz(%size(MsgData))
     D  BytesAvail                   10i 0
     D  ExceptionID                   7
     D  Reserved                      1
     D  MsgData                     128

     C/EXEC SQL
     C+  DECLARE ORDERS CURSOR FOR
     C+   SELECT *
     C+     FROM ORDERS
     C+ ORDER BY ORDERID
     C/END-EXEC

     C/EXEC SQL
     C+ OPEN ORDERS
     C/END-EXEC
      *
      * An SQLCOD<0 reflects an error condition
      *
     C                   If        SQLCOD<*Zero
     C                   CallP(E)  SQLErrorMsg
     C                   EndIf

     C                   Eval      *InLR=*On
     C                   Return
      *================================================================
      * Subprocedure: Send SQL Error Message back to client
      *================================================================
     P SQLErrorMsg     B
      *
     C                   Eval      MsgID='SQL'+%Subst(%EditW(%Abs(
     C                                   SQLCOD):'0         '):7)
     C                   Eval      MsgFile='QSQLMSG   *LIBL'
     C                   Eval      MsgDta=SQLERM
     C                   Eval      MsgDtaLen=SQLERL
     C                   Eval      MsgType='*ESCAPE'
     C                   CallP(E)  QMHSNDPM(MsgId:
     C                                      MsgFile:
     C                                      MsgDta:
     C                                      MsgDtaLen:
     C                                      MsgType:
     C                                      MsgStack:
     C                                      MsgStack#:
     C                                      MsgKey:
     C                                      dsErrCode)
     C                   Return
     P SQLErrorMsg     E