User Defined table Function

page d'accueil
Boite à outils

Cette page a été mise à jour le 13 septembre 2009
Contact

Welcome page
Tools box

Versionning 

See also

last version : How to upload to my 400



With this page I show how to code user defined resultset stored procedure and user defined table function. Two slightly different ways to provide a big quantity of data from a RPG program. For example, imagine you have a rpg program that actually shows some interesting data in a subfile and you want to have the same data in a web page. Instead of writting to the display file, you can add the record to the result set or table function.

loading a result set is as simple as loading a static subfile.

providing data for a table function is as simple as providing one line at a time for a dynamic subfile.

Before starting, some explainations.

What's a resultset procedure ? it's a procedure that returns one (or more) temporary table. These tables are dynamic. That means their structure are known at run time, not at compile time. By opposition, a classic procedure can updates all it's INOUT & OUT strongly typed parameters, no more

And what's a table function ? it's a function that returns one (and only one) temporary table. The structure of the temporary table is strongly typed at compile time. By opposition, a classic function returns one strongly typed value.

It's not exactly the same usage, experience will provide samples of good (or bad) use. Feed back your experiences, it's always interesting

Precaution : While improving these sample, you will fall in the main dirty error, IE when the rpg code end abnormaly. That's not something SQL tolerate. In this case, SQL will indefinitely wait for an answer that never occurs. If this comes, you just can ENDJOB *IMMED the job where your SQL is running + hardly close your emulator window.

It's not really pretty. What to do ? Before running a new code for procedure or function, prepare one session to run SQL, prepare an other session to STRSRVJOB the first, STRDBG your rpg pgm, have a break point on the first line of the pgm. it's a convenient way to understand what happens, when there is a SQL loop , ... Notice : the first session can be a QZDASOINIT job for a iSeries Sql script runner. To convince you it's the best way to control what happens, remember the first message you receive when starting iSeries sql script runner : you receive the server job name :

Connected to relational database M170pub1 on M170pub1.rzkh.de as Jpltools - 272654/Quser/Qzdasoinit

You are ready for

STRSRVJOB 272654/Quser/Qzdasoinit
STRDBG mynewcode UPDPROD(*YES)

updprod(*yes) is mandatory because SQL will open many own files that are not in your test library but in system prod library

To start, I now show a simplified sample, based on the well known file QIWS/QCUSTCDT : target is to define a result set with column names that match exactly an existing file. Sql interface is a stored procedure with one result set, sql don't know column names.

The interest of starting the demonstration with a procedure, is because the normal way to build a procedure is to reuse existing code with as little correction as necessary. And because there is no necessity to define output when compiling the sql procedure,  you can change the output structure without recompiling the sql, just the rpg.

the rpg code for UDTFR1 :

‚ * this sample shows how to code in RPG the inside-code of a
‚ * sql procedure that returns a result set.
‚ *
‚ * based on data from qiws/qcustcdt.
‚ * Take care of having QIWS in your library list
‚ *
‚ * Create Procedure udtfproc1 ()
‚ * Dynamic Result Sets 1
‚ * Language RPGLE
‚ * not deterministic
‚ * Reads SQL Data
‚ * external name udtfr1
‚ *
‚ * compilation :
‚ *
‚ * test : with iSeries Navigator, myserver/database/mylocalrdb/schemas, in low right corner
‚ * run sql script : call udtfproc1()
‚ *
h debug datedit(*ymd) datfmt(*iso-) decedit('0.')
‚ *================================================================
‚ * sample of program for sql procedure returns a resultset
‚ *================================================================
‚ * the file to read
fqcustcdt if e k disk infsr(*pssr)
f rename(cusrec :fload)
‚ * define the output recordset, occursing the external output record format
d recordset e ds extname(qcustcdt)
d occurs(32765) it's the max value
d count s 10u 0 inz(0)
c/EXEC SQL
C+ Set Option Commit = *NONE
C+ , CloSQLCsr = *ENDMOD
C+ , DatFmt = *ISO
C+ , TimFmt = *ISO
C+ , Naming = *SYS
C/End-Exec
/free
//‚* main program
B01 for count=1 to 32765;
%occur (recordset)=count;
read fload;
B02 if %eof();
count-=1;
leave;
E02 endif;
//‚out fields = in fields, move already done
E01 endfor;
/end-free
c/EXEC SQL
C+ Set result sets array : recordset for : count rows
C/End-Exec
/free
*inlr = *on ;
B01 begsr *pssr ;
dump ;
E01 endsr '*CANCL';
/end-free
Compilation :
CRTSQLRPGI OBJ(JPLTOOLS1/UDTFR1) SRCFILE(JPLTOOLS1/QPGMSRC) COMMIT(*NONE) OBJTYPE(*MODULE)
OUTPUT(*PRINT) OPTION(*NOSEQSRC *XREF *SECLVL) CLOSQLCSR(*ENDMOD) SQLPATH(*LIBL)
DBGVIEW(*SOURCE) DYNUSRPRF(*OWNER)

CRTPGM PGM(JPLTOOLS1/UDTFR1) ACTGRP(*caller ) bnddir(qc2le)

Create a procedure without parameter (not the target of this demonstration) but a resultset

Create Procedure jpltools1.udtfproc1 ()
Dynamic Result Sets 1
Language RPGLE
not deterministic
Reads SQL Data
external name jpltools1.udtfr1
Compilation :
RUNSQLSTM SRCFILE(JPLTOOLS1/QPGMSRC)SRCMBR(UDTFR1Q)

test it with iSeries navigator. Why navigator ? because it's able to receive, retrieve and show the returned result sets

result set :

iSeries navigator log :

> call jpltools1.udtfproc1()

Return Code = 0


SQL State: 0100C
Vendor Code: 466
Message: [SQL0466] 1 Ergebnisgruppen sind aus Prozedur UDTFPROC1 in JPLTOOLS1 verfügbar.
Ursache . . . . : Prozedur UDTFPROC1 in JPLTOOLS1 wurde aufgerufen und gab eine oder mehrere
Ergebnisgruppen zurück.Fehlerbeseitigung: Keine.

SQL State: 01S02
Vendor Code: -99999
Message: Option value changed.

Statement ran successfully, with warnings (591 ms)

