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:
- H/Title - Source for RPG program PJDEDD
-
- H OPTION(*SRCSTMT: *NODEBUGIO: *SHOWCPY :*XREF)
- H DEBUG(*YES)
- H BNDDIR('QC2LE')
-
- *----------------------------------------------------------------
- * To recreate the service program:
- *----------------------------------------------------------------
-
- * 1) DLTSRVPGM MCUTIL/PJDEDD
- * 2) DLTMOD MCUTIL/PJDEDD
- * 3) CRTRPGMOD MODULE(MCUTIL/PJDEDD ) SRCFILE(MCUTIL/QRPGLESRC) DBGVIEW(*ALL)
- * 4) CRTSRVPGM SRVPGM(MCUTIL/PJDEDD ) EXPORT(*ALL)
-
- *----------------------------------------------------------------
- * SQL Statements to create the SQL user-defined function JDEDD that uses this procedure:
- *----------------------------------------------------------------
- *
- * drop FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9) )
- *
- * CREATE FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9) )
- * RETURNS CHAR(20)
- * EXTERNAL NAME 'MCUTIL/PJDEDD(JDEDD)'
- * LANGUAGE RPGLE
- * NO SQL
- * NOT DETERMINISTIC
- * NOT FENCED
- * RETURNS NULL ON NULL INPUT
- *
- * drop FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9), varchar(1) )
- *
- * CREATE FUNCTION JDEDD( VARCHAR(4) , NUMERIC(29,9), varchar(1) )
- * RETURNS CHAR(20)
- * EXTERNAL NAME 'MCUTIL/PJDEDD(JDEDD)'
- * LANGUAGE RPGLE
- * NO SQL
- * NOT DETERMINISTIC
- * NOT FENCED
- * RETURNS NULL ON NULL INPUT
- *
- *----------------------------------------------------------------
-
- d JDEDD pr 20a
- d pDDin 4a const varying
- d pvalueIn 29s 9
- d pECORIn 1a const varying
- d options(*nopass : *omit)
-
- p JDEDD b export
-
- d JDEDD pi 20a
- d pDDin 4a const varying
- d pvalueIn 29s 9
- d pECORIn 1a const varying
- d options(*nopass : *omit)
-
- d ValueOut S 20a
-
- /free
-
- NbrParms = %Parms;
- .
- . (left out a bunch of irrelevant stuff...)
- .
-
- #ECOR = *blanks;
- // If %ADDR(pECORIn) <> *null and %Len(pECORIn) <> 0;
- Monitor;
- #ECOR = %XLATE(lo1: up1: %TRIM(pECORIn));
- On-error *all;
- #ECOR = *blanks;
- EndMon;
- // Endif;
-
- #DCOR = *blank;
- ExSr C00161;
- If #ALR = 'L';
- EVAL ValueOut = #SINBR; // Move Left
- Else;
- EVALR ValueOut = #SINBR; // Move Right
- EndIf;
-
- Return ValueOut;
- *inlr = *Off;
-
- /end-free
-
- * Common Subroutine - Format Numeric Fields for Output
- * with Overrides
-
- C/COPY JDECPYILE,C00161
-
- p e
- *----------------------------------------------------------------
-
|
|
|