**free
ctl-opt debug
        datedit(*ymd)
        dftactgrp(*no)
        actgrp(*caller)
        datfmt(*iso-)
        decedit('0.');

//***********************************************************************//
// Sample RPG program for an SQL table function                          //
// (Sample based from http://jplamontre.free.fr/AS400/UDTF.htm )         //
//***********************************************************************//

dcl-pi *n;
   // List of table columns
   p_dts         char(26);

   // List of null indicators
   p_idts        int(5);

   // SQL style parameters
   p_sqlstate    char(5);
   p_function    varchar(517);
   p_specific    varchar(128);
   p_sqlmsg      varchar(70);
   p_scratchpad  varchar(100);
   p_calltype    int(10);
end-pi;

dcl-ds scratchDS len(100);
   spStatus      char(5) pos(1);
end-ds;
// -------------------------------------------------------------
// Main program
// -------------------------------------------------------------
scratchDS = p_scratchpad;

p_sqlstate = '00000';
p_sqlmsg   = '';
p_idts     = -1;

select;
   when p_calltype = -2;
      firstCall();

   when p_calltype = -1;
      openCall();

   when p_calltype = 0;
      fetchCall();

   when p_calltype = 1;
      closeCall();

   when p_calltype = 2;
      finalCall();

   other;
      p_sqlstate = 'JP001';
      p_sqlmsg   = 'Unattended call type received';
endsl;

p_scratchpad = scratchDS;

*inlr = *on;
return;


// -------------------------------------------------------------
// First call
// -------------------------------------------------------------
dcl-proc firstCall;

   spStatus = 'FIRST';

end-proc;


// -------------------------------------------------------------
// Open call
// -------------------------------------------------------------
dcl-proc openCall;

   spStatus = 'OPEN ';

end-proc;


// -------------------------------------------------------------
// Fetch call
// -------------------------------------------------------------
dcl-proc fetchCall;

   if spStatus = 'OPEN ';
      p_dts  = %char(%timestamp());
      p_idts = 0;
   else;
      p_sqlstate = '02000';
   endif;

   spStatus = 'FETCH';

end-proc;


// -------------------------------------------------------------
// Close call
// -------------------------------------------------------------
dcl-proc closeCall;

   spStatus = 'CLOSE';

end-proc;


// -------------------------------------------------------------
// Final call
// -------------------------------------------------------------
dcl-proc finalCall;

   spStatus = 'FINAL';

end-proc;