Sorry for the message in german, I've not find where to change the SYSLIBL for the JDBC connexion of Navigator(need QSYS2924 before QSYS). I've tested my code at M170PUB1 iSeries free sharing (http://m170pub1.rzkh.de/forumeng.html ) Thanks to Holger Scherer for freely sharing an iSeries

in english :
Message ID . . . . . . . . . : SQL0466
Message file . . . . . . . . : QSQLMSG
Library . . . . . . . . . : QSYS2924

Message . . . . : &3 result sets are available from procedure &1 in &2.
Cause . . . . . : Procedure &1 in &2 was called and has returned one or more
result sets.
Recovery . . . : None.

Second step : i improve my sample to choose what field I post in the result set. Code for UDTFR2 :

‚ * this sample shows how to code in RPG the inside-code of a
‚ * sql procedure that returns a result set.
‚ *
‚ * based on data from qiws/qcustcdt.
‚ * Take care of having QIWS in your library list
‚ *
‚ * Create Procedure jpltools1/udtfproc2 ()
‚ * Dynamic Result Sets 1
‚ * Language RPGLE
‚ * Reads SQL Data
‚ * Not deterministic
‚ * external name jpltools1/udtfr2
‚ *
‚ * compilation :
‚ *
‚ *
‚ *
h debug datedit(*ymd) datfmt(*iso-) decedit('0.')
‚ *================================================================
‚ * sample of program for sql procedure returns a resultset
‚ *================================================================
‚ * the file to read
fqcustcdt if e k disk infsr(*pssr)
f prefix(load_ )
f rename(cusrec :fload)
‚ * define the output recordset, occursing the output record format
d recordset ds occurs(32765) it's the max value
d** qualified unsupported in V5R2
LOAD_d BALDUE 6p 2
LOAD_d CDTDUE 6p 2
LOAD_d CDTLMT 4p 0
LOAD_d CHGCOD 1p 0
LOAD_d CITY 6
LOAD_d CUSNUM 6p 0
LOAD_d INIT 3
LOAD_d LSTNAM 8
LOAD_d STATE 2
LOAD_d STREET 13
LOAD_d ZIPCOD 5p 0
d count s 10u 0 inz(0)
c/EXEC SQL
C+ Set Option Commit = *NONE
C+ , CloSQLCsr = *ENDMOD
C+ , DatFmt = *ISO
C+ , TimFmt = *ISO
C+ , Naming = *SYS
C/End-Exec
/free
//‚* main program
B01 for count=1 to 32765;
%occur (recordset)=count;
read fload;
B02 if %eof();
count-=1;
leave;
E02 endif;
//‚ in field names looks like load_cusnum
//‚out field names looks like cusnum
//‚move have to be done manually. Better control of what is sent.
BALDUE = load_BALDUE ;
CDTDUE = load_CDTDUE ;
CDTLMT = load_CDTLMT ;
CHGCOD = load_CHGCOD ;
CITY = load_CITY ;
CUSNUM = load_CUSNUM ;
INIT = load_INIT ;
LSTNAM = load_LSTNAM ;
STATE = load_STATE ;
STREET = load_STREET ;
ZIPCOD = load_ZIPCOD ;
E01 endfor;
/end-free
c/EXEC SQL
C+ Set result sets array : recordset for : count rows
C/End-Exec
c eval *inlr = *on
EPR /free
*inlr = *on ;
B00 begsr *pssr ;
dump ;
E00 endsr '*CANCL';
/end-free
Compilation :

CRTSQLRPGI OBJ(JPLTOOLS1/UDTFR2) SRCFILE(JPLTOOLS1/QPGMSRC) COMT(*NONE) OBJTYPE(*MODULE)
OUTPUT(*PRINT) OPTION(*NOSEQSRC *XREF *LVL)
CLOSQLCSR(*ENDMOD) SQLPATH(*LIBL) DBGVIEW(*SOURCE) DYNUSRPRF(*OWNER) 
CRTPGM PGM(JPLTOOLS1/UDTFR2) ACTGRP(*caller ) bnddir(qc2le) 
Create Procedure jpltools1.udtfproc2 ()
Dynamic Result Sets 1
Language RPGLE
not deterministic
Reads SQL Data
external name jpltools1.udtfr2

nota : the create procedure statement is exactly the same as previous but the names.

Run with Navigator :


> call jpltools1.udtfproc2()
Return Code = 0
SQL State: 0100C
Vendor Code: 466
Message: [SQL0466] 1 Ergebnisgruppen sind aus Prozedur UDTFPROC2 in JPLTOOLS1 verfügbar.
Ursache . . . . : Prozedur UDTFPROC2 in JPLTOOLS1 wurde aufgerufen und gab eine oder mehrere Ergebnisgruppen
zurück.Fehlerbeseitigung: Keine.
SQL State: 01S02
Vendor Code: -99999
Message: Option value changed.
Statement ran successfully, with warnings (812 ms)

The improvement is not terrific : I have changed the order of the columns. It's enough for the demonstration.

I have a variant that runs with V5R3 :

‚ * this sample shows how to code in RPG the inside-code of a
‚ * sql procedure that returns a result set.
‚ *
‚ * based on data from qiws/qcustcdt.
‚ * Take care of having QIWS in your library list
‚ *
‚ * Create Procedure udtfproc2 ()
‚ * Dynamic Result Sets 1
‚ * Language RPGLE
‚ * Reads SQL Data
‚ * Not deterministic
‚ * external name udtfr2
‚ *
‚ * compilation :
‚ *
‚ *
‚ *
h debug datedit(*ymd) datfmt(*iso-) decedit('0.')
‚ *================================================================
‚ * sample of program for sql procedure returns a resultset
‚ *================================================================
‚ * the file to read
fqcustcdt if e k disk infsr(*pssr)
f prefix(load_ )
f rename(cusrec :fload)
‚ * define the output record format
d record e ds extname(qcustcdt)
d prefix(load_)
‚ * define the output recordset, occursing the output record format
‚ * this construction with likeds makes the recorset fields to be qualified
d recordset ds occurs(32765) it's the max value
d likeds(record)

d count s 10u 0 inz(0)
c/EXEC SQL
C+ Set Option Commit = *NONE
C+ , CloSQLCsr = *ENDMOD
C+ , DatFmt = *ISO
C+ , TimFmt = *ISO
C+ , Naming = *SYS
C/End-Exec
/free
//‚* main program
B01 for count=1 to 32765;
%occur (recordset)=count;
read fload;
B02 if %eof();
count-=1;
leave;
E02 endif;
//‚ in field names looks like load_cusnum
//‚out field names looks like recordset.load_cusnum
//‚move have to be done manually. Better control of what is sent.
recordset = record;
E01 endfor;
/end-free
c/EXEC SQL
C+ Set result sets array : recordset for : count rows
C/End-Exec
c eval *inlr = *on
EPR /free
*inlr = *on ;
B00 begsr *pssr ;
dump ;
E00 endsr '*CANCL';
/end-free

The difference, that is not really visible is that the SQL preprocessor build the RECORDSET DS as a qualified DS, so the structure of the DS can be build with LIKEDS

Now, i've covered the result-set part of the demonstration. What's not covered : procedure can return many result sets, something like Set result sets array : recordset1 for : count1 rows, array : recordset2 for : count2 rows

Next sample shows a simplified table function. By opposition to a ResultSet procedure, a Table function is strongly typed at compile time : it's significant to first define the function interface, then build the underlying program interface before coding any more.

My first simple sample is a function that returns some attributes of the server job. The function :

CREATE FUNCTION JPLTOOLS1/UDTFFUNC4 ()
RETURNS TABLE (
JOB CHAR (10)
, USER CHAR (10)
, NBR CHAR (6)
, INQMSGRPY CHAR (10)
, USRLIBL CHAR (2750)
, CURLIB CHAR (10)
, SYSLIBL CHAR (165)
, CURUSER CHAR (10)
, LANGID CHAR (3)
, CNTRYID CHAR (2)
, CCSID DECIMAL (5, 0)
, DFTCCSID DECIMAL (5, 0)
, DECFMT CHAR (1)
)

For this function, i've choose to code in CL. List of CL parameters is

the list is varying depending on options of create function :

LANGUAGE CL
PARAMETER STYLE DB2SQL
NOT DETERMINISTIC
NO SQL
CALLED ON NULL INPUT
NO DBINFO
NO EXTERNAL ACTION
NOT FENCED
NO FINAL CALL
DISALLOW PARALLEL
SCRATCHPAD
EXTERNAL NAME JPLTOOLS1/UDTFC4
CARDINALITY 1
PARAMETER STYLE DB2SQL mandatory, no comment
NOT DETERMINISTIC  two successive calls don't always return the same values : SQL can not cache the returned values when optimizing
NO SQL there is not SQL package associated. save & restore operation on *PGM can not restore attached SQL function.
CALLED ON NULL INPUT  SQL is not allowed to returns directly NULL without calling underlying code
NO DBINFO the function does not require the database information to be passed. Details in  rbafzmst.pdf (DB2 Universal Database for iSeries SQL Reference)
NO EXTERNAL ACTION no call outside SQL scope, some optimizations are allowed
NOT FENCED don't need to run in a dedicated thread
NO FINAL CALL function don't need ressource reservation or ressource liberation steps, only open, fetch & close.
DISALLOW PARALLEL not thread safe
SCRATCHPAD need working variables attached to the thread, totaly under control of function code. It's a varying field. default length is 100, so underlying code receive a 102 bytes parameter
CARDINALITY 1 average number of rows the function returns

How it works ?

SQLSTATE other than '00000' and '02000' change these rules for handling abnormal situations

CLLE code UDTFC4 :

/* maxi 40 params, - 6 reserved for trailer */
/* each answer need 2 parameters : we can accept 17 values */
pgm parm(+
&JOB +
&USER +
&NBR +
&INQMSGRPY +
&USRLIBL +
&CURLIB +
&SYSLIBL +
the 13 columns variables
&CURUSER +
&LANGID +
&CNTRYID +
&CCSID +
&DFTCCSID +
&DECFMT +
&iJOB +
&iUSER +
&iNBR +
&iINQMSGRPY +
&iUSRLIBL +
&iCURLIB +
&iSYSLIBL +
&iCURUSER +
the 13 columns null indicators
&iLANGID +
&iCNTRYID +
&iCCSID +
&iDFTCCSID +
&iDECFMT +
&sqlstate +
the sql parameters
&function +
&specific +
&sqlmsg +
&scratchpad +
&calltype )
dcl &JOB *char (10)
dcl &USER *char (10)
dcl &NBR *char (6)
dcl &INQMSGRPY *char (10)
dcl &USRLIBL *char (2750)
dcl &CURLIB *char (10)
dcl &SYSLIBL *char (165)
dcl &CURUSER *char (10)
dcl &LANGID *char (3)
dcl &CNTRYID *char (2)
dcl &CCSID *dec (5 0)
dcl &DFTCCSID *dec (5 0)
dcl &DECFMT *char (1)
dcl &iJOB *char (2)
dcl &iUSER *char (2)
dcl &iNBR *char (2)
dcl &iINQMSGRPY *char (2)
dcl &iUSRLIBL *char (2)
dcl &iCURLIB *char (2)
dcl &iSYSLIBL *char (2)
dcl &iCURUSER *char (2)
dcl &iLANGID *char (2)
dcl &iCNTRYID *char (2)
dcl &iCCSID *char (2)
dcl &iDFTCCSID *char (2)
dcl &iDECFMT *char (2)
DCL VAR(&SQLSTATE) TYPE(*CHAR) LEN(5)
DCL VAR(&FUNCTION) TYPE(*CHAR) LEN(517)
DCL VAR(&SPECIFIC) TYPE(*CHAR) LEN(128)
DCL VAR(&SQLMSG) TYPE(*CHAR) LEN(70)
DCL VAR(&SCRATCHPAD) TYPE(*CHAR) LEN(104)
DCL VAR(&CALLTYPE) TYPE(*CHAR) LEN(4)
DCL VAR(&CALLTYPEB) TYPE(*DEC) LEN(5 0)
DCL VAR(&DECIN) TYPE(*DEC) LEN(1)
DCL VAR(&N2) TYPE(*DEC) LEN(2 0)
DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5 0) VALUE(70)
DCL VAR(&X70) TYPE(*CHAR) LEN(2) VALUE(X'0046')
DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(70)
/*===========GESTION-DES-MESSAGES-D'ERREUR--------------------------*/
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
/*-RENVOI-DES-MESSAGES-VERS-L'APPELANT------------------*/
COPYRIGHT TEXT('Author is Jean-Paul Lamontre')
MONMSG MSGID(CPF0000 QWM0000) EXEC(GOTO +
CMDLBL(STDMONMSG))
GOTO CMDLBL(DEBUTPGM)
STDMONMSG:
/*-----------CAPTURE-DU-MESSAGE----------------------*/
RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
/*-----------PROMOTION-DU-MESSAGE--------------------*/
escape message are converted to SQLSTATE
RTVMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSG(&MSGDTA) MSGLEN(&MSGLEN)
CHGVAR VAR(&SQLSTATE) VALUE('JP001')
CHGVAR VAR(&MSGTXT) VALUE(&X70 *CAT &MSGID *CAT +
&MSGDTA)
RETURN
DEBUTPGM:
/*===========CORPS-DU-PROGRAMME-------------------------------------*/
/* default values : sqlstate = ok, values = null */
CHGVAR VAR(&SQLSTATE) VALUE('00000')
CHGVAR VAR(&IJOB) VALUE(X'FFFF')
x'FFFF' = -1
CHGVAR VAR(&IUSER) VALUE(X'FFFF')
CHGVAR VAR(&INBR) VALUE(X'FFFF')
CHGVAR VAR(&IINQMSGRPY) VALUE(X'FFFF')
CHGVAR VAR(&IUSRLIBL) VALUE(X'FFFF')
CHGVAR VAR(&ICURLIB) VALUE(X'FFFF')
CHGVAR VAR(&ISYSLIBL) VALUE(X'FFFF')
CHGVAR VAR(&ICURUSER) VALUE(X'FFFF')
CHGVAR VAR(&ILANGID) VALUE(X'FFFF')
CHGVAR VAR(&ICNTRYID) VALUE(X'FFFF')
CHGVAR VAR(&ICCSID) VALUE(X'FFFF')
CHGVAR VAR(&IDFTCCSID) VALUE(X'FFFF')
CHGVAR VAR(&IDECFMT) VALUE(X'FFFF')
/*&decin : 0=not null ; -1=null */
/* CHGVAR VAR(&DECIN) VALUE(%BIN(&INP1 ) */
CHGVAR VAR(&CALLTYPEB) VALUE(%BIN(&CALLTYPE 1 4))
IF COND(&CALLTYPEB = -2) THEN(GOTO +
CMDLBL(FIRSTCALL))
IF COND(&CALLTYPEB = -1) THEN(GOTO +
CMDLBL(OPENCALL))
IF COND(&CALLTYPEB = 0) THEN(GOTO +
CMDLBL(FETCHCALL))
IF COND(&CALLTYPEB = 1) THEN(GOTO +
CMDLBL(CLOSECALL))
IF COND(&CALLTYPEB = 2) THEN(GOTO +
CMDLBL(FINALCALL))
CHGVAR VAR(&SQLSTATE) VALUE('JP021')
CHGVAR VAR(&MSGTXT) VALUE(&X70 *CAT 'JP021 +
unattended call type received')
RETURN
firstcall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('FIRST')
RETURN
opencall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('OPEN')
RETURN
fetchcall:
IF COND(%SST(&SCRATCHPAD 5 5) = 'OPEN') THEN(DO)
RTVJOBA JOB(&JOB) USER(&USER) NBR(&NBR) +
INQMSGRPY(&INQMSGRPY) USRLIBL(&USRLIBL) +
CURLIB(&CURLIB) SYSLIBL(&SYSLIBL) +
CURUSER(&CURUSER) LANGID(&LANGID) +
CNTRYID(&CNTRYID) CCSID(&CCSID) +
DFTCCSID(&DFTCCSID) DECFMT(&DECFMT)
CHGVAR VAR(&IJOB) VALUE(X'0000')
CHGVAR VAR(&IUSER) VALUE(X'0000')
CHGVAR VAR(&INBR) VALUE(X'0000')
CHGVAR VAR(&IINQMSGRPY) VALUE(X'0000')
CHGVAR VAR(&IUSRLIBL) VALUE(X'0000')
CHGVAR VAR(&ICURLIB) VALUE(X'0000')
CHGVAR VAR(&ISYSLIBL) VALUE(X'0000')
CHGVAR VAR(&ICURUSER) VALUE(X'0000')
CHGVAR VAR(&ILANGID) VALUE(X'0000')
CHGVAR VAR(&ICNTRYID) VALUE(X'0000')
CHGVAR VAR(&ICCSID) VALUE(X'0000')
CHGVAR VAR(&IDFTCCSID) VALUE(X'0000')
CHGVAR VAR(&IDECFMT) VALUE(X'0000')
ENDDO
ELSE CMD(DO)
CHGVAR VAR(&SQLSTATE) VALUE('02000')
ENDDO
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('FETCH')
RETURN
closecall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('CLOSE')
RETURN
finalcall:
CHGVAR VAR(%SST(&SCRATCHPAD 5 5)) VALUE('FINAL')
RETURN
FIN: ENDPGM

SELECT * FROM table(jpltools1.udtffunc4()) as t
Statement ran successfully (1251 ms)

Now a sample in RPGLE, without external action : UDTFR6. target is returning current time stamp

Create Function jpltools1/udtffunc6 ()
RETURNS TABLE (
DTS Char (26)
)
LANGUAGE RPGLE
PARAMETER STYLE DB2SQL
Not DETERMINISTIC
NO SQL
CALLED ON NULL INPUT
NO DBINFO
NO EXTERNAL ACTION
NOT FENCED
NO FINAL CALL
DISALLOW PARALLEL
SCRATCHPAD
EXTERNAL NAME jpltools1/udtfr6
CARDINALITY 1
‚ * this sample shows how to code in RPG the inside-code of a
‚ * sql function that returns a table.
‚ *
‚ *
‚ * compilation :
‚ *
‚ *
‚ *
h debug datedit(*ymd) datfmt(*iso-) decedit('0.')
‚ *================================================================
‚ * sample of program for sql function returns a table
‚ *================================================================
d udtfr6 pr
‚ * list of table columns
d p_dts 26
‚ * list of null indicators
d p_idts 5i 0
‚ * sql style parameters
d p_sqlstate 5
d p_function 517 varying
d p_specific 128 varying
d p_sqlmsg 70 varying
d p_scratchpad 100 varying
d p_calltype 10i 0
d udtfr6 pi
‚ * list of table columns
d p_dts 26
‚ * list of null indicators
d p_idts 5i 0
‚ * sql style parameters
d p_sqlstate 5
d p_function 517 varying
d p_specific 128 varying
d p_sqlmsg 70 varying
d p_scratchpad 100 varying
d p_calltype 10i 0

d scratchDS ds 100
d SPstatus 5
d

/free
//‚* main program
//‚initial state
//‚PscratchDS=%addr(p_ScratchPad);
scratchDS= p_ScratchPad ;
p_sqlstate = '00000';
p_sqlmsg='';
p_idts = -1;
B01 select;
X01 when p_calltype = -2;
exsr firstcall;
X01 when p_calltype = -1;
exsr opencall;
X01 when p_calltype = 0;
exsr fetchcall;
X01 when p_calltype = 1;
exsr closecall;
X01 when p_calltype = 2;
exsr finalcall;
X01 other;
p_sqlstate = 'JP001';
p_sqlmsg='unattended call type received';
E01 endsl;
p_scratchpad=ScratchDS ;
return;
*inrt = *on ;
B01 begsr *pssr ;
dump ;
E01 endsr '*CANCL';

B01 begsr firstcall;
SPstatus = 'FIRST';
E01 endsr;

B01 begsr opencall;
SPstatus = 'OPEN ';
E01 endsr;

B01 begsr fetchcall;
B02 if spstatus = 'OPEN' ;
p_dts = %char(%timestamp());
p_idts = 0;
X02 else;
p_sqlstate='02000';
E02 endif;

SPstatus = 'FETCH';
E01 endsr;

B01 begsr closecall;

SPstatus = 'CLOSE';
E01 endsr;

B01 begsr finalcall;
SPstatus = 'FINAL';
E01 endsr;

SELECT * FROM table(jpltools1.udtffunc6()) as texte

A sample with external action : rewritting UDTFC4 in RPGLE for the interface and CLLE for data

the DDL : (sql data description language)

Create Function jpltools1/udtffunc5 ()
RETURNS TABLE (
JOB char (10)
, USER char (10)
, NBR char (6)
, INQMSGRPY char (10)
, USRLIBL char (2750)
, CURLIB char (10)
, SYSLIBL char (165)
, CURUSER char (10)
, LANGID char (3)
, CNTRYID char (2)
, CCSID decimal (5, 0)
, DFTCCSID decimal (5, 0)
, DECFMT char (1)
)
LANGUAGE RPGLE
PARAMETER STYLE DB2SQL
Not DETERMINISTIC
NO SQL
CALLED ON NULL INPUT
NO DBINFO
EXTERNAL ACTION
FENCED
NO FINAL CALL
DISALLOW PARALLEL
SCRATCHPAD
EXTERNAL NAME jpltools1/udtfr5
CARDINALITY 1

the RPGLE for interface

‚ * this sample shows how to code in RPG the inside-code of a
‚ * sql function that returns a table.
‚ *
‚ * how to debug the rpg inside udtf ?
‚ * 1) open session A, note the job number
‚ * 2) open session B,
‚ * STRSRVJOB on session A
‚ * STRDBG therpgpgm
‚ * 3) on session A,
‚ * STRSQL
‚ * select * from table(udtffunc5()) as t
‚ * 4) debug the rpg code with session B
‚ *
‚ * RPG code and create function must be harmonized :
‚ * RPGLE -> NO SQL
‚ * SQLRPGLE -> CONTAINS SQL or more (READS, MODIFIES)
‚ *
‚ * Program must be compiled with actgrp(*caller)
‚ *
‚ *
‚ *
‚ *
‚ * Create Function jpltools1/udtffunc5 ()
‚ * RETURNS TABLE (
‚ * JOB char (10)
‚ * , USER char (10)
‚ * , NBR char (6)
‚ * , INQMSGRPY char (10)
‚ * , USRLIBL char (2750)
‚ * , CURLIB char (10)
‚ * , SYSLIBL char (165)
‚ * , CURUSER char (10)
‚ * , LANGID char (3)
‚ * , CNTRYID char (2)
‚ * , CCSID decimal (5, 0)
‚ * , DFTCCSID decimal (5, 0)
‚ * , DECFMT char (1)
‚ * )
‚ * LANGUAGE RPGLE
‚ * PARAMETER STYLE DB2SQL
‚ * Not DETERMINISTIC
‚ * NO SQL
‚ * CALLED ON NULL INPUT
‚ * NO DBINFO
‚ * EXTERNAL ACTION
‚ * FENCED
‚ * FINAL CALL
‚ * DISALLOW PARALLEL
‚ * SCRATCHPAD
‚ * EXTERNAL NAME jpltools1/udtfr5
‚ * CARDINALITY 1
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ * compilation :
‚ *
‚ *
‚ *
h debug datedit(*ymd) datfmt(*iso-) decedit('0.')
‚ *================================================================
‚ * sample of program for sql function returns a table
‚ *================================================================
d udtfr5 pr
‚ * list of table columns
d p_JOB 10
d p_USER 10
d p_NBR 6
d p_INQMSGRPY 10
d p_USRLIBL 2750
d p_CURLIB 10
d p_SYSLIBL 165
d p_CURUSER 10
d p_LANGID 3
d p_CNTRYID 2
d p_CCSID 5s 0
d p_DFTCCSID 5s 0
d p_DECFMT 1
‚ * list of null indicators
d p_iJOB 5i 0
d p_iUSER 5i 0
d p_iNBR 5i 0
d p_iINQMSGRPY 5i 0
d p_iUSRLIBL 5i 0
d p_iCURLIB 5i 0
d p_iSYSLIBL 5i 0
d p_iCURUSER 5i 0
d p_iLANGID 5i 0
d p_iCNTRYID 5i 0
d p_iCCSID 5i 0
d p_iDFTCCSID 5i 0
d p_iDECFMT 5i 0
‚ * sql style parameters
d p_sqlstate 5
d p_function 517 varying
d p_specific 128 varying
d p_sqlmsg 70 varying
d p_scratchpad 100 varying
d p_calltype 10i 0
d udtfr5 pi
‚ * list of table columns
d p_JOB 10
d p_USER 10
d p_NBR 6
d p_INQMSGRPY 10
d p_USRLIBL 2750
d p_CURLIB 10
d p_SYSLIBL 165
d p_CURUSER 10
d p_LANGID 3
d p_CNTRYID 2
d p_CCSID 5s 0
d p_DFTCCSID 5s 0
d p_DECFMT 1
‚ * list of null indicators
d p_iJOB 5i 0
d p_iUSER 5i 0
d p_iNBR 5i 0
d p_iINQMSGRPY 5i 0
d p_iUSRLIBL 5i 0
d p_iCURLIB 5i 0
d p_iSYSLIBL 5i 0
d p_iCURUSER 5i 0
d p_iLANGID 5i 0
d p_iCNTRYID 5i 0
d p_iCCSID 5i 0
d p_iDFTCCSID 5i 0
d p_iDECFMT 5i 0
‚ * sql style parameters
d p_sqlstate 5
d p_function 517 varying
d p_specific 128 varying
d p_sqlmsg 70 varying
d p_scratchpad 100 varying
d p_calltype 10i 0

