Add StateVal Service PGM

Copy_Mbrs/SRV_STE_P.RPGLE

@@ -0,0 +1,5 @@
+**free
+dcl-pr StateVal ind;
+  p_code char(2);                    // State Code
+  p_name Char(30) options(*nopass) ; //Returned State Name
+end-pr;

Service_Pgms/README.md

@@ -66,3 +66,32 @@ Contains procedures to manipulate strings in an RPG program.
   JobLogMsg in SRV_MSG is more useful. Really should be part of SRV_MSG.
 
   * SHOW_T   RPG program to test & exercise SHOW.
+
+## STATEVAL
+
+  A service program to validate a 2-character USA state code.
+
+  This demonstrates several techniques:
+   
+  - Using a variable sized array.
+  
+  - Loading the array with SQL on the first call.
+  
+  - In the first and subsequent calls using the array for the lookup.
+
+  - Use of static variables
+
+  - Passing an optional parameter.
+
+### Couple or caveats:
+
+  - Any program that call this service *must not* be in the default activation group, otherwise the arrary will be loaded every call. So code `ctl-opt DftActGrp(*NO) ActGrp(...)`.
+
+  - %LOOKUP does a binary search, so the data loaded must be in sorted--note that I have an ORDER BY on the SQL select. In practical terms, a binary search of this size of table might be less efficent than just plain old LOOKUP. Theory says it is a tradeoff until you get to 100 or more items in the table.
+
+  - You can find SQL to create/load the STATES table in the *5250 Subfile* folder.
+
+#### STATEV_T
+A program to test STATEVAL. Note the 'ActGrp(*new)'.
+
+

Service_Pgms/StateV_T.rpgle

@@ -0,0 +1,62 @@
+**free
+
+ctl-opt DftActGrp(*NO) ActGrp(*new) // <--- Needed 
+      option(*nodebugio: *srcstmt)
+      BndDir('STATE_BND' : 'UTIL_BND');
+/COPY ../Copy_Mbrs/SRV_STE_P.RPGLE
+/COPY ../Copy_Mbrs/SRV_MSG_P.RPGLE
+dcl-s myCode char(2);
+dcl-s myName char(30);
+dcl-s msg varchar(50);
+dcl-s ind ind;
+
+// === Test at limits: first and last
+myCode = 'AA';
+ind = StateVal(myCode:myName);
+prt();
+myCode = 'WY';
+ind = StateVal(myCode:myName);
+prt();
+
+// === test awau from limits
+myCode = 'OK';
+ind = StateVal(myCode:myName);
+prt();
+myCode = 'OH';
+ind = StateVal(myCode:myName);
+prt();
+
+// === test lower case ===
+myCode = 'mp';
+ind = StateVal(myCode:myName);
+prt();
+myCode = 'Dc';
+ind = StateVal(myCode:myName);
+prt();
+
+// === test bad state code
+myCode = 'xx';
+myName = 'Should be cleared';
+ind = StateVal(myCode:myName);
+prt();
+
+// === test with 1 parameter ===
+myCode = 'fl';
+ind = StateVal(myCode:myName);
+prt();
+myCode = 'fl';
+myName = 'Should be unchanged';
+ind = StateVal(myCode);
+prt();
+myCode = '**';
+myName = 'code was ** ';
+ind = StateVal(myCode);
+prt();
+
+*inlr = *on;
+
+dcl-proc prt;
+  msg = 'RET: ' + %char(ind);
+  msg = msg + ' Code: ' + myCode + ' Name: ' + myName;
+  JobLogMsg(msg);
+end-proc;

Service_Pgms/StateVal.sqlrpgle

