Retrieve Program Functions Services
This service program example was created to externalize program functions
Externalizing Keys
Since most interactive RPG (and CL, and SQL) programs functions revolve around function keys to react to user instructions I created a service to externalize a significant portion of those operations. Based on work published by Bob Cozzi, Jr. I moved program function key actions and options into database files. This isn't a new concept. I created the first version of the process in 1988 (six years before ILE was available for RPG developers) using subprograms instead of service programs. It signaled a major change in my approach to application design.
Get Function
WIth ILE, the subprograms became service program procedures. The SoftCode service program included the modules necessary to move function keys (and program options) into database tables. Since the functions are external to the program, they may be changed independently of the program code. This creates something similar to a plug-and-play environment for HLL programs. The code below represents the module (a part of the SoftCode System Services) which performs the task of looking up the function requested and returning the instruction to the calling program.
H DEBUG(*YES)
H nomain
****************************************************************
* PROGRAM NAME - SC0080RM *
* *
* FUNCTION - This is a module designed to support the *
* softcoded program functions. *
* *
* PROGRAMMER - STEVE CROY 04/11/06 *
****************************************************************
* Prototypes
*---
/copy qrpglesrc,SC0000_PR
*---
DExecCmd PR EXTPGM('QCMDEXC')
D Command 256
D Length 15 5
*---
* Global Variables
*---
D KEYMACRO E DS EXTNAME(SCFUNCPF)
D MACRO E DS EXTNAME(SCOPTNPF)
D sql s 32767a varying
D SQLSTTOK C '00000'
D SQLNOMOREROWS C '02000'
D True C '1'
D False C '0'
D CloseLbl C 'Close'
D FetchLbl C 'Fetch'
D OpenLbl C 'Open'
D MoreRows S 1A Inz('0')
D SourceOpen S 1A Inz('0')
D PgmError S 1A Inz('0')
D URLfound S N
D ProgramName S 10A
D PanelName S 10A
D SQLTable S 21A
D SQLStmnt S 10A
D TblName S 10A
D Sort2 S 10A
D Msg S 51A
D W$CMD S 256 INZ
D W$LEN S 15 5 INZ(256)
**********************************************************************
* Get function keys
**********************************************************************
P GetFunction B export
D GetFunction PI
D pgmnam 10
D pnlnam 10
D keyDS 1
D keyID 10
D function 45
D level 3
D FN S 10 DIM(31)
D K S 3 0
D I S 3 0
D thisPgm S 10
D thisPnl S 10
D CMDKEY E DS EXTNAME(SCKEYSPF) QUALIFIED
D KeyDefined 1 31 DIM(31)
/free
cmdkey = FunctionKeys();
programName = pgmnam;
panelName = pnlnam;
thisPgm = pgmnam;
thisPnl = pnlnam;
cmdkey = FunctionKeys();
FN(1) = 'ENTER';
FN(2) = 'ROLLUP';
FN(3) = 'ROLLDN';
FN(4) = 'HELP';
FN(5) = 'PRINT';
FN(6) = 'BSPACE';
FN(7) = 'CLEAR';
FN(8) = 'F1';
FN(9) = 'F2';
FN(10)= 'F3';
FN(11)= 'F4';
FN(12)= 'F5';
FN(13)= 'F6';
FN(14)= 'F7';
FN(15)= 'F8';
FN(16)= 'F9';
FN(17)= 'F10';
FN(18)= 'F11';
FN(19)= 'F12';
FN(20)= 'F13';
FN(21)= 'F14';
FN(22)= 'F15';
FN(23)= 'F16';
FN(24)= 'F17';
FN(25)= 'F18';
FN(26)= 'F19';
FN(27)= 'F20';
FN(28)= 'F21';
FN(29)= 'F22';
FN(30)= 'F23';
FN(31)= 'F24';
k = %lookup(KeyDS:CMDKEY.KeyDefined:1); // Lookup key passed
IF k > 0;
keyID = fn(k);
ELSE;
keyID = *blank;
ENDIF;
//*-------------------------------------------------------------
// Determine what macro is to be returned to the calling pgm
//*-------------------------------------------------------------
EXSR @find;
IF sqlstt <> sqlsttok;
thisPnl = *blank;
EXSR @find;
ENDIF;
IF sqlstt <> sqlsttok;
thisPgm = '*SYS';
thisPnl = *blank;
EXSR @find;
ENDIF;
IF sqlstt <> sqlsttok;
function = 'Undefined';
ELSE;
IF fkautl <= level;
IF %subst(fmacro:1:1) = '&';
w$cmd = %subst(fmacro:2);
w$len = %len(%trim(w$cmd));
function = '*NOOP';
Command( w$cmd : w$len);
ELSEIF %subst(fmacro:1:5) = '*HELP';
URLfound = ShowHelp( programName );
IF URLfound;
function = '*NOOP';
ELSE;
HelpText(programName:fpnlid);
function = '*NOOP';
ENDIF;
ELSE;
function = fmacro;
ENDIF;
ELSE;
function = 'Unauthorized';
ENDIF;
ENDIF;
RETURN;
/end-free
*=============================================================
* Subroutine to find function
*=============================================================
CSR @FIND BEGSR
c/Exec SQL
c+ Set Option Commit = *None
c/End-Exec
c/exec sql
c+ select *
c+ into :KEYMACRO
c+ from SCFUNCPF
c+ where fpgmid=:thisPgm and fpnlid=:thisPnl and fkeyid=:keyID
c/end-exec
CSR ENDSR
P GetFunction E
**********************************************************************
* Get function key text
**********************************************************************
P GetKeyText B export
D GetKeyText PI
D pgmnam 10
D pnlnam 10
D keytxt 720
D level 3
D KEYS S 10 DIM(80) KEY LIST
D TEXT DS 720
D INFO 1 720 DIM(36)
D SORT DS 720
D ARR 1 720 DIM(36) ASCEND
D F S 3 0
D I S 3 0
D K S 3 0
D X S 3 0
D R S 3 0
/free
EXSR SetCursor;
f = 0;
k = 0;
x = 0;
i = 1;
sort = *blanks;
text = *blanks;
EXSR OpnCursor;
IF SQLStt = SQLSttOK;
SourceOpen = True;
MoreRows = True;
ELSE;
SourceOpen = False;
MoreRows = False;
SQLStmnt = OpenLbl;
SQLTable = 'KeySource';
SQLError();
ENDIF;
DOU MoreRows = false;
EXSR FetchNext;
IF MoreRows = True;
IF (fpnlid = pnlnam or fpnlid = *blank)
AND fkautl <= level;
r = %lookup(fkeyid:keys:1);
IF r = 0;
F = F + 1;
keys(f) = fkeyid;
info(i) = %trim(fkeyid) + '=' + %trim(fktext);
i = i + 1;
ENDIF;
ENDIF;
ENDIF;
ENDDO;
sort = text;
FOR x = 1 to 36;
IF %subst(arr(x):3:1) = '=';
arr(x) = 'A' + %subst(arr(x):2);
ENDIF;
ENDFOR;
SORTA ARR;
CLEAR text;
i = 1;
FOR x = 1 to 36;
IF %subst(arr(x):1:1) = 'A';
arr(x) = 'F' + %subst(arr(x):2);
ENDIF;
IF arr(x)<> *blank;
info(i) = arr(x);
i = i+ 1;
ENDIF;
ENDFOR;
IF SourceOpen = True;
SourceOpen = False;
EXSR ClsCursor;
IF SQLStt <> SQLSttOK;
SQLStmnt = CloseLbl;
SQLTable = 'File' + ':Source';
SQLError();
ENDIF;
ENDIF;
keytxt = text;
RETURN;
//*=============================================================
//* Read the Cursor
//*=============================================================
BEGSR FetchNext;
EXSR GetNext;
SELECT;
WHEN SQLStt = SQLSttOK;
MoreRows = *ON;
WHEN SQLStt = SQLNoMoreRows;
MoreRows = *Off;
OTHER;
SQLStmnt = FetchLbl;
SQLTable = 'File' + ':KeySource';
SQLError();
ENDSL;
ENDSR;
/end-free
*---------------------------------------------------------------------
* Declare Cursor
*---------------------------------------------------------------------
CSR SetCursor BEGSR
C/Exec SQL
C+ Declare KeySource scroll Cursor For
C+ Select *
C+ From SCFUNCPF
C+ Where FPGMID=:PGMNAM
C+ Order By FPGMID, FPNLID
C+ For Read Only
C+ Optimize for 1 Rows
C/End-Exec
CSR ENDSR
CSR ClsCursor BEGSR
C/Exec SQL
C+ Close KeySource
C/End-Exec
CSR ENDSR
CSR OpnCursor BEGSR
C/Exec SQL
C+ Open KeySource
C/End-Exec
CSR ENDSR
CSR GetNext BEGSR
C/Exec SQL
C+ FETCH NEXT FROM KeySource INTO :KeyMacro
C/End-Exec
CSR ENDSR
P GetKeyText E
**********************************************************************
* Get program option
**********************************************************************
P GetOption B export
D GetOption PI
D pgmnam 10
D pnlnam 10
D optID 10
D option 45
D level 3
D thisPgm S 10
D thisPnl S 10
/free
thisPgm = pgmnam;
thisPnl = pnlnam;
EXSR @find;
IF sqlstt <> sqlsttok;
thisPnl = *blank;
EXSR @find;
ENDIF;
IF sqlstt <> sqlsttok;
thisPgm = '*SYS';
thisPnl = *blank;
EXSR @find;
ENDIF;
IF sqlstt <> sqlsttok;
option = 'Undefined';
ELSE;
IF OPautl <= level;
IF %subst(omacro:1:1) = '&';
w$cmd = %subst(omacro:2);
w$len = %len(%trim(w$cmd));
option = '*NOOP';
Command(w$cmd:w$len);
ELSEIF %subst(omacro:1:5) = '*HELP';
ShowHelp( pgmnam );
option = '*NOOP';
ELSE;
option = omacro;
ENDIF;
ELSE;
option = 'Unauthorized';
ENDIF;
ENDIF;
RETURN;
/end-free
*=============================================================
* Subroutine to find program option
*=============================================================
---> CSR @FIND BEGSR
C/exec sql
C+ select *
C+ into :macro
C+ from SCOPTNPF
C+ where opgmid=:thisPgm and opnlid=:thisPnl and optnid=:optID
C/end-exec
<--- CSR ENDSR
P GetOption E
**********************************************************************
* Get program option text
**********************************************************************
P GetOptText B export
D GetOptText PI
D pgmnam 10
D pnlnam 10
D Opttxt 720
D level 3
D FA S 01 DIM(80) ACTION
D OPTS S 10 DIM(80) OPTION LIST
D TEXT DS 720
D INFO 1 720 DIM(36)
D SORT DS 720
D ARR 1 720 DIM(36) ASCEND
D F S 3 0
D I S 3 0
D K S 3 0
D X S 3 0
D R S 3 0
/free
EXSR SetCursor;
f = 0;
k = 0;
x = 0;
i = 1;
sort = *blanks;
text = *blanks;
EXSR OpnCursor;
IF SQLStt = SQLSttOK;
SourceOpen = True;
MoreRows = True;
ELSE;
SourceOpen = False;
MoreRows = False;
SQLStmnt = OpenLbl;
SQLTable = 'File' + ':OptSource';
SQLError();
ENDIF;
DOU MoreRows = false;
EXSR FetchNext;
IF MoreRows = True;
IF (opnlid = pnlnam or opnlid = *blank)
AND opautl <= level;
r = %lookup(optnid:opts:1);
IF r = 0;
F = F + 1;
opts(f) = optnid;
info(i) = %trim(optnid) + '=' + %trim(OPtext);
i = i + 1 ;
ENDIF;
ENDIF;
ENDIF;
ENDDO;
sort = text;
SORTA ARR;
CLEAR text;
i = 1;
FOR x = 1 to 36;
IF arr(x)<> *blank;
info(i) = arr(x);
i = i+ 1;
ENDIF;
ENDFOR;
IF SourceOpen = True;
SourceOpen = False;
EXSR ClsCursor;
IF SQLStt <> SQLSttOK;
SQLStmnt = CloseLbl;
SQLTable = 'File' + ':OptSource';
SQLError();
ENDIF;
ENDIF;
OptTxt = text;
RETURN;
//*=============================================================
//* Read the Cursor
//*=============================================================
BEGSR FetchNext;
EXSR GetNext;
SELECT;
WHEN SQLStt = SQLSttOK;
MoreRows = *ON;
WHEN SQLStt = SQLNoMoreRows;
MoreRows = *Off;
OTHER;
SQLStmnt = FetchLbl;
SQLTable = 'File' + ':OptSource';
SQLError();
ENDSL;
ENDSR;
/end-free
*---------------------------------------------------------------------
* Declare Cursor
*---------------------------------------------------------------------
CSR SetCursor BEGSR
C/Exec SQL
C+ Declare OptSource Cursor For
C+ Select *
C+ From SCOPTNPF
C+ Where OPGMID=:PGMNAM
C+ Order By OPGMID, OPNLID
C+ For Read Only
C+ Optimize for 1 Rows
C/End-Exec
CSR ENDSR
CSR ClsCursor BEGSR
C/Exec SQL
C+ Close OptSource
C/End-Exec
CSR ENDSR
CSR OpnCursor BEGSR
C/Exec SQL
C+ Open OptSource
C/End-Exec
CSR ENDSR
CSR GetNext BEGSR
C/Exec SQL
C+ Fetch Next
C+ From OptSource
C+ Into :MACRO
C/End-Exec
CSR ENDSR
P GetOptText E
**********************************************************************
* SQL error
**********************************************************************
P SQLError B export
D SQLError PI
/free
Msg = 'SQL error ' + SQLStt + ' on '
+ %TrimR(SQLStmnt) + ' for '
+ %TrimR(SQLTable) + ' table.';
DSPLY(E) Msg;
PgmError = True;
RETURN ;
/end-free
P SQLError E
**********************************************************************
* Execute command
**********************************************************************
P Command B
D Command PI
D Cmd 256
D Len 15 5
/free
MONITOR;
CALLP ExecCmd( cmd: len );
ON-ERROR;
PgmError = True;
ENDMON;
RETURN;
/end-free
P Command E
**********************************************************************
* Display Function keys
**********************************************************************
P DisplayKeys B EXPORT
D DisplayKeys PI
D KeysIn 720
D LinOut1 60
D LinOut2 60
D KeyIdx 3S 0
D pos S 3S 0
D MoreKeys S 20a INZ('F24=More Keys ')
/free
IF KeyIdx > 601 ;
KeyIdx = 0 ;
ENDIF ;
LinOut1 = %subst(KeysIn:KeyIdx +1 :60) ;
LinOut2 = %subst(KeysIn:KeyIdx + 61:60) ;
KeyIdx = KeyIdx + 60 ;
IF LinOut1 = *blanks ;
LinOut1 = %subst(KeysIn:1:60) ;
LinOut2 = %subst(KeysIn:61:60) ;
KeyIdx = 60 ;
ENDIF ;
pos = %scan('=':KeysIn:120) ;
IF pos > 120 ;
%subst(LinOut2:41:20) = MoreKeys ;
ENDIF ;
RETURN;
/end-free
P DisplayKeys E
**********************************************************************
* Display Program Options
**********************************************************************
P DisplayOptions B EXPORT
D DisplayOptions PI
D OptionsIn 720
D LinOut1 60
D LinOut2 60
D OptIdx 3S 0
D pos S 3S 0
/free
IF OptIdx > 601 ;
OptIdx = 0 ;
ENDIF ;
LinOut1 = %subst(OptionsIn:OptIdx +1 :60) ;
LinOut2 = %subst(OptionsIn:OptIdx + 61:60) ;
OptIdx = OptIdx + 120 ;
IF LinOut1 = *blanks ;
LinOut1 = %subst(OptionsIn:1:60) ;
LinOut2 = %subst(OptionsIn:61:60) ;
OptIdx = 120 ;
ENDIF ;
pos = %scan('=':OptionsIn:120) ;
IF pos > 120 ;
%subst(LinOut2:57:3) = '...' ;
ENDIF ;
RETURN;
/end-free
P DisplayOptions E
Function Table
The program functions are contained in the table (SCFUNCPF) a keyed physical file. The keys to the table are the program name, record format name, and the function key ID. The field named FMACRO is a free-format text field that, optionally, may be subdivided into multiple fields. This allows a great degree of flexibility in coding HLL applications. The macro instruction can be used to identify different key lists to use, or whether the function action is related to an update, delete, insert, or simply view only.
A****************************************************************
A* PHYSICAL FILE- SCFUNCPF *
A* *
A* FUNCTION - This file provides a set command function *
A* macro instructions to be executed from a *
A* HLL, or the function editor program. *
A* *
A* PROGRAMMER - Steve Croy 04/11/06 *
A****************************************************************
A****************************************************************
A* FILE ATTRIBUTE SECTION *
A* *
A* KEY FIELDS: FPGMID, FPNLID, FKEYID *
A* MAXMBRS : 1 *
A* *
A****************************************************************
A R RSCFUNC TEXT('FUNCTION KEY ACTIONS')
*
A FPGMID 10 TEXT('PROGRAM ID')
A COLHDG('Program ID')
A FPNLID 10 TEXT('PANEL ID')
A COLHDG('Panel' 'ID')
A FKEYID 10 TEXT('FUNCTION KEY ID')
A COLHDG('Function' 'Key')
A FMACRO 45 TEXT('FN KEY ACTION')
A COLHDG('Macro' 'Action')
A FKTEXT 20 TEXT('TEXT DESCRIPTION')
A COLHDG('Description')
A FKAUTL 3 TEXT('AUTHORITY LEVEL')
A COLHDG('Authority' 'Level')
A K FPGMID
A K FPNLID
A K FKEYID
Macro Flexibility
Subdividing the macro text field introduces a greater range of flexibility into the HLL application. The macro can determine the name of the program to call, as well as the parameter list to use when invoking the subprogram. If a called program is updated to use a different argument, then the program using the macro may have to be changed. But by using the macro, new programs can be added if they use an existing parameter list. This allows a staged implementation in modular development. For example: The interactive session with list presentation may be placed into production without the suite of services being complete. Based on a pre-defined argument, print, update, insert, and delete functions can be added as development on those modules are complete.