d scratchDS ds 100
d SPstatus 5
d

d udtfr51 pr extpgm('UDTFR51')
‚ * list of table columns
d p_JOB 10
d p_USER 10
d p_NBR 6
d p_INQMSGRPY 10
d p_USRLIBL 2750
d p_CURLIB 10
d p_SYSLIBL 165
d p_CURUSER 10
d p_LANGID 3
d p_CNTRYID 2
d p_CCSID 5s 0
d p_DFTCCSID 5s 0
d p_DECFMT 1

‚ *c/EXEC SQL
‚ *C+ Set Option Commit = *NONE
‚ *C+ , CloSQLCsr = *ENDMOD
‚ *C+ , DatFmt = *ISO
‚ *C+ , TimFmt = *ISO
‚ *C+ , Naming = *SYS
‚ *C/End-Exec
/free
//‚* main program
//‚initial state
//‚PscratchDS=%addr(p_ScratchPad);
scratchDS= p_ScratchPad ;
p_sqlstate = '00000';
p_sqlmsg='';
p_iJOB = -1;
p_iUSER = -1;
p_iNBR = -1;
p_iINQMSGRPY = -1;
p_iUSRLIBL = -1;
p_iCURLIB = -1;
p_iSYSLIBL = -1;
p_iCURUSER = -1;
p_iLANGID = -1;
p_iCNTRYID = -1;
p_iCCSID = -1;
p_iDFTCCSID = -1;
B01 p_iDECFMT = -1;
B01 select;
X01 when p_calltype = -2;
exsr firstcall;
X01 when p_calltype = -1;
exsr opencall;
X01 when p_calltype = 0;
exsr fetchcall;
X01 when p_calltype = 1;
exsr closecall;
X01 when p_calltype = 2;
exsr finalcall;
X01 other;
p_sqlstate = 'JP001';
p_sqlmsg='unattended call type received';
E01 endsl;
p_scratchpad=ScratchDS ;
return;
*inrt = *on ;
B01 begsr *pssr ;
dump ;
E01 endsr '*CANCL';