@@ -0,0 +1,81 @@
+**free 
+// StateVAL - Validates a 2-character USA State Code
+// Returns * ON if the passed code is valid, otherwise *OFF
+// Optionally returns the 30 character state name
+// Note: Modifies data in the caller:
+//    1) Ensures the state code is upper case.
+//    2) If optional state name parameter is passed it is modified.
+
+// CRTBNDDIR BNDDIR(LENNONS1/STATE_BND) TEXT('For STATEVAL')
+// ADDBNDDIRE BNDDIR(STATE_BND) OBJ((SRV_STE *SRVPGM *DEFER))
+// CRTSRVPGM SRVPGM(SRV_STE) MODULE(STATEVAL) EXPORT(*ALL)
+
+ctl-opt nomain option(*nodebugio:*srcstmt) 
+    bnddir('SQL_BND' : 'UTIL_BND');
+
+dcl-proc StateVal export;
+  dcl-pi StateVal ind;
+    p_code like(States_T.code); 
+    p_name like(States_T.name) options(*nopass); 
+  end-pi;
+
+  /include ../Copy_Mbrs/SRV_SQL_P.RPGLE
+  /include ../Copy_Mbrs/SRV_MSG_P.RPGLE
+  dcl-c SQLSUCCESS '00000';
+
+  dcl-ds States_T template qualified;
+    code char(2);
+    name char(30);
+  end-ds;
+  dcl-s ix int(10);
+  
+  // === Static variables ===
+  // Array of State info loaded once first time.
+  dcl-ds States_A likeds(States_T) dim(*auto :100) static;
+  dcl-s StatesLoaded ind static;
+
+  // === One time load of State info ===================================
+  if (StatesLoaded = *off);
+    // Job log message to confirm load occurs only once.
+    JobLogMsg('StateVal: Loading States');
+    EXEC SQL
+    DECLARE  states_cursor CURSOR FOR select state, name from states
+      order by state;
+    EXEC SQL
+    OPEN  states_cursor;
+    if sqlstate <>  SQLSUCCESS;
+      SQLProblem('Open of states_cursor failed');
+    endif;
+    // Loading all in one fetch since we know there are alway fewer
+    // than 100 USA states and territories.
+    EXEC SQL
+    FETCH from states_cursor for 100 rows into :States_A;
+    if sqlstate <>  SQLSUCCESS;
+      SQLProblem('Fetch from states_cursor failed');
+    endif;
+    EXEC SQL
+    CLOSE states_cursor ;
+    if sqlstate <>  SQLSUCCESS;
+      SQLProblem('Close of states_cursor failed');
+    endif;
+    StatesLoaded = *on;
+  endif;
+
+  // === Lookup the provided state code ================================
+  p_code = %upper(p_code); // Ensure it is upper case
+  ix=%lookup(p_code : States_A(*).code);
+  // === State code found ===
+  if ix <> 0;
+    if %passed(p_name);
+      p_name = States_A(ix).name;
+    endif;
+    return *on;
+  else;
+    // === State not found ===
+    if %passed(p_name);
+      p_name = *blanks;
+    endif;
+    return *off;
+  endif;
+
+end-proc;

Z_Exp1/.vscode/actionsx.json

@@ -0,0 +1,55 @@
+[
+  {
+    "name": "Create RPGLE Program",
+    "command": "CRTBNDRPG PGM(&CURLIB/&NAME) SRCSTMF('&RELATIVEPATH') OPTION(*EVENTF) DBGVIEW(*SOURCE) TGTCCSID(*JOB)",
+    "deployFirst": true,
+    "environment": "ile",
+    "extensions": [
+      "RPGLE"
+    ]
+  },
+  {
+    "name": "Create RPGLE Module",
+    "command": "CRTRPGMOD MODULE(&CURLIB/&NAME) SRCSTMF('&RELATIVEPATH') OPTION(*EVENTF) DBGVIEW(*SOURCE) TGTCCSID(*JOB)",
+    "deployFirst": true,
+    "environment": "ile",
+    "extensions": [
+      "RPGLE"
+    ]
+  },
+  {
+    "name": "Create SQLRPGLE Program",
+    "command": "CRTSQLRPGI OBJ(&CURLIB/&NAME) SRCSTMF('&RELATIVEPATH') OPTION(*EVENTF) DBGVIEW(*SOURCE) CLOSQLCSR(*ENDMOD) CVTCCSID(*JOB) COMPILEOPT('TGTCCSID(*JOB)') RPGPPOPT(*LVL2)",
+    "deployFirst": true,
+    "environment": "ile",
+    "extensions": [
+      "SQLRPGLE"
+    ]
+  },
+  {
+    "name": "Create SQLRPGLE Module",
+    "command": "CRTSQLRPGI OBJ(&CURLIB/&NAME) SRCSTMF('&RELATIVEPATH') OBJTYPE(*MODULE) OPTION(*EVENTF) DBGVIEW(*SOURCE) CLOSQLCSR(*ENDMOD) CVTCCSID(*JOB) COMPILEOPT('TGTCCSID(*JOB)') RPGPPOPT(*LVL2)",
+    "deployFirst": true,
+    "environment": "ile",
+    "extensions": [
+      "SQLRPGLE"
+    ]
+  },
+  {
+    "extensions": [
+      "SQL",
+      "TABLE",
+      "VIEW",
+      "SQLPRC",
+      "SQLUDF",
+      "SQLUDT",
+      "SQLTRG",
+      "SQLALIAS",
+      "SQLSEQ"
+    ],
+    "name": "Run SQL Statements (RUNSQLSTM)",
+    "command": "RUNSQLSTM SRCSTMF('&FULLPATH') COMMIT(*NONE) NAMING(*SQL)",
+    "deployFirst": true,
+    "environment": "ile"
+  }
+]