Add SRV_SQL with SQLProblem procedure

Copy_Mbrs/README.md

@@ -2,7 +2,7 @@
 
 These are source files that will be copied into programs using /COPY or /INCLUDE
 
-* ##AIDBTYES 
+* ##AIDBTYE
 
     5250 Attention ID Definitions. These are the value that are returned  in byte 369 of the display file indicator data structure when a screen entry is made.
 
@@ -14,4 +14,6 @@ These are source files that will be copied into programs using /COPY or /INCLUDE
 
      Prototype definitions for procedures in the SRV_STR service program.
 
+* SRV_SQL_P
 
+     Prorotype definitions for procedures in the SQL_SRV service program.

Service_Pgms/README.md

@@ -1,6 +1,6 @@
 ### Service Programs
 
-Utility Service Programs. This is probably the first code you want to explore before going on to the interactive programs.
+Utility Service Programs. 
 
 * SRV_MSG
 
@@ -10,6 +10,10 @@ Utility Service Programs. This is probably the first code you want to explore be
 
     Contains procedures to manipulate strings in an RPG program.
 
+* SRV_SQL
+  
+  * Helper procedures for RPG programs using embedded SQL.
+  
 * CRTBNDDIR
 
    A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG.
@@ -25,4 +29,3 @@ Utility Service Programs. This is probably the first code you want to explore be
 * SRV_STRTR
 
      RPG program to test the procedures in SRV_STR.
-

Service_Pgms/SRV_SQL.SQLRPGLE

@@ -0,0 +1,56 @@
+**FREE
+//==============================================================
+//=== SRV_SQL service program contains prodcedure relating to
+//=== processing embedded SQL.
+//==============================================================
+// CRTRPGMOD MODULE(SRV_SQL)
+// CRTSRVPGM SRVPGM(SRV_SQL) EXPORT(*ALL)
+// ADDBNDDIRE BNDDIR(SQL_BND) OBJ((SRV_SQL *SRVPGM *DEFER))
+
+ctl-opt nomain
+      bnddir('UTIL_BND')
+      option(*NoDebugIo: *srcstmt);
+
+//=== SQLProblem ===============================================
+// For those "Never should happen" SQL errors.
+// Issues DUMP(A) to dump memory, then ends program by
+// sending an *ESCAPE message of the supplied debugging message,
+// plus whatever SQL diagnostics we can fit into 512 chars.
+dcl-proc SQLProblem export;
+  dcl-pi SQLProblem;
+    piSQLDebug varchar(200) const;
+  end-pi;
+
+  /include copy_mbrs,Srv_Msg_P
+
+  //--- Local Variables ---------------------------------
+  dcl-s myDebugMsg varchar(512); //Max CPF9898 supports
+  dcl-s wkRem int(10);
+
+  // Returned SQL diagnostic info
+  dcl-s mySQLState CHAR(5);
+  dcl-s mySQLMsgTxt varchar(32740);
+  dcl-s mySQLMsgLgth int(5);
+
+  exec sql get diagnostics condition 1
+      :mySQLState = RETURNED_SQLSTATE,
+      :mySQLMsgTxt = MESSAGE_TEXT,
+      :mySQLMsgLgth = MESSAGE_LENGTH
+  ;
+  myDebugMsg =  piSQLDebug
+      + ' - Unexpected SQL return: SQLSTATE='
+      + mySQLState
+      + '. "';
+
+  // Fit in as much of mySQLMsgTxt as possible.
+  wkRem = (%size(myDebugMsg)-2) - %len(myDebugMsg);
+  if wkRem >= mySQLMsgLgth +1;
+    myDebugMsg += (mySQLMsgTxt +'"');
+  else;
+    myDebugMsg += (%subst(mySQLMsgTxt: 1 :wkRem -5) + ' ..."');
+  endif;
+
+  dump(a);
+  SndEscMsg(myDebugMsg);
+  return;
+end-proc;