B01 begsr firstcall;
SPstatus = 'FIRST';
E01 endsr;

B01 begsr opencall;
SPstatus = 'OPEN ';
E01 endsr;

B01 begsr fetchcall;
B02 if spstatus = 'OPEN' ;
B01 udtfr51(
p_JOB
: p_USER
: p_NBR
: p_INQMSGRPY
: p_USRLIBL
: p_CURLIB
: p_SYSLIBL
: p_CURUSER
: p_LANGID
: p_CNTRYID
: p_CCSID
: p_DFTCCSID
: p_DECFMT ) ;
p_iJOB = 0;
p_iUSER = 0;
p_iNBR = 0;
p_iINQMSGRPY = 0;
p_iUSRLIBL = 0;
p_iCURLIB = 0;
p_iSYSLIBL = 0;
p_iCURUSER = 0;
p_iLANGID = 0;
p_iCNTRYID = 0;
p_iCCSID = 0;
p_iDFTCCSID = 0;
B01 p_iDECFMT = 0;
X02 else;

p_sqlstate='02000';
//‚ p_calltype=1;
E02 endif;

SPstatus = 'FETCH';
E01 endsr;

B01 begsr closecall;

SPstatus = 'CLOSE';
E01 endsr;

B01 begsr finalcall;
SPstatus = 'FINAL';
E01 endsr;

