ecki/IBM-i-RPG-Free-CLP-Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Add

Browse Source
This commit is contained in:
SJLennon
2021-05-20 15:03:23 -04:00
parent 1cc93cf3b5
commit 0f414cf5fe
7 changed files with 585 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
DATE_UDF/DATECRTFN.SQL
+45
View File
@@ -0,0 +1,45 @@
-- Create the DATE UDF (User Defined Functions) using
-- the routines in the DATE_SQL Service program.
set schema lennons1; -- CHANGE TO YOUR LIBRARY
set path lennons1; -- CHANGE TO YOUR LIBRARY
DROP FUNCTION DATE_MDY
;
CREATE OR REPLACE FUNCTION DATE_MDY
(INDATE DECIMAL(8,0) )
RETURNS DATE
PARAMETER STYLE SQL
LANGUAGE RPGLE
NO SQL
DETERMINISTIC
EXTERNAL NAME 'DATE_SQL(DATE_MDY)'
RETURNS NULL ON NULL INPUT
NO EXTERNAL ACTION
;
DROP FUNCTION DATE_YMD
;
CREATE OR REPLACE FUNCTION DATE_YMD
(INDATE DECIMAL(8,0) )
RETURNS DATE
PARAMETER STYLE SQL
LANGUAGE RPGLE
NO SQL
DETERMINISTIC
EXTERNAL NAME 'DATE_SQL(DATE_YMD)'
RETURNS NULL ON NULL INPUT
NO EXTERNAL ACTION
;
DROP FUNCTION DATE_CYMD
;
CREATE OR REPLACE FUNCTION DATE_CYMD
(INDATE DECIMAL(8,0) )
RETURNS DATE
PARAMETER STYLE SQL
LANGUAGE RPGLE
NO SQL
DETERMINISTIC
EXTERNAL NAME 'DATE_SQL(DATE_CYMD)'
RETURNS NULL ON NULL INPUT
NO EXTERNAL ACTION
;
DATE_UDF/DATE_SQL.RPGLE
+207
View File
@@ -0,0 +1,207 @@
/title SQL UDFs to convert numeric to true dates
//===============================================================
// The DATE_SQL service program contains routines that are
// registered as User Defined Functions to SQL and which
// convert legacy numeric dates to true dates. This makes doing
// date arithmetic in SQL much easier.
//
// For example, if DSTPT is a 6-digit date in YYMMDD format, in SQL
// you can code:
//
// SELECT PNOPT FROM MVPSPRTP
// WHERE DATE_YMD(DSTPT) >= CURDATE() - 9O DAYS
//
// On alder versions of the OS,you may need to cast character dates
// to numeric before using.
// For example, WHERE DECIMAL(DATE_YMD(DSTPT)) >= ...
//
// Function included are:
// DATE_YMD Accepts numeric dates in YMD format, with
// either 6 or 8 digits.
// DATE_MDY Accepts numeric dates in MDY format, with
// either 6 or 8 digits.
// DATE_CYMD Accepts 7 digit numeric dates. If the 1st
// digit is 0 then it is in the 1900s and if
// it is 1 then it is the 2000s. These are
// standard IBM seven byte dates.
// ??????? Similar routines could be added to
// accept other formats
//
// For YMD or MDY dates, it handles either 6 or 8 digits.
// If the date passed is greater then 999999 then is it
// assumed to already have the century.
//
// Invalid dates return a null value. This means the UDFs will
// not crash, but be aware that your results may be skewed if
// you have bad data. (Logic could be added to convert
// "special" bad dates into some corporately acceptable value,
// e.g., 999999 could be converted to 9999-12-31.)
//
// Originally coded late 1990s, before the Y2K cleanups. Since
// tidied up and converted to free form..
//
// To Create
// =========
// 1) CRTRPGMOD MODULE(DATE_SQL) SRCFILE(DATE_UDF)
// OPTION(*EVENTF) DBGVIEW(*SOURCE)
// 2) CRTSRVPGM SRVPGM(DATE_SQL) EXPORT(*ALL)
// TEXT('DATE_SQL Service Program')
// 3) Run the CREATE_FNSQL statements to register to SQL
//===============================================================
H NoMain
//=== Prototypes ================================================
D Date_YMD pr
D NumericDate 8p 0 const
d RealDate d
D Indicators 5i 0 dim(1)
D RetInd 5i 0
d SQLSTATE 5a
d FuncName 517a varying
d SpecificName 128a varying
d ErrText 1000a varying
D Date_CYMD pr
D NumericDate 8p 0 const
d RealDate d
D Indicators 5i 0 dim(1)
D RetInd 5i 0
d SQLSTATE 5a
d FuncName 517a varying
d SpecificName 128a varying
d ErrText 1000a varying
D Date_MDY pr
D NumericDate 8p 0 const
d RealDate d
D Indicators 5i 0 dim(1)
D RetInd 5i 0
d SQLSTATE 5a
d FuncName 517a varying
d SpecificName 128a varying
d ErrText 1000a varying
//===============================================================
// DATE_YMD
// ========
// SQL User Defined Function (UDF) converts a 6 or 8 digit
// numeric date in YMD format to a true date.
//
// Returns
// =======
// If input date is valid, then a true date.
// If input date is invalid, returns null with warning 01H99.
p Date_YMD b export
d Date_YMD pi
d pDateIn 8p 0 const
d pDateOut d
d pIndicators 5i 0 dim(1)
d pRetInd 5i 0
d pSQLSTATE 5a
d pFuncName 517a varying
d pSpecificName 128a varying
d pErrText 1000a varying
/FREE
pRetInd = 0;
pSQLSTATE = '00000';
monitor;
select;
// === 8 digit dates, yyyymmdd =================================
when pDateIn > 999999;
pDateOut = %date(pDateIn: *ISO);
// === 6 digit dates, yymmdd ===================================
other;
pDateOut = %date(pDateIn: *YMD);
endsl;
on-error;
pRetInd = -1;
pDateOut = %date('9999-01-03');
pSQLSTATE = '01H99';
pErrText = %char(pDateIn) + ' is not a (numeric) date';
endmon;
return;
/END-FREE
p Date_YMD e
//===============================================================
// DATE_CYMD
// =========
// SQL User Defined Function (UDF) converts a 7 digit
// numeric date in CYMD format to a true date.
//
// Returns
// =======
// If input date is valid, then a true date.
// If input date is invalid, returns null with warning 01H99.
p Date_CYMD b export
d Date_CYMD pi
d pDateIn 8p 0 const
d pDateOut d
d pIndicators 5i 0 dim(1)
d pRetInd 5i 0
d pSQLSTATE 5a
d pFuncName 517a varying
d pSpecificName 128a varying
d pErrText 1000a varying
/FREE
pRetInd = 0;
pSQLSTATE = '00000';
monitor;
pDateOut = %date(pDateIn: *CYMD);
on-error;
pRetInd = -1;
pDateOut = %date('9999-01-01');
pSQLSTATE = '01H99';
pErrText = %char(pDateIn) + ' is not a (numeric) date';
endmon;
return;
/END-FREE
p Date_CYMD e
//===============================================================
// DATE_MDY
// ========
// SQL User Defined Function (UDF) converts a 6 or 8 digit
// numeric date in MDY format to a true date.
//
// Returns
// =======
// If input date is valid, then a true date.
// If input date is invalid, returns null with warning 01H99.
p Date_MDY b export
d Date_MDY pi
d pDateIn 8p 0 const
d pDateOut d
d pIndicators 5i 0 dim(1)
d pRetInd 5i 0
d pSQLSTATE 5a
d pFuncName 517a varying
d pSpecificName 128a varying
d pErrText 1000a varying
/FREE
pRetInd = 0;
pSQLSTATE = '00000';
monitor;
select;
// === 8 digit dates, mmddyyyy =================================
when pDateIn > 999999;
pDateOut = %date(pDateIn: *USA);
// === 6 digit dates, mmddyy ===================================
other;
pDateOut = %date(pDateIn: *MDY);
endsl;
on-error;
pRetInd = -1;
pDateOut = %date('9999-01-02');
pSQLSTATE = '01H99';
pErrText = %char(pDateIn) + ' is not a (numeric) date';
endmon;
return;
/END-FREE
p Date_MDY e
DATE_UDF/DATE_SQLFR.RPGLE
+208
View File
@@ -0,0 +1,208 @@
**free
/title SQL UDFs to convert numeric to true dates
//===============================================================
// The DATE_SQL service program contains routines that are
// registered as User Defined Functions to SQL and which
// convert legacy numeric dates to true dates. This makes doing
// date arithmetic in SQL much easier.
//
// For example, if DSTPT is a 6-digit date in YYMMDD format, in SQL
// you can code:
//
// SELECT PNOPT FROM MVPSPRTP
// WHERE DATE_YMD(DSTPT) >= CURDATE() - 9O DAYS
//
// On alder versions of the OS,you may need to cast character dates
// to numeric before using.
// For example, WHERE DECIMAL(DATE_YMD(DSTPT)) >= ...
//
// Function included are:
// DATE_YMD Accepts numeric dates in YMD format, with
// either 6 or 8 digits.
// DATE_MDY Accepts numeric dates in MDY format, with
// either 6 or 8 digits.
// DATE_CYMD Accepts 7 digit numeric dates. If the 1st
// digit is 0 then it is in the 1900s and if
// it is 1 then it is the 2000s. These are
// standard IBM seven byte dates.
// ??????? Similar routines could be added to
// accept other formats
//
// For YMD or MDY dates, it handles either 6 or 8 digits.
// If the date passed is greater then 999999 then is it
// assumed to already have the century.
//
// Invalid dates return a null value. This means the UDFs will
// not crash, but be aware that your results may be skewed if
// you have bad data. (Logic could be added to convert
// "special" bad dates into some corporately acceptable value,
// e.g., 999999 could be converted to 9999-12-31.)
//
// Originally coded late 1990s, before the Y2K cleanups. Since
// tidied up and converted to free form..
//
// To Create
// =========
// 1) CRTRPGMOD MODULE(DATE_SQL) SRCFILE(DATE_UDF)
// OPTION(*EVENTF) DBGVIEW(*SOURCE)
// 2) CRTSRVPGM SRVPGM(DATE_SQL) EXPORT(*ALL)
// TEXT('DATE_SQL Service Program')
// 3) Run the CREATE_FNSQL statements to register to SQL
//===============================================================
Ctl-Opt NoMain;
//=== Prototypes ================================================
Dcl-PR Date_YMD;
NumericDate Packed(8:0) const;
RealDate Date;
Indicators Int(5) dim(1);
RetInd Int(5);
SQLSTATE Char(5);
FuncName Varchar(517);
SpecificName Varchar(128);
ErrText Varchar(1000);
End-PR;
Dcl-PR Date_CYMD;
NumericDate Packed(8:0) const;
RealDate Date;
Indicators Int(5) dim(1);
RetInd Int(5);
SQLSTATE Char(5);
FuncName Varchar(517);
SpecificName Varchar(128);
ErrText Varchar(1000);
End-PR;
Dcl-PR Date_MDY;
NumericDate Packed(8:0) const;
RealDate Date;
Indicators Int(5) dim(1);
RetInd Int(5);
SQLSTATE Char(5);
FuncName Varchar(517);
SpecificName Varchar(128);
ErrText Varchar(1000);
End-PR;
//===============================================================
// DATE_YMD
// ========
// SQL User Defined Function (UDF) converts a 6 or 8 digit
// numeric date in YMD format to a true date.
//
// Returns
// =======
// If input date is valid, then a true date.
// If input date is invalid, returns null with warning 01H99.
Dcl-Proc Date_YMD export;
Dcl-PI Date_YMD;
pDateIn Packed(8:0) const;
pDateOut Date;
pIndicators Int(5) dim(1);
pRetInd Int(5);
pSQLSTATE Char(5);
pFuncName Varchar(517);
pSpecificNam Varchar(128);
pErrText Varchar(1000);
End-PI;
pRetInd = 0;
pSQLSTATE = '00000';
monitor;
select;
// === 8 digit dates, yyyymmdd =================================
when pDateIn > 999999;
pDateOut = %date(pDateIn: *ISO);
// === 6 digit dates, yymmdd ===================================
other;
pDateOut = %date(pDateIn: *YMD);
endsl;
on-error;
pRetInd = -1;
pDateOut = %date('9999-01-03');
pSQLSTATE = '01H99';
pErrText = %char(pDateIn) + ' is not a (numeric) date';
endmon;
return;
End-Proc;
//===============================================================
// DATE_CYMD
// =========
// SQL User Defined Function (UDF) converts a 7 digit
// numeric date in CYMD format to a true date.
//
// Returns
// =======
// If input date is valid, then a true date.
// If input date is invalid, returns null with warning 01H99.
Dcl-Proc Date_CYMD export;
Dcl-PI Date_CYMD;
pDateIn Packed(8:0) const;
pDateOut Date;
pIndicators Int(5) dim(1);
pRetInd Int(5);
pSQLSTATE Char(5);
pFuncName Varchar(517);
pSpecificNam Varchar(128);
pErrText Varchar(1000);
End-PI;
pRetInd = 0;
pSQLSTATE = '00000';
monitor;
pDateOut = %date(pDateIn: *CYMD);
on-error;
pRetInd = -1;
pDateOut = %date('9999-01-01');
pSQLSTATE = '01H99';
pErrText = %char(pDateIn) + ' is not a (numeric) date';
endmon;
return;
End-Proc;
//===============================================================
// DATE_MDY
// ========
// SQL User Defined Function (UDF) converts a 6 or 8 digit
// numeric date in MDY format to a true date.
//
// Returns
// =======
// If input date is valid, then a true date.
// If input date is invalid, returns null with warning 01H99.
Dcl-Proc Date_MDY export;
Dcl-PI Date_MDY;
pDateIn Packed(8:0) const;
pDateOut Date;
pIndicators Int(5) dim(1);
pRetInd Int(5);
pSQLSTATE Char(5);
pFuncName Varchar(517);
pSpecificNam Varchar(128);
pErrText Varchar(1000);
End-PI;
pRetInd = 0;
pSQLSTATE = '00000';
monitor;
select;
// === 8 digit dates, mmddyyyy =================================
when pDateIn > 999999;
pDateOut = %date(pDateIn: *USA);
// === 6 digit dates, mmddyy ===================================
other;
pDateOut = %date(pDateIn: *MDY);
endsl;
on-error;
pRetInd = -1;
pDateOut = %date('9999-01-02');
pSQLSTATE = '01H99';
pErrText = %char(pDateIn) + ' is not a (numeric) date';
endmon;
return;
End-Proc;
DATE_UDF/ReadMe.md
+56
View File
@@ -0,0 +1,56 @@
# DATE_UDF - SQL **U**ser **D**efined **F**unctions to Convert a Legacy Date to a True Date
Legacy databases on the IBM i stored dates in numeric (or character) fields. Doing validation or arithmetic on such fields was complex. IBM finally added a true date type to the database as Y2K approached.
After Y2K, many of these dates still existed in databases. I developed these SQL UDFs to convert a legacy date to a true date, largely so I could do date arithmetic. For example:
SELECT ... FROM CUSTMAST WHERE DATE_YMD(DUEDATE) <= CURDATE() - 9O DAYS
The most common formats where month-day-year (in the USA) and year-month day. Often there was no century included. There was also an IBM sanctioned format, CYMD, where the C was a 1-digit century, with 0 meaning 19, and 1 meaning 20.
## Development
What these functions do can also be done, with some work, directly in SQL. And I'm aware there are other open source date UDFs avaliable, e.g. [iDate](https://www.think400.dk/downloads.htm).
However...
1. When I wrote this I was not aware of any similar functions, and there may not have been any. (Though I probably got the idea from [Scott Klement](https://www.scottklement.com/udtf/)).
2. This is an efficient, light weight implementation in RPG.
3. Each function requires only 1 parameter and I like that convenience.
4. The code demonstrates creating an SQL UDF in RPG.
## Functions
There are three functions,each taking a numeric fieldas input. *Note:* Newer versions of SQL will automatically cast character fields to numeric, otherwise you have to cast to numeric manually.
* **DATE_YMD** to convert dates in either YYMMDD or CCYYMMD format.
* Example: 980129 or 19980129.
* Example: 210319 or 20210319
* **DATE_MDY** to convert dates in MMDDYY or MMDDCCYY format.
* Example: 012998 or 01291998
* Example: 031921 or 03192021
* **DATE_CYMD** to convert dates in CYYMMDD format.
* Example: 0990317
* Example: 1210317
### Invalid Input
An invalid input value will return a null value and give a 01H99 SQLSTATE warning.
## DATE_SQL
The RPG code for the DATE_SQL service program, which contains the functions. It is free forms but the D-Specs are still fixed, and it can be edited in SEU. (When I originally wrote it, it was in fixed form RPGIV.)
## DATE_SQLFR
This is DATE_SQL but converted to totally free form. I converted it using [RpgFreeWeb](https://github.com/worksofbarry/rpgfreeweb), which does a nice job.
## DATECRTFN
This is SQL "Create Function" code that tells SQL where the functions are.
## TEST_CYMD/TEST_MDY/TEST_YMD
There are example SQL statements that can be used to test the three functions.
DATE_UDF/TEST_CYMD.SQL
+22
View File
@@ -0,0 +1,22 @@
-- Test DATE_CYMD UDF
set path lennons1; -- Change to your library
set schema session; -- QTEMP
declare global temporary TABLE test_cymd (
Date_7 NUM(7) ,Date_7Char CHAR(7)
);
insert into test_cymd values(0480321, '0480321');
insert into test_cymd values(0010101, '0010101');
insert into test_cymd values(1480321, '1480321');
insert into test_cymd values(1720229, '1720229');
insert into test_cymd values(1710229, '1710229'); --bad
insert into test_cymd values(0210321, '0210321');
insert into test_cymd values(0210332, '0210332'); --bad
insert into test_cymd values(null, null);
SELECT Date_7
,date_cymd(Date_7) AS True_7
,Date_7Char
,date_cymd(date_7Char) AS True_7Char
FROM test_cymd;
DATE_UDF/TEST_MDY.SQL
+22
View File
@@ -0,0 +1,22 @@
-- Test DATE_MDY UDF
set path lennons1; -- Change to your library
set schema session; -- QTEMP
declare global temporary TABLE test_mdy (
Date_6 NUM(6) ,Date_6Char CHAR(6),
Date_8 NUM(8), Date_8Char CHAR(8)
);
insert into test_mdy values(031748, '031748', 03171948, '03171948');
insert into test_mdy values(031721, '031721', 03172021, '03172021');
insert into test_mdy values(033248, '033248', 03321948, '03321948');
insert into test_mdy values(null, null, null, null);
SELECT Date_6
,date_mdy(Date_6) AS True_6
,Date_6Char
,date_mdy(date_6Char) AS True_6Char
,Date_8
,date_mdy(date_8) AS True_8
,Date_8Char
,date_mdy(date_8Char) AS True_8Char
FROM test_mdy;
DATE_UDF/TEST_YMD.SQL
+25
View File
@@ -0,0 +1,25 @@
-- Test DATE_YMD UDF
set path lennons1; -- Change to your library
set schema session; -- QTEMP
declare global temporary TABLE test_ymd (
Date_6 NUM(6) ,Date_6Char CHAR(6),
Date_8 NUM(8), Date_8Char CHAR(8)
);
insert into test_ymd values(480321, '480321', 19480321, '19480321');
insert into test_ymd values(210317, '210317', 20210317, '20210317');
insert into test_ymd values(200229, '200229', 20200229, '20200229');
insert into test_ymd values(210229, '210229', 20210229, '20210229');
insert into test_ymd values(480332, '480332', 19480332, '19480332');
insert into test_ymd values(null, null, null, null);
SELECT Date_6
,date_ymd(Date_6) AS True_6
,Date_6Char
,date_ymd(date_6Char) AS True_6Char
,Date_8
,date_ymd(date_8) AS True_8
,Date_8Char
,date_ymd(date_8Char) AS True_8Char
FROM test_ymd;