midrange.com code scratchpad
Name:
SJL
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
12/01/2009 08:43:26 pm
IP:
Logged
Description:
Experiment in overloaded SQL UDF's.

%PARMS is always = -1 when this subprocedure is called, regardless of whether 2 or 3 parms are passed from SQL.

example of usage from interactive SQL:
Select SDDOCO, SDDCTO, JDEDD('LNID',SDLNID), JDEDD('AEXP',SDAEXP,'O') from F4211

Code:
  1.      H/Title - Source for RPG program PJDEDD
  2.  
  3.      H   OPTION(*SRCSTMT: *NODEBUGIO: *SHOWCPY :*XREF)
  4.      H   DEBUG(*YES)
  5.      H   BNDDIR('QC2LE')
  6.  
  7.       *----------------------------------------------------------------
  8.       *  To recreate the service program:
  9.       *----------------------------------------------------------------
  10.  
  11.       *  1) DLTSRVPGM MCUTIL/PJDEDD
  12.       *  2) DLTMOD    MCUTIL/PJDEDD
  13.       *  3) CRTRPGMOD MODULE(MCUTIL/PJDEDD  ) SRCFILE(MCUTIL/QRPGLESRC) DBGVIEW(*ALL)
  14.       *  4) CRTSRVPGM SRVPGM(MCUTIL/PJDEDD  ) EXPORT(*ALL)
  15.  
  16.       *----------------------------------------------------------------
  17.       *  SQL Statements to create the SQL user-defined function JDEDD that uses this procedure:
  18.       *----------------------------------------------------------------
  19.       *
  20.       *  drop   FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9) )
  21.       *
  22.       *  CREATE FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9) )
  23.       *  RETURNS CHAR(20)
  24.       *  EXTERNAL NAME 'MCUTIL/PJDEDD(JDEDD)'
  25.       *  LANGUAGE RPGLE
  26.       *  NO SQL
  27.       *  NOT DETERMINISTIC
  28.       *  NOT FENCED
  29.       *  RETURNS NULL ON NULL INPUT
  30.       *
  31.       *  drop   FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9), varchar(1) )
  32.       *
  33.       *  CREATE FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9), varchar(1) )
  34.       *  RETURNS CHAR(20)
  35.       *  EXTERNAL NAME 'MCUTIL/PJDEDD(JDEDD)'
  36.       *  LANGUAGE RPGLE
  37.       *  NO SQL
  38.       *  NOT DETERMINISTIC
  39.       *  NOT FENCED
  40.       *  RETURNS NULL ON NULL INPUT
  41.       *
  42.       *----------------------------------------------------------------
  43.  
  44.      d JDEDD           pr            20a
  45.      d  pDDin                         4a   const varying
  46.      d  pvalueIn                     29s 9
  47.      d  pECORIn                       1a   const varying
  48.      d                                     options(*nopass : *omit)
  49.  
  50.      p JDEDD           b                   export
  51.  
  52.      d JDEDD           pi            20a
  53.      d  pDDin                         4a   const varying
  54.      d  pvalueIn                     29s 9
  55.      d  pECORIn                       1a   const varying
  56.      d                                     options(*nopass : *omit)
  57.  
  58.      d ValueOut        S             20a
  59.  
  60.       /free
  61.  
  62.        NbrParms = %Parms;
  63. .
  64. .  (left out a bunch of irrelevant stuff...)
  65. .
  66.  
  67.        #ECOR  = *blanks;
  68.        // If %ADDR(pECORIn) <> *null and %Len(pECORIn) <> 0;
  69.           Monitor;
  70.              #ECOR   = %XLATE(lo1: up1: %TRIM(pECORIn));
  71.           On-error *all;
  72.              #ECOR   = *blanks;
  73.           EndMon;
  74.        // Endif;
  75.  
  76.        #DCOR  = *blank;
  77.        ExSr C00161;
  78.        If  #ALR = 'L';
  79.            EVAL ValueOut =  #SINBR;                              //    Move Left
  80.        Else;
  81.            EVALR ValueOut =  #SINBR;                              //    Move Right
  82.        EndIf;
  83.  
  84.        Return ValueOut;
  85.        *inlr = *Off;
  86.  
  87.       /end-free
  88.  
  89.       *  Common Subroutine - Format Numeric Fields for Output
  90.       *                      with Overrides
  91.  
  92.      C/COPY JDECPYILE,C00161
  93.  
  94.      p                 e
  95.       *----------------------------------------------------------------
  96.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css