the CLLE for data


pgm parm(+
&JOB +
&USER +
&NBR +
&INQMSGRPY +
&USRLIBL +
&CURLIB +
&SYSLIBL +
&CURUSER +
&LANGID +
&CNTRYID +
&CCSID +
&DFTCCSID +
&DECFMT )
dcl &JOB *char (10)
dcl &USER *char (10)
dcl &NBR *char (6)
dcl &INQMSGRPY *char (10)
dcl &USRLIBL *char (2750)
dcl &CURLIB *char (10)
dcl &SYSLIBL *char (165)
dcl &CURUSER *char (10)
dcl &LANGID *char (3)
dcl &CNTRYID *char (2)
dcl &CCSID *dec (5 0)
dcl &DFTCCSID *dec (5 0)
dcl &DECFMT *char (1)
/*===========GESTION-DES-MESSAGES-D'ERREUR--------------------------*/
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
/*-RENVOI-DES-MESSAGES-VERS-L'APPELANT------------------*/
COPYRIGHT TEXT('Author is Jean-Paul Lamontre')
MONMSG MSGID(CPF0000 QWM0000) EXEC(GOTO +
CMDLBL(STDMONMSG))
GOTO CMDLBL(DEBUTPGM)
STDMONMSG:
/*-----------CAPTURE-DU-MESSAGE----------------------*/
RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
/*-----------PROMOTION-DU-MESSAGE--------------------*/
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
RETURN
DEBUTPGM:
/*===========CORPS-DU-PROGRAMME-------------------------------------*/
RTVJOBA JOB(&JOB) USER(&USER) NBR(&NBR) +
INQMSGRPY(&INQMSGRPY) USRLIBL(&USRLIBL) +
CURLIB(&CURLIB) SYSLIBL(&SYSLIBL) +
CURUSER(&CURUSER) LANGID(&LANGID) +
CNTRYID(&CNTRYID) CCSID(&CCSID) +
DFTCCSID(&DFTCCSID) DECFMT(&DECFMT)
FIN: ENDPGM

SELECT * FROM table(jpltools1.udtffunc5()) as t

And now, after these aperitive games,  a function that returns data from QCUSTCDT. The function :

Create Function jpltools1/udtffunc3 ()
RETURNS TABLE (
CUSNUM decimal(6, 0)
, LSTNAM CHAR(8)
, INIT CHAR(3)
, STREET CHAR(13)
, CITY CHAR(6)
, STATE CHAR(2)
, ZIPCOD decimal(5, 0)
, CDTLMT decimal(4, 0)
, CHGCOD decimal(1, 0)
, BALDUE decimal(6, 2)
, CDTDUE decimal(6, 2)
)
LANGUAGE RPGLE
PARAMETER STYLE DB2SQL
Not DETERMINISTIC
NO SQL
CALLED ON NULL INPUT
NO DBINFO
NO EXTERNAL ACTION
FENCED
NO FINAL CALL
DISALLOW PARALLEL
SCRATCHPAD
EXTERNAL NAME jpltools1/udtfr3
CARDINALITY 10

Notice : code is strongly protected against abnormal end with many MONITOR or (E) extenders

the RPGLE code :

‚ * this sample shows how to code in RPG the inside-code of a
‚ * sql function that returns a table.
‚ *
‚ * based on data from qiws/qcustcdt.
‚ * Take care of having QIWS in your sql path
‚ *
‚ * an inside-function code must NEVER end abnormaly (sample : endsr '*CANCL' in *PSSR)
‚ * because this puts SQL in situation to wait a answer that never occurs.
‚ * An unattended error must be converted in SQLSTATE <> '00000'
‚ * have a look at sqlstate documentation to choose your own place
‚ *
‚ * how to do ?
‚ * main code : controled by a main MONITOR block
‚ * I/O code : use the extendee (E) to capture the errors
‚ *
‚ *
‚ * Create Function jpltools1/udtffunc3 ()
‚ * RETURNS TABLE (
‚ * CUSNUM NUMERIC(6, 0)
‚ * , LSTNAM CHAR(8)
‚ * , INIT CHAR(3)
‚ * , STREET CHAR(13)
‚ * , CITY CHAR(6)
‚ * , STATE CHAR(2)
‚ * , ZIPCOD NUMERIC(5, 0)
‚ * , CDTLMT NUMERIC(4, 0)
‚ * , CHGCOD NUMERIC(1, 0)
‚ * , BALDUE NUMERIC(6, 2)
‚ * , CDTDUE NUMERIC(6, 2)
‚ * )
‚ * LANGUAGE RPGLE
‚ * PARAMETER STYLE DB2SQL
‚ * Not DETERMINISTIC
‚ * NO SQL
‚ * CALLED ON NULL INPUT
‚ * NO DBINFO
‚ * NO EXTERNAL ACTION
‚ * NOT FENCED
‚ * NO FINAL CALL
‚ * DISALLOW PARALLEL
‚ * SCRATCHPAD
‚ * EXTERNAL NAME jpltools1/udtfr3
‚ * CARDINALITY 10
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ *
‚ * compilation :
‚ *
‚ *
‚ *
h debug datedit(*ymd) datfmt(*iso-) decedit('0.')
‚ *================================================================
‚ * sample of program for sql procedure returns a resultset
‚ *================================================================
‚ * the file to read
fqcustcdt if e k disk
infsr(*pssr)
f prefix(load_ )
f rename(cusrec :fload)
f usropn
f
infds(fids)
D FIDS DS 528
‚ *
‚ * common data structure
‚ *
‚ * Descriptif du format . . . : the File Information Data Structure
‚d* File name (same as subfield location *FILE).
d SFFILE 8A
‚d* Open indication (1 = open).
d SFOPEN 1A
‚d* End of file (1 = end of file)
d SFEOF 1A
‚d* Status code (same as subfield location *STATUS).
d SFSTAT 9P 0
‚d* Operation code (same as subfield location *OPCODE)
d SFOPCO 6A
‚d* Name of the RPG/400 routine in which the exception
d SFRTN 8A
‚d* RPG/400 source statement sequence number.
d SFLINB 8A
‚d* For a program described file the record identifyin
d SFRCRD 8A
‚d* Machine or system message number.
d SFMSID 7A
‚d* MI/ODT (machine instruction/object definition temp
d SFMINB 4A
‚d* Unused.me (same as subfield location *FILE).
d SFFIL1 10A
‚d* Screen size (same as subfield location *SIZE).
d SFSIZE 7P 0
‚d* The national language input capability of the devi
d SFINP 3P 0
‚d* The national language output capability of the dev
d SFOUTT 3P 0
‚d* The preferred national language mode of the device
d SFMODE 3P 0
‚d* Name of the RPG/400 routine in which the exception
d SFFIL9 4A
‚d* Open data path (ODP) type: DS Device file DB D
d SFODPB 2A
‚d* Name of the file. For a nonspooled file, this is t
d SFFLNM 10A
‚d* Name of the library containing the file. For a sp
d SFFLLB 10A
‚d* Name of the spooled file. This entry is set onlyp
d SFSPLF 10A
‚d* Name of the library where the spooled file is loca
d SFSPLL 10A
‚d* Spooled file number (supplied only for spooled out
d SFSPLN 4B 0
‚d* Record length (number of bytes transferred at a ti
d SFRCDL 4B 0
‚d* Reserved.
d SFFIL2 2A
‚d* Member name: - If ODP type is DB, this entry is
d SFFLMB 10A
‚d* Not used.
d SFFIL3 4A
‚d* Not used.
d SFFIL4 4A
‚d* File type (supplied only if the ODP type is DS or
d SFFLTP 4B 0
‚d* Reserved.
d SFFIL5 3A
‚d* Number of rows on a display screen or number of li
d SFROWS 4B 0
‚d* Number of columns on a display screen ornumber of
d SFCOLS 4B 0
‚d* Number of records in the member at open time. Thi
d SFRCNB 9B 0
‚d* Access type (supplied only if ODP type is DB): KU
d SFACTP 2A
‚d* Duplicate key indication. This entry is set only
d SFDUPK 1A
‚d* Source file indication. This entry contains Y if t
d SFSRCF 1A
‚d* User file control block (UFCB) parameters. This e
d SFFCBP 10A
‚d* User file control block (UFCB) overrides. This en
d SFFCBO 10A
‚d* Offset to volume label fields of open feedback are
d SFOFST 4B 0
‚d* Maximum number of records that can be sent or rece
d SFBLCK 4B 0
‚d* Overflow line number(supplied only for a printer f
d SFSPLO 4B 0
‚d* Blocked record I/O record increment.This is the nu
d SFBLRC 4B 0
‚d* Unused.
d SFFIL6 5A
‚d* Name of the requester program device.
d SFRQPD 10A
‚d* File open count. If the file is opened nonshareab
d SFFCBC 2B 0
‚d* Reserved.
d SFFIL7 2A
‚d* Number of based-on physical members opened. For l
d SFOPPF 4B 0
‚d* Miscellaneous flags. See the Data Management Guid
d SFMIS1 1A
‚d* Open Identifier. Value is unique for a full open
d SFOPID 2A
‚d* Maximum Record Length. This value includes the da
d SFMXRL 4B 0
‚d* the Input/Output Feedback Information
d SFFILA 23A
‚d* Offset to file-dependent feedback information. Se
d SFIOFI 4B 0
‚d* Write operation count. This entry is updated only
d SFWRIC 9B 0
‚d* Read operation count. This entry is updated only
d SFREAC 9B 0
‚d* Write/Read operation count. This entry is updated
d SFWRRC 9B 0
‚d* Other I/O operation count. Number of successful o
d SFOIOC 9B 0
‚d* Unused.
d SFFIL8 1A
‚d* Current operation. This entry represents the last
d SFCUOP 1A
‚d* Name of the record format just processed, which is
d SFRFMT 10A
‚d* Device class. In the Data Management Guide, see th
d SFDVCL 2A
‚d* Program device name. This entry is the name of th
d SFPDNM 10A
‚d* Length of the record processed by the last I/O ope
d SFLNRC 9B 0
‚ *
‚ * device-specific data
‚ *
‚ *ilename++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚ * PRINTER
‚D*ame+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚D*PRTFBK DS
D CUR_LINE 367 368I 0 * Current line num
D CUR_PAGE 369 372I 0 * Current page cnt
‚ * If the first bit of PRT_FLAGS is on, the spooled file has been
‚ * deleted. Use TESTB X'80' or TESTB '0' to test this bit.
D PRT_FLAGS 373 373
D PRT_MAJOR 401 402 * Major ret code
D PRT_MINOR 403 404 * Minor ret code
‚ *ilename++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚ * DISK
‚ *ame+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚ *DBFBK DS
D FDBK_SIZE 367 370I 0 * Size of DB fdbk
D JOIN_BITS 371 374I 0 * JFILE bits
D LOCK_RCDS 377 378I 0 * Nbr locked rcds
D POS_BITS 385 385 * File pos bits
D DLT_BITS 384 384 * Rcd deleted bits
D NUM_KEYS 387 388I 0 * Num keys (bin)
D KEY_LEN 393 394I 0 * Key length
D MBR_NUM 395 396I 0 * Member number
D DB_RRN 397 400I 0 * Relative-rcd-num
D KEY 401 528 * Key value (max
D * size 2000)
‚d* relative rank number (FILE)
d sfrrn 397 400b 0
‚ *ilename++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚ * WORKSTN INFDS(ICFFBK)
‚ *ame+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚D*ICFFBK DS
D ICF_AID 369 369 * AID byte
D ICF_LEN 372 375I 0 * Actual data len
D ICF_MAJOR 401 402 * Major ret code
D ICF_MINOR 403 404 * Minor ret code
D SNA_SENSE 405 412 * SNA sense rc
D SAFE_IND 413 413 * Safe indicator
D RQSWRT 415 415 * Request write
D RMT_FMT 416 425 * Remote rcd fmt
D ICF_MODE 430 437 * Mode name
‚ *ilename++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚ * WORKSTN INFDS(DSPFBK)
‚ *ame+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++Comments++++++++++
‚ *DSPFBK DS
D DSP_FLAG1 367 368 * Display flags
D DSP_AID 369 369 * AID byte
D CURSOR 370 371 * Cursor location
D DATA_LEN 372 375I 0 * Actual data len
D SF_RRN 376 377I 0 * Subfile rrn
D MIN_RRN 378 379I 0 * Subfile min rrn
D NUM_RCDS 380 381I 0 * Subfile num rcds
D ACT_CURS 382 383 * Active window
‚D* cursor location
D DSP_MAJOR 401 402 * Major ret code
D DSP_MINOR 403 404 * Minor ret code








D PSDS SDS
‚d* Program name (same as subfield location *PROGRAM)
d SPNAME 10A Program name (sam
‚d* Status code (same as subfield location *STATUS).
d SPSTAT 5A Status code (same
‚d* Previous status code.
d SPPSTA 5A Previous status c
‚d* RPG/400 source statement sequence number.
d SPLINB 8A RPG/400 source st
‚d* Name of the RPG/400 routine in which the exceptio
d SPRTN 8A Name of the RPG/4
‚d* Number of parameters passed to this program (same
d SPPARM 5P 0 Number of paramet
‚d* Exception type (CPF for a OS/400 system exception
d SPMSID 7A Exception type (C
‚d* MI/ODT (machine instruction / object definition t
d SPMINB 4A MI/ODT (machine i
‚d* Work area for messages. This area is only meant
d SPFIL1 30A Work area for mes
‚d* Name of library in which the program is located.
d SPPGLB 10A Name of library i
‚d* Retrieved exception data. CPF messages are placed
d SPMSDA 80A Retrieved excepti
‚d* Identification of the exception that caused RPG90
d SPMSIP 4A Identification of
‚d* Unused.
d SPFIL2 24A Unused.
‚d* First 2 digits of a 4-digit year. The same as the
d SPSIEC 2A First 2 digits of
‚d* Name of file on which the last file operation occ
d SPFILE 8A Name of file on w
‚d* Status information on the last file used. This i
d SPFSTA 35A Status informatio
‚d* Job name.
d SPJBNM 10A Job name.
‚d* User name from the user profile.
d SPJBUS 10A User name from th
‚d* Job number.
d SPJBNB 6S 0 Job number.
‚d* Date (in UDATE format) the program started runnin
d SPUDAT 6S 0 Date (in UDATE fo
‚d* Date of program running (the system date in UDATE
d SPSYDT 6S 0 Date of program r
‚d* Time of program running in the format hhmmss.
d SPSYTM 6S 0 Time of program r
‚d* Date (in UDATE format) the program was compiled.
d SPCPLD 6A Date (in UDATE fo
‚d* Time (in the format hhmmss) the program was compi
d SPCPLT 6A Time (in the form
‚d* Level of the compiler.
d SPCPLL 4A Level of the comp
‚d* Source file name.
d SPSRCF 10A Source file name.
‚d* Source library name.
d SPSRCL 10A Source library na
‚d* Source file member name.
d SPSRCM 10A Source file membe
‚d* Unused.
d SPFIL3 96A Unused.
d udtfr3 pr
‚ * list of table columns
d p_CUSNUM like(load_CUSNUM)
d p_LSTNAM like(load_LSTNAM)
d p_INIT like(load_INIT )
d p_STREET like(load_STREET)
d p_CITY like(load_CITY )
d p_STATE like(load_STATE )
d p_ZIPCOD like(load_ZIPCOD)
d p_CDTLMT like(load_CDTLMT)
d p_CHGCOD like(load_CHGCOD)
d p_BALDUE like(load_BALDUE)
d p_CDTDUE like(load_CDTDUE)
‚ * list of null indicators
d p_iCUSNUM 5i 0
d p_iLSTNAM 5i 0
d p_iINIT 5i 0
d p_iSTREET 5i 0
d p_iCITY 5i 0
d p_iSTATE 5i 0
d p_iZIPCOD 5i 0
d p_iCDTLMT 5i 0
d p_iCHGCOD 5i 0
d p_iBALDUE 5i 0
d p_iCDTDUE 5i 0
‚ * sql style parameters
d p_sqlstate 5
d p_function 517 varying
d p_specific 128 varying
d p_sqlmsg 70 varying
d p_scratchpad 100 varying
d p_calltype 10i 0
d udtfr3 pi
‚ * list of table columns
d p_CUSNUM like(load_CUSNUM)
d p_LSTNAM like(load_LSTNAM)
d p_INIT like(load_INIT )
d p_STREET like(load_STREET)
d p_CITY like(load_CITY )
d p_STATE like(load_STATE )
d p_ZIPCOD like(load_ZIPCOD)
d p_CDTLMT like(load_CDTLMT)
d p_CHGCOD like(load_CHGCOD)
d p_BALDUE like(load_BALDUE)
d p_CDTDUE like(load_CDTDUE)
‚ * list of null indicators
d p_iCUSNUM 5i 0
d p_iLSTNAM 5i 0
d p_iINIT 5i 0
d p_iSTREET 5i 0
d p_iCITY 5i 0
d p_iSTATE 5i 0
d p_iZIPCOD 5i 0
d p_iCDTLMT 5i 0
d p_iCHGCOD 5i 0
d p_iBALDUE 5i 0
d p_iCDTDUE 5i 0
‚ * sql style parameters
d p_sqlstate 5
d p_function 517 varying
d p_specific 128 varying
d p_sqlmsg 70 varying
d p_scratchpad 100 varying
d p_calltype 10i 0

d scratchDS ds 100 based(PscratchDS)
d SPlen 5u 0
d SPstatus 5
d

d count s 10u 0 inz(0)
/free
//‚* main program
B01
monitor;
//‚initial state
PscratchDS=%addr(p_ScratchPad);
p_sqlstate = '00000';
p_sqlmsg='';
p_iCUSNUM = -1;
p_iLSTNAM = -1;
p_iINIT = -1;
p_iSTREET = -1;
p_iCITY = -1;
p_iSTATE = -1;
p_iZIPCOD = -1;
p_iCDTLMT = -1;
p_iCHGCOD = -1;
p_iBALDUE = -1;
p_iCDTDUE = -1;
B02 select;
X02 when p_calltype = -2;
exsr firstcall;
X02 when p_calltype = -1;
exsr opencall;
X02 when p_calltype = 0;
exsr fetchcall;
X02 when p_calltype = 1;
exsr closecall;
X02 when p_calltype = 2;
exsr finalcall;
X02 other;
p_sqlstate = 'JP001';
p_sqlmsg='unattended call type received';
E02 endsl;
on-error;
p_sqlstate = 'JP002';
p_sqlmsg = spmsid + spmsda ;
dump ;
E01
endmon;
return;
*inrt = *on ;
B01 begsr *pssr ;
//‚
avoid going to *pssr, it's an infinite loop.
dump ;
p_sqlstate = 'JP003';
p_sqlmsg = spmsid + spmsda ;
E01 endsr ;
B01 begsr firstcall;
SPstatus = 'FIRST';
E01 endsr;
B01 begsr opencall;
SPstatus = 'OPEN ';
open
(e) qcustcdt ;
B02
if %error;
p_sqlstate = 'JP004';
p_sqlmsg = spmsid + spmsda ;
SPstatus = p_sqlstate;
E02 endif;
E01 endsr;
B01 begsr fetchcall;
SPstatus = 'FETCH';
read
(e) fload;
B02 if %eof();
p_sqlstate='02000';
leavesr;
E02 endif;
B02
if %error;
p_sqlstate = 'JP005';
p_sqlmsg = spmsid + spmsda ;
SPstatus = p_sqlstate;
leavesr;
E02 endif;
p_CUSNUM = load_CUSNUM ;
p_LSTNAM = load_LSTNAM ;
p_INIT = load_INIT ;
p_STREET = load_STREET ;
p_CITY = load_CITY ;
p_STATE = load_STATE ;
p_ZIPCOD = load_ZIPCOD ;
p_CDTLMT = load_CDTLMT ;
p_CHGCOD = load_CHGCOD ;
p_BALDUE = load_BALDUE ;
p_CDTDUE = load_CDTDUE ;
p_iCUSNUM = -0;
p_iLSTNAM = -0;
p_iINIT = -0;
p_iSTREET = -0;
p_iCITY = -0;
p_iSTATE = -0;
p_iZIPCOD = -0;
p_iCDTLMT = -0;
p_iCHGCOD = -0;
p_iBALDUE = -0;
p_iCDTDUE = -0;
E01 endsr;
B01 begsr closecall;
SPstatus = 'CLOSE';
close
(e) qcustcdt;
B02
if %error;
p_sqlstate = 'JP006';
p_sqlmsg = spmsid + spmsda ;
SPstatus = p_sqlstate;
leavesr;
E02 endif;
E01 endsr;
B01 begsr finalcall;
SPstatus = 'FINAL';
E01 endsr;

To make a correct case, have QCUSTCDT on line (QIWS in LIBL or duplicate file in your test lib)

To make an error case, remove the file from the libl scope

SELECT * FROM table(jpltools1.udtffunc3()) as t

I have indented my /free rpg code with Indent Free-RPG program

Conclusion

You have see that building an user defined table function is a little more complex than an user defined resultset procedure. 

it's the price to pay for security of data. It's the same idea as the format level identifier of a file. With a strongly typed sql statement (a table function), the client, that may be developped by an other team (the web team for example), can only receive defined data ; same as a program can not run with a file that format level identifier has changed. A smart development tool can see a change in the function definition. This is not possible with a resultset procedure because resultset structure is known by SQL only after execution of procedure.
A table function is a protection, but not so strong as a format level identifier. With a changed FLI, a program can not run. A modified table function continues to be callable, and code continues to work, depending on not to be sensitive to change. It's a decision to be token by development team to take care of change. 

A result set, by construction, is loaded to the client, then worked. It can be an heavy net load.

A table function, due to its destination (to be incorporated in a select), participates to a more global work : build an answer to the client, including WHERE clause on the temporary table, all this on server side.

 

What's about database normalization (IE going to SQL) ? don't know. Have an advice ? feed-back ! thank in advance.

 

The source code is provided as an open source tool under the GNU General Public License, version 2.  In summary, this license specifies:

By clicking the download link you acknowledge and agree to the terms of the license.

Download the (zipped) SAVF containing the JPLTOOLS : the source file, the message file, the bnddir

THIS TOOLBOX IS PROVIDED ''AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PROVIDER OR ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS TOOLBOX, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.