Initial Download
This commit is contained in:
SJLennon
@@ -0,0 +1,41 @@
|
||||
CMD PROMPT('Add/Sub from a Date')
|
||||
/* ================================================================*/
|
||||
/* DATEADJR is the command processing program */
|
||||
/* CRTCMD CMD(DATEADJ) PGM(*LIBL/DATEADJR) SRCFILE(DATEADJ) */
|
||||
/* ALLOW(*IPGM *BPGM *IMOD *IPGM) HLPPNLGRP(DATEADJP) */
|
||||
/* HLPID(*CMD) */
|
||||
/* ================================================================*/
|
||||
PARM KWD(INDATE) TYPE(*CHAR) DFT('*JOBDATE') +
|
||||
MIN(0) PROMPT('Input Date')
|
||||
|
||||
PARM KWD(OUTDATE) TYPE(*CHAR) LEN(10) +
|
||||
RTNVAL(*YES) MIN(1) PROMPT('Output Date')
|
||||
|
||||
PARM KWD(ADJAMT) TYPE(*DEC) LEN(5) DFT(1) +
|
||||
PROMPT('Amount to adjust by')
|
||||
|
||||
PARM KWD(ADJTYPE) TYPE(*CHAR) LEN(7) RSTD(*YES) +
|
||||
DFT(*DAYS) VALUES(*DAYS *MONTHS *YEARS) +
|
||||
PROMPT('Adjustment type')
|
||||
|
||||
PARM KWD(INFMT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
|
||||
DFT('*JOBFMT') VALUES('*JOBFMT' +
|
||||
'*YMD' '*MDY' '*DMY' +
|
||||
'*YMD0' '*MDY0' '*DMY0' +
|
||||
'*CYMD' '*CMDY' '*CDMY' +
|
||||
'*CYMD0' '*CMDY0' '*CDMY0' +
|
||||
'*ISO' '*USA' '*EUR' '*JIS' +
|
||||
'*ISO0' '*USA0' '*EUR0' '*JIS0' +
|
||||
'*JUL' '*LONGJUL' '*SYSTEM') PROMPT('Input Date +
|
||||
Format')
|
||||
|
||||
PARM KWD(OUTFMT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
|
||||
DFT('*INFMT') VALUES('*JOBFMT' +
|
||||
'*YMD' '*MDY' '*DMY' +
|
||||
'*YMD0' '*MDY0' '*DMY0' +
|
||||
'*CYMD' '*CMDY' '*CDMY' +
|
||||
'*CYMD0' '*CMDY0' '*CDMY0' +
|
||||
'*ISO' '*USA' '*EUR' '*JIS' +
|
||||
'*ISO0' '*USA0' '*EUR0' '*JIS0' +
|
||||
'*JUL' '*LONGJUL' '*SYSTEM' '*INFMT') +
|
||||
PROMPT('Output Date Format')
|
||||
@@ -0,0 +1,11 @@
|
||||
/* ================================================================ */
|
||||
/* Helper program for DATEADJR to return: */
|
||||
/* 1) The job date format */
|
||||
/* 2) The value of QSYSVAL(DATFMT) */
|
||||
/* ================================================================ */
|
||||
PGM PARM(&JOBFMT &SYSVALFMT)
|
||||
DCL VAR(&JOBFMT) TYPE(*CHAR) LEN(4)
|
||||
DCL VAR(&SYSVALFMT) TYPE(*CHAR) LEN(3)
|
||||
RTVJOBA DATFMT(&JOBFMT)
|
||||
RTVSYSVAL SYSVAL(QDATFMT) RTNVAR(&SYSVALFMT)
|
||||
ENDPGM
|
||||
@@ -0,0 +1,336 @@
|
||||
:pnlgrp.
|
||||
.************************************************************************
|
||||
.* Help for command DATEADJ
|
||||
.************************************************************************
|
||||
:help name='DATEADJ'.
|
||||
Add/Sub from a Date - Help
|
||||
:p.The DATEADJ command adds or subtracts a number of days, months or years
|
||||
from the specified input date. The format of both input and output dates
|
||||
may be specified and may be different, allowing for reformatting.
|
||||
:ehelp.
|
||||
.*******************************************
|
||||
.* Help for parameter INDATE
|
||||
.*******************************************
|
||||
:help name='DATEADJ/INDATE'.
|
||||
Input Date (INDATE) - Help
|
||||
:xh3.Input Date (INDATE)
|
||||
:p.Specifies the beginning date for the calculation.
|
||||
:parml.
|
||||
:pt.:pk def.*JOBDATE:epk.
|
||||
:pd.
|
||||
The job's date is used.
|
||||
:pt.:pv.*SYSTEM:epv.
|
||||
:pd.
|
||||
The system date is used.
|
||||
:pt.:pv.Character value:epv.
|
||||
:pd.
|
||||
Character date formatted as specified in INFMT parameter.
|
||||
:eparml.
|
||||
:ehelp.
|
||||
.*******************************************
|
||||
.* Help for parameter OUTDATE
|
||||
.*******************************************
|
||||
:help name='DATEADJ/OUTDATE'.
|
||||
Output Date (OUTDATE) - Help
|
||||
:xh3.Output Date (OUTDATE)
|
||||
:p.The adjusted date is returned here.
|
||||
:parml.
|
||||
:pt.:pv.character-value:epv.
|
||||
:pd.
|
||||
Formatted as specified by the OUTFMT parameter.
|
||||
:eparml.
|
||||
:ehelp.
|
||||
.*******************************************
|
||||
.* Help for parameter ADJAMT
|
||||
.*******************************************
|
||||
:help name='DATEADJ/ADJAMT'.
|
||||
Amount to adjust by (ADJAMT) - Help
|
||||
:xh3.Units to add or subtract (ADJAMT)
|
||||
:p.The unit amount by which to adjust the date. The type of
|
||||
unit is specified in the AMTTYPE parameter.
|
||||
:P.Positive number to add, negative number to subtract.
|
||||
:p.Zero is acceptable, allowing for date reformatting.
|
||||
:parml.
|
||||
:pt.:pk def.1:epk.
|
||||
:pd.
|
||||
Default is add one unit.
|
||||
:pt.:pv.decimal-number:epv.
|
||||
:pd.
|
||||
Number in the range of -99999 through 99999.
|
||||
:eparml.
|
||||
:ehelp.
|
||||
.*******************************************
|
||||
.* Help for parameter ADJTYPE
|
||||
.*******************************************
|
||||
:help name='DATEADJ/ADJTYPE'.
|
||||
Adjustment type (ADJTYPE) - Help
|
||||
:xh3.Adjustment type (ADJTYPE)
|
||||
:p.The type of unit specified in the ADJAMT parameter.
|
||||
:parml.
|
||||
:pt.:pk def.*DAYS:epk.
|
||||
:pd.
|
||||
Default unit is days.
|
||||
:pt.:pv.*MONTHS:epv.
|
||||
:pd.
|
||||
Unit is months.
|
||||
:pt.:pv.*YEARS:epv.
|
||||
:pd.
|
||||
Unit is years.
|
||||
:eparml.
|
||||
:ehelp.
|
||||
.*******************************************
|
||||
.* Help for parameter INFMT
|
||||
.*******************************************
|
||||
:help name='DATEADJ/INFMT'.
|
||||
Input Date Format (INFMT) - Help
|
||||
:xh3.Input Date Format (INFMT)
|
||||
:p.Specifies the format of the INDATE value.
|
||||
Ignored if INDATE(*JOBDATE) or INDATE(*SYSTEM) is specified, because
|
||||
these dates formats are determined by the Operating System.
|
||||
:parml.
|
||||
:pt.:pk def.*JOBFMT:epk.
|
||||
:pd.
|
||||
Formatted as per the Job's DATFMT value.
|
||||
:pt.:pk.*YMD:epk.
|
||||
:pd.
|
||||
yy/mm/dd
|
||||
:pt.:pk.*MDY:epk.
|
||||
:pd.
|
||||
mm/dd/yy
|
||||
:pt.:pk.*DMY:epk.
|
||||
:pd.
|
||||
dd/mm/yy
|
||||
:pt.:pk.*YMD0:epk.
|
||||
:pd.
|
||||
yymmdd
|
||||
:pt.:pk.*MDY0:epk.
|
||||
:pd.
|
||||
mmddyy
|
||||
:pt.:pk.*DMY0:epk.
|
||||
:pd.
|
||||
ddmmyy
|
||||
|
||||
:pt.:pk.*CYMD:epk.
|
||||
:pd.
|
||||
Cyy/mm/dd
|
||||
:pt.:pk.*CMDY:epk.
|
||||
:pd.
|
||||
Cmm/dd/yy
|
||||
:pt.:pk.*CDMY:epk.
|
||||
:pd.
|
||||
Cdd/mm/yy
|
||||
:pt.:pk.*CYMD0:epk.
|
||||
:pd.
|
||||
Cyymmdd
|
||||
:pt.:pk.*CMDY0:epk.
|
||||
:pd.
|
||||
Cmmddyy
|
||||
:pt.:pk.*CDMY0:epk.
|
||||
:pd.
|
||||
Cddmmyy
|
||||
|
||||
:pt.:pk.*ISO:epk.
|
||||
:pd.
|
||||
yyyy-mm-dd
|
||||
:pt.:pk.*ISO0:epk.
|
||||
:pd.
|
||||
yyyymmdd
|
||||
|
||||
:pt.:pk.*USA:epk.
|
||||
:pd.
|
||||
mm/dd/yyyy
|
||||
:pt.:pk.*USA0:epk.
|
||||
:pd.
|
||||
mmddyyyy
|
||||
|
||||
:pt.:pk.*EUR:epk.
|
||||
:pd.
|
||||
dd.mm.yyyy
|
||||
:pt.:pk.*EUR0:epk.
|
||||
:pd.
|
||||
ddmmyyyy
|
||||
|
||||
:pt.:pk.*JIS:epk.
|
||||
:pd.
|
||||
yyyy-mm-dd
|
||||
:pt.:pk.*JIS0:epk.
|
||||
:pd.
|
||||
yyyymmdd
|
||||
|
||||
:pt.:pk.*JUL:epk.
|
||||
:pd.
|
||||
yy/ddd
|
||||
:pt.:pk.*LONGJUL:epk.
|
||||
:pd.
|
||||
yyyy/ddd
|
||||
|
||||
:pt.:pk.*SYSTEM:epk.
|
||||
:pd.
|
||||
As specified by QSYSVAL(QDATFMT): yy/mm/dd, mm/dd/yy, dd/mm/yy, yy/ddd
|
||||
|
||||
:eparml.
|
||||
:ehelp.
|
||||
.*******************************************
|
||||
.* Help for parameter OUTFMT
|
||||
.*******************************************
|
||||
:help name='DATEADJ/OUTFMT'.
|
||||
Output Date Format (OUTFMT) - Help
|
||||
:xh3.Output Date Format (OUTFMT)
|
||||
:p.Specifies the format of the date returned in the OUTDATE paramater.
|
||||
:parml.
|
||||
:pt.:pk def.*INFMT:epk.
|
||||
:pd.
|
||||
Formatted as as specefied in the INFMT parameter.
|
||||
:pt.:pk.*JOBFMT:epk.
|
||||
:pd.
|
||||
Formatted as per the Job's DATFMT value.
|
||||
:pt.:pk.*YMD:epk.
|
||||
:pd.
|
||||
yy/mm/dd
|
||||
:pt.:pk.*MDY:epk.
|
||||
:pd.
|
||||
mm/dd/yy
|
||||
:pt.:pk.*DMY:epk.
|
||||
:pd.
|
||||
dd/mm/yy
|
||||
:pt.:pk.*YMD0:epk.
|
||||
:pd.
|
||||
yymmdd
|
||||
:pt.:pk.*MDY0:epk.
|
||||
:pd.
|
||||
mmddyy
|
||||
:pt.:pk.*DMY0:epk.
|
||||
:pd.
|
||||
ddmmyy
|
||||
|
||||
:pt.:pk.*CYMD:epk.
|
||||
:pd.
|
||||
Cyy/mm/dd
|
||||
:pt.:pk.*CMDY:epk.
|
||||
:pd.
|
||||
Cmm/dd/yy
|
||||
:pt.:pk.*CDMY:epk.
|
||||
:pd.
|
||||
Cdd/mm/yy
|
||||
:pt.:pk.*CYMD0:epk.
|
||||
:pd.
|
||||
Cyymmdd
|
||||
:pt.:pk.*CMDY0:epk.
|
||||
:pd.
|
||||
Cmmddyy
|
||||
:pt.:pk.*CDMY0:epk.
|
||||
:pd.
|
||||
Cddmmyy
|
||||
|
||||
:pt.:pk.*ISO:epk.
|
||||
:pd.
|
||||
yyyy-mm-dd
|
||||
:pt.:pk.*ISO0:epk.
|
||||
:pd.
|
||||
yyyymmdd
|
||||
|
||||
:pt.:pk.*USA:epk.
|
||||
:pd.
|
||||
mm/dd/yyyy
|
||||
:pt.:pk.*USA0:epk.
|
||||
:pd.
|
||||
mmddyyyy
|
||||
|
||||
:pt.:pk.*EUR:epk.
|
||||
:pd.
|
||||
dd.mm.yyyy
|
||||
:pt.:pk.*EUR0:epk.
|
||||
:pd.
|
||||
ddmmyyyy
|
||||
|
||||
:pt.:pk.*JIS:epk.
|
||||
:pd.
|
||||
yyyy-mm-dd
|
||||
:pt.:pk.*JIS0:epk.
|
||||
:pd.
|
||||
yyyymmdd
|
||||
|
||||
:pt.:pk.*JUL:epk.
|
||||
:pd.
|
||||
yy/ddd
|
||||
:pt.:pk.*LONGJUL:epk.
|
||||
:pd.
|
||||
yyyy/ddd
|
||||
|
||||
:pt.:pk.*SYSTEM:epk.
|
||||
:pd.
|
||||
As specified by QSYSVAL(QDATFMT): yy/mm/dd, mm/dd/yy, dd/mm/yy, yy/ddd
|
||||
|
||||
:pt.:pk def.*INFMT:epk.
|
||||
:pd.
|
||||
As specified by the INFMT parameter
|
||||
|
||||
:eparml.
|
||||
:ehelp.
|
||||
.**************************************************
|
||||
.*
|
||||
.* Examples for DATEADJ
|
||||
.*
|
||||
.**************************************************
|
||||
:help name='DATEADJ/COMMAND/EXAMPLES'.
|
||||
Examples for DATEADJ - Help
|
||||
:xh3.Examples for DATEADJ
|
||||
:p.:hp2.Example 1: Calculate tomorrow:ehp2.
|
||||
:xmp.
|
||||
DATEADJ INDATE(*SYSTEM) OUTDATE(&NEWDTE)
|
||||
:exmp.
|
||||
:p.Takes the default of 1 for DAYS and adds to the system date
|
||||
:p.:hp2.Example 2: Calculate yesterday:ehp2.
|
||||
:xmp.
|
||||
DATEADJ INDATE(*JOBDATE) OUTDATE(&NEWDTE) ADJAMT(-1)
|
||||
:exmp.
|
||||
:p.Subtracts 1 day from the job date.
|
||||
:p.:hp2.Example 3: Calculate and reformat:ehp2.
|
||||
:xmp.
|
||||
DATEADJ INDATE('2019-03-21') OUTDATE(&NEWDTE) +
|
||||
ADJAMT(-1) INFMT(*ISO) OUTFMT(*JOBFMT)
|
||||
:exmp.
|
||||
:p.Subtracts 1 day from the ISO input date and returns the date
|
||||
in the Job date format.
|
||||
:p.:hp2.Example 4: Calculate beginning and end of last month:ehp2.
|
||||
:xmp.
|
||||
PGM
|
||||
/* Caclulate last month beginning and ending dates */
|
||||
DCL VAR(&THISDAY) TYPE(*CHAR) LEN(2)
|
||||
DCL VAR(&ADJ) TYPE(*CHAR) LEN(3)
|
||||
DCL VAR(&WKDATE) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&EOML) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&BOML) TYPE(*CHAR) LEN(10)
|
||||
/* Adjustment of minus the day value in the system date*/
|
||||
RTVSYSVAL SYSVAL(QDAY) RTNVAR(&THISDAY)
|
||||
CHGVAR VAR(&ADJ) VALUE('-' *TCAT &THISDAY)
|
||||
/* Last day of last month */
|
||||
DATEADJ INDATE(*SYSTEM) OUTDATE(&EOML) ADJAMT(&ADJ)
|
||||
/* 1st of this month */
|
||||
DATEADJ INDATE(&EOML) OUTDATE(&WKDATE) ADJAMT(1)
|
||||
/* 1st of last month */
|
||||
DATEADJ INDATE(&WKDATE) OUTDATE(&BOML) ADJAMT(-1) +
|
||||
ADJTYPE(*MONTHS) INFMT('*SYSTEM')
|
||||
SNDMSG MSG('Last month is' *BCAT &BOML *BCAT +
|
||||
'through' *BCAT &EOML) TOUSR(*REQUESTER)
|
||||
ENDPGM
|
||||
:exmp.
|
||||
:p.Note that that when adjusting by months or years you should start at
|
||||
the first day of a month.
|
||||
:ehelp.
|
||||
.**************************************************
|
||||
.* Error messages for DATEADJ
|
||||
.**************************************************
|
||||
:help name='DATEADJ/ERROR/MESSAGES'.
|
||||
&msg(CPX0005,QCPFMSG). DATEADJ - Help
|
||||
:xh3.&msg(CPX0005,QCPFMSG). DATEADJ
|
||||
:p.:hp3.*ESCAPE &msg(CPX0006,QCPFMSG).:ehp3.
|
||||
:DL COMPACT.
|
||||
:DT.CPF9898
|
||||
:DD.Input date invalid or not compatible with input format.
|
||||
:DT.CPF9898
|
||||
:DD.Calculated date not compatible with output format.
|
||||
:EDL.
|
||||
:ehelp.
|
||||
:epnlgrp.
|
||||
|
||||
@@ -0,0 +1,274 @@
|
||||
**free
|
||||
// ==================================================================
|
||||
// Use the DATEADJ command to invoke this program.
|
||||
// Logic to add or subtract from a date with specified input and
|
||||
// output formats.
|
||||
// ==================================================================
|
||||
// Note: ACTGRP *NEW is specified so that the activation group goes
|
||||
// away on return. This ensures that a new job date in
|
||||
// an interactive session is picked up.
|
||||
// Yes, some overhead, but I doubt if this will be noticed in
|
||||
// most CL programs.
|
||||
ctl-opt option(*nodebugio: *srcstmt)
|
||||
actgrp(*new)
|
||||
main(Main);
|
||||
ctl-opt BndDir('UTIL_BND');
|
||||
/COPY copy_mbrs,Srv_Msg_P
|
||||
dcl-pr getSpecFmts extpgm('DATEADJC');
|
||||
jobfmt char(4);
|
||||
sysvalfmt char(3);
|
||||
end-pr;
|
||||
|
||||
dcl-proc Main;
|
||||
dcl-pi Main;
|
||||
piInDate char(10);
|
||||
poOutDate char(10);
|
||||
piAdj packed(5);
|
||||
piAdjType char(7);
|
||||
piInFmt char(10);
|
||||
piOutFmt char(10);
|
||||
end-pi;
|
||||
|
||||
dcl-s wkInDate like(piInDate);
|
||||
dcl-s wkInFmt like(piInFmt);
|
||||
dcl-s wkOutFmt like(piOutFmt);
|
||||
|
||||
dcl-s JobDateFmt char(4);
|
||||
dcl-s QDatFmt char(3);
|
||||
|
||||
dcl-s wkDate date;
|
||||
|
||||
poOutDate ='9999/99/99';
|
||||
|
||||
// === Move input parameters to work variables ====================
|
||||
wkInDate = piInDate;
|
||||
wkInFmt = piInFmt;
|
||||
wkOutFmt =piOutFmt;
|
||||
|
||||
// === Handle special values in and out fmts =======================
|
||||
if (piInFmt ='*JOBFMT'
|
||||
or piInFmt ='*SYSTEM'
|
||||
or piOutFmt = '*JOBFMT'
|
||||
or piOutFmt = '*SYSTEM');
|
||||
getSpecFmts(JobDateFmt:QDatFmt);
|
||||
endif;
|
||||
|
||||
if (piInFmt = '*JOBFMT');
|
||||
wkInFmt = JobDateFmt;
|
||||
endif;
|
||||
|
||||
if (piInFmt = '*SYSTEM');
|
||||
wkInFmt = '*' + QDatFmt;
|
||||
endif;
|
||||
|
||||
if (piOutFmt = '*JOBFMT');
|
||||
wkOutFmt = JobDateFmt;
|
||||
endif;
|
||||
|
||||
if (piOutFmt = '*SYSTEM');
|
||||
wkOutFmt = '*' + QDatFmt;
|
||||
endif;
|
||||
|
||||
if (piOutFmt = '*INFMT');
|
||||
wkOutFmt = wkInFmt;
|
||||
endif;
|
||||
|
||||
// === Handle special date values =================================
|
||||
if (piInDate = '*SYSTEM');
|
||||
wkInDate = %char(%date : *ISO);
|
||||
wkInFmt = '*ISO'; // ignore INFMT value
|
||||
endif;
|
||||
|
||||
if (piInDate = '*JOBDATE');
|
||||
wkInDate =%char(%date(UDATE) :*ISO);
|
||||
wkInFmt = '*ISO'; // ignore INFMT value
|
||||
endif;
|
||||
|
||||
*inlr = *on;
|
||||
|
||||
// === Do the calculation and return the date =====================
|
||||
// wkInfmt & wkOutFmt control conversions.
|
||||
monitor;
|
||||
wkDate = CvtInDate(wkInDate : wkInFmt);
|
||||
on-error;
|
||||
badInDate(wkInDate : wkInFmt);
|
||||
endmon;
|
||||
|
||||
select;
|
||||
when (piAdjType = '*DAYS');
|
||||
wkDate = wkDate + %days(piAdj);
|
||||
when (piAdjType = '*MONTHS');
|
||||
wkDate = wkDate + %months(piAdj);
|
||||
when (piAdjType = '*YEARS');
|
||||
wkDate = wkDate + %years(piAdj);
|
||||
other;
|
||||
SndEscMsg('ADJTYPE: '+ piAdjType + ' not supported' :4);
|
||||
endsl;
|
||||
|
||||
monitor;
|
||||
poOutDate = toOutDate(wkDate : wkOutFmt);
|
||||
on-error;
|
||||
badOutDate(wkDate : piOutFmt);
|
||||
endmon;
|
||||
|
||||
return;
|
||||
end-proc;
|
||||
|
||||
// === Convert the input char string to a date =======================
|
||||
dcl-proc CvtInDate;
|
||||
dcl-pi CvtInDate date;
|
||||
inChar char(10);
|
||||
inFmt char(10);
|
||||
end-pi;
|
||||
dcl-s outDate date;
|
||||
select;
|
||||
when (inFmt = '*YMD');
|
||||
outDate = %date(inChar : *YMD);
|
||||
when (inFmt = '*MDY');
|
||||
outDate = %date(inChar : *MDY);
|
||||
when (inFmt = '*DMY');
|
||||
outDate = %date(inChar : *DMY);
|
||||
|
||||
when (inFmt = '*YMD0');
|
||||
outDate = %date(inChar : *YMD0);
|
||||
when (inFmt = '*MDY0');
|
||||
outDate = %date(inChar : *MDY0);
|
||||
when (inFmt = '*DMY0');
|
||||
outDate = %date(inChar : *DMY0);
|
||||
|
||||
when (inFmt = '*CYMD');
|
||||
outDate = %date(inChar : *CYMD);
|
||||
when (inFmt = '*CMDY');
|
||||
outDate = %date(inChar : *CMDY);
|
||||
when (inFmt = '*CDMY');
|
||||
outDate = %date(inChar : *CDMY);
|
||||
|
||||
when (inFmt = '*CYMD0');
|
||||
outDate = %date(inChar : *CYMD0);
|
||||
when (inFmt = '*CMDY0');
|
||||
outDate = %date(inChar : *CMDY0);
|
||||
when (inFmt = '*CDMY0');
|
||||
outDate = %date(inChar : *CDMY0);
|
||||
|
||||
when (inFmt = '*ISO');
|
||||
outDate = %date(inChar : *ISO);
|
||||
when (inFmt = '*ISO0');
|
||||
outDate = %date(inChar : *ISO0);
|
||||
|
||||
when (inFmt = '*USA');
|
||||
outDate = %date(inChar : *USA);
|
||||
when (inFmt = '*USA0');
|
||||
outDate = %date(inChar : *USA0);
|
||||
|
||||
when (inFmt = '*EUR');
|
||||
outDate = %date(inChar : *EUR);
|
||||
when (inFmt = '*EUR0');
|
||||
outDate = %date(inChar : *EUR0);
|
||||
|
||||
when (inFmt = '*JIS');
|
||||
outDate = %date(inChar : *JIS);
|
||||
when (inFmt = '*JIS0');
|
||||
outDate = %date(inChar : *JIS0);
|
||||
|
||||
when (inFmt = '*JUL');
|
||||
outDate = %date(inChar : *JUL);
|
||||
when (inFmt = '*LONGJUL');
|
||||
outDate = %date(inChar : *LONGJUL);
|
||||
|
||||
other; // Should never happen
|
||||
SndEscMsg('INFMT; ' + inFmt + ' not supported':4);
|
||||
endsl;
|
||||
return outDate;
|
||||
end-proc;
|
||||
|
||||
// === Convert date to character =====================================
|
||||
// Returns input date in format specified
|
||||
dcl-proc toOutDate;
|
||||
dcl-pi toOutDate char(10);
|
||||
theDate date;
|
||||
outFmt char(10);
|
||||
end-pi;
|
||||
dcl-s wkChar char(10);
|
||||
select;
|
||||
when (outFmt = '*YMD');
|
||||
wkChar = %char(theDate : *YMD);
|
||||
when (outFmt = '*MDY');
|
||||
wkChar = %char(theDate : *MDY);
|
||||
when (outFmt = '*DMY');
|
||||
wkChar = %char(theDate : *DMY);
|
||||
|
||||
when (outFmt = '*YMD0');
|
||||
wkChar = %char(theDate : *YMD0);
|
||||
when (outFmt = '*MDY0');
|
||||
wkChar = %char(theDate : *MDY0);
|
||||
when (outFmt = '*DMY0');
|
||||
wkChar = %char(theDate : *DMY0);
|
||||
|
||||
when (outFmt = '*CYMD');
|
||||
wkChar = %char(theDate : *CYMD);
|
||||
when (outFmt = '*CMDY');
|
||||
wkChar = %char(theDate : *CMDY);
|
||||
when (outFmt = '*CDMY');
|
||||
wkChar = %char(theDate : *CDMY);
|
||||
|
||||
when (outFmt = '*CYMD0');
|
||||
wkChar = %char(theDate : *CYMD0);
|
||||
when (outFmt = '*CMDY0');
|
||||
wkChar = %char(theDate : *CMDY0);
|
||||
when (outFmt = '*CDMY0');
|
||||
wkChar = %char(theDate : *CDMY0);
|
||||
|
||||
when (outFmt = '*ISO');
|
||||
wkChar = %char(theDate : *ISO);
|
||||
when (outFmt = '*ISO0');
|
||||
wkChar = %char(theDate : *ISO0);
|
||||
|
||||
when (outFmt = '*USA');
|
||||
wkChar = %char(theDate : *USA);
|
||||
when (outFmt = '*USA0');
|
||||
wkChar = %char(theDate : *USA0);
|
||||
|
||||
when (outFmt = '*EUR');
|
||||
wkChar = %char(theDate : *EUR);
|
||||
when (outFmt = '*EUR0');
|
||||
wkChar = %char(theDate : *EUR0);
|
||||
|
||||
when (outFmt = '*JIS');
|
||||
wkChar = %char(theDate : *JIS);
|
||||
when (outFmt = '*JIS0');
|
||||
wkChar = %char(theDate : *JIS0);
|
||||
|
||||
when (outFmt = '*JUL');
|
||||
wkChar = %char(theDate : *JUL);
|
||||
when (outFmt = '*LONGJUL');
|
||||
wkChar = %char(theDate : *LONGJUL);
|
||||
other; // Should never happen
|
||||
SndEscMsg('OUTFMT; ' + outFmt + ' not supported':4);
|
||||
endsl;
|
||||
return wkChar;
|
||||
end-proc;
|
||||
|
||||
// === Crash if input bad ============================================
|
||||
// Standardizes the message for all input variations
|
||||
dcl-proc badInDate;
|
||||
dcl-pi badInDate;
|
||||
theChar char(10);
|
||||
theFmt char(10);
|
||||
end-pi;
|
||||
SndEscMsg('Input date "' + %trim(theChar)
|
||||
+ '" not valid or not compatible with input format "'
|
||||
+ %trim(theFmt) + '"'
|
||||
:4);
|
||||
end-proc;
|
||||
|
||||
// === Crash if incompatible output format ===========================
|
||||
dcl-proc badOutDate;
|
||||
dcl-pi badOutDate;
|
||||
theDate date;
|
||||
theFmt char(10);
|
||||
end-pi;
|
||||
SndEscMsg('Calculated date "' +%char(theDate)
|
||||
+ '" is not compatible with output format "'
|
||||
+ %trim(theFmt) + '"'
|
||||
:4);
|
||||
end-proc;
|
||||
@@ -0,0 +1,22 @@
|
||||
/* Use DATEADJR command with specified parameters */
|
||||
/* Called by T1R for extensive testing. */
|
||||
PGM PARM(&INDATE &ADJ &TYPE &INFMT &OUTFMT &OUTDATE +
|
||||
&OUTESC)
|
||||
DCL VAR(&INDATE) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&ADJ) TYPE(*DEC) LEN(5 0)
|
||||
DCL VAR(&TYPE) TYPE(*CHAR) LEN(7)
|
||||
DCL VAR(&INFMT) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&OUTFMT) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&OUTDATE) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&OUTESC) TYPE(*CHAR) LEN(100) VALUE(' ')
|
||||
CHGVAR VAR(&OUTESC) VALUE(' ')
|
||||
|
||||
DATEADJ INDATE(&INDATE) OUTDATE(&OUTDATE) +
|
||||
ADJAMT(&ADJ) ADJTYPE(&TYPE) +
|
||||
INFMT(&INFMT) OUTFMT(&OUTFMT)
|
||||
MONMSG MSGID(CPF9898 CPF0001) EXEC(DO)
|
||||
CHGVAR VAR(&OUTDATE) VALUE('*Failed*')
|
||||
RCVMSG MSGTYPE(*EXCP) RMV(*YES) MSG(&OUTESC)
|
||||
ENDDO
|
||||
|
||||
ENDPGM
|
||||
@@ -0,0 +1,376 @@
|
||||
**free
|
||||
ctl-opt DftActGrp(*NO) ActGrp(*new) option(*nodebugio: *srcstmt)
|
||||
main(Main);
|
||||
ctl-opt BndDir('UTIL_BND');
|
||||
/COPY copy_mbrs,Srv_Msg_P
|
||||
/COPY copy_mbrs,Prt_p
|
||||
|
||||
dcl-proc Main;
|
||||
|
||||
// CL pgm that executes DATEADJ command
|
||||
dcl-pr datet extpgm('T1C');
|
||||
indate char(10);
|
||||
indays packed(5:0);
|
||||
inType char(7);
|
||||
inFmt char(10);
|
||||
outFmt char(10);
|
||||
outDate char(10);
|
||||
outEsc char(100);
|
||||
end-pr;
|
||||
|
||||
dcl-s indate char(10);
|
||||
dcl-s days packed(5:0);
|
||||
dcl-s inType char(7);
|
||||
dcl-s inFmt char(10);
|
||||
dcl-s outFmt char(10);
|
||||
dcl-s outEsc char(100);
|
||||
|
||||
dcl-s outDate char(10);
|
||||
|
||||
dcl-ds line len(132) qualified;
|
||||
inFmt char(10);
|
||||
*n char(1);
|
||||
indate char(10);
|
||||
*n char(1);
|
||||
days char(5);
|
||||
*n char(1);
|
||||
inType Char(7);
|
||||
*n char(1);
|
||||
outDate char(10);
|
||||
*n char(1);
|
||||
outFmt char(10);
|
||||
end-ds;
|
||||
|
||||
dcl-ds head likeds(line);
|
||||
head.inFmt = 'InFmt';
|
||||
head.indate = 'inDate';
|
||||
head.days = ' Adj';
|
||||
head.inType = 'Type';
|
||||
head.outDate = 'OutDate';
|
||||
head.outFmt = 'OutFmt';
|
||||
PRT(head :'*HEAD') ;
|
||||
|
||||
// === Test default stuff ====
|
||||
inType = '*DAYS';
|
||||
// --------------------------------
|
||||
PRT('=== Testing SYSTEM date') ;
|
||||
days = 1;
|
||||
indate = '*SYSTEM';
|
||||
inFmt = '*JOBFMT';
|
||||
outFmt = '*INFMT';
|
||||
exsr doit;
|
||||
outFmt = '*MDY';
|
||||
exsr doit;
|
||||
inFmt = '*LONGJUL';
|
||||
exsr doit;
|
||||
outFmt = '*ISO';
|
||||
exsr doit;
|
||||
|
||||
// --------------------------------
|
||||
PRT('=== Testing date: *JOBDATE');
|
||||
indate ='*JOBDATE';
|
||||
inFmt = '*JUL';
|
||||
outFmt = '*INFMT';
|
||||
exsr doit;
|
||||
outFmt = '*EUR';
|
||||
exsr doit;
|
||||
days =-1;
|
||||
exsr doit;
|
||||
days = 0;
|
||||
exsr doit;
|
||||
|
||||
// == Test all input formats
|
||||
PRT(' ' : '*NEWPAGE');
|
||||
PRT('=== Testing Input formats ===');
|
||||
days = 1;
|
||||
outFmt = '*ISO';
|
||||
// -------------------------------
|
||||
indate = '99/12/31';
|
||||
inFmt = '*YMD';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '12/31/99';
|
||||
inFmt = '*MDY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '31/12/99';
|
||||
inFmt = '*DMY';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
indate = '991231';
|
||||
inFmt = '*YMD0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '123199';
|
||||
inFmt = '*MDY0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '311299';
|
||||
inFmt = '*DMY0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
indate = '099/12/31';
|
||||
inFmt = '*CYMD';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '012/31/99';
|
||||
inFmt = '*CMDY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '031/12/99';
|
||||
inFmt = '*CDMY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '0991231';
|
||||
inFmt = '*CYMD0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '0123199';
|
||||
inFmt = '*CMDY0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '0311299';
|
||||
inFmt = '*CDMY0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
indate = '1999-12-31';
|
||||
inFmt = '*ISO';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '12/31/1999';
|
||||
inFmt = '*USA';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '31.12.1999';
|
||||
inFmt = '*EUR';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '1999-12-31';
|
||||
inFmt = '*JIS';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
indate = '19991231';
|
||||
inFmt = '*ISO0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '12311999';
|
||||
inFmt = '*USA0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '31121999';
|
||||
inFmt = '*EUR0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '19991231';
|
||||
inFmt = '*JIS0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
indate = '99/365';
|
||||
inFmt = '*JUL';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
indate = '1999/365';
|
||||
inFmt = '*LONGJUL';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '03/17/21';
|
||||
inFmt = '*SYSTEM';
|
||||
days =31;
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '03/21/21';
|
||||
inFmt = '*JOBFMT';
|
||||
days =61;
|
||||
exsr doit;
|
||||
|
||||
|
||||
// === Test all output formats ===
|
||||
PRT(' ' : '*NEWPAGE');
|
||||
PRT('=== Testing Output formats ===');
|
||||
days = 1;
|
||||
// -------------------------------
|
||||
indate = '03/17/21';
|
||||
inFmt = '*JOBFMT';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate ='24/02/28';
|
||||
inFmt = '*YMD';
|
||||
outFmt = '*YMD';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*MDY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*DMY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate ='24/02/28';
|
||||
inFmt = '*YMD';
|
||||
outFmt = '*YMD0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*MDY0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*DMY0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
days = 2;
|
||||
indate ='80/02/28';
|
||||
inFmt = '*YMD';
|
||||
outFmt = '*CYMD';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*CMDY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*CDMY';
|
||||
// -------------------------------
|
||||
exsr doit;
|
||||
outFmt = '*CYMD0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*CMDY0';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*CDMY0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
outFmt = '*ISO';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*ISO0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
outFmt = '*USA';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*USA0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
outFmt = '*EUR';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*EUR0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
outFmt = '*JIS';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*JIS0';
|
||||
exsr doit;
|
||||
|
||||
// -------------------------------
|
||||
outFmt = '*JUL';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*LONGJUL';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt = '*SYSTEM';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
outFmt= '*ISO';
|
||||
inFmt = '*MDY';
|
||||
indate = '03/01/80';
|
||||
days = -2;
|
||||
exsr doit;
|
||||
days = -1;
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '03/17/21';
|
||||
outFmt = '*JOBFMT';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
days = 0;
|
||||
inFmt = '*ISO';
|
||||
indate = '1999-01-01';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
days = 365;
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
|
||||
// === Test error Handling
|
||||
PRT(' ' : '*NEWPAGE');
|
||||
PRT('=== Testing Error Handling ===');
|
||||
indate = '2039-12-31';
|
||||
days = 1;
|
||||
inFmt = '*ISO';
|
||||
outFmt = '*YMD';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
inFmt = 'XXX';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
inFmt = '*ISO';
|
||||
outFmt = 'YYY';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '2039-13-31';
|
||||
outFmt = '*ISO';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '01/01/40';
|
||||
inFmt = '*MDY';
|
||||
days = -1;
|
||||
outFmt = '*INFMT';
|
||||
exsr doit;
|
||||
// -------------------------------
|
||||
indate = '01/01/19';
|
||||
inType = '*CENTURY';
|
||||
exsr doit;
|
||||
|
||||
// === Testing *MONTH
|
||||
PRT(' ' : '*NEWPAGE');
|
||||
// get first day of this month
|
||||
indate = '*JOBDATE';
|
||||
inType = '*DAYS';
|
||||
days = 1 - %subdt(%date(udate) :*days);
|
||||
outFmt = '*INFMT';
|
||||
exsr doit;
|
||||
// get first day of last month
|
||||
indate = outDate;
|
||||
inType = '*MONTHS';
|
||||
days = -1;
|
||||
exsr doit;
|
||||
// first day of this year
|
||||
indate = '*JOBDATE';
|
||||
days = 1 - %subdt(%date(udate) :*months);
|
||||
inType = '*MONTHS';
|
||||
exsr doit;
|
||||
// first day of last year
|
||||
indate = outDate;
|
||||
days = -1;
|
||||
inType = '*YEARS';
|
||||
exsr doit;
|
||||
|
||||
return;
|
||||
|
||||
begsr doit;
|
||||
datet(indate : days : inType : inFmt : outFmt : outDate : outEsc);
|
||||
|
||||
line.inFmt = inFmt;
|
||||
line.indate = indate;
|
||||
evalr line.days = %trim(%char(days));
|
||||
line.inType = inType;
|
||||
line.outDate = outDate;
|
||||
line.outFmt = outFmt;
|
||||
PRT(line);
|
||||
if (outEsc <> ' ');
|
||||
PRT(' +++ ERROR +++ Msg: ' +outEsc);
|
||||
endif;
|
||||
endsr;
|
||||
end-proc;
|
||||
|
||||
@@ -0,0 +1,46 @@
|
||||
PGM
|
||||
DCL VAR(&NEWDTE) TYPE(*CHAR) LEN(10) +
|
||||
VALUE('**dummy**')
|
||||
/* Tomorrow */
|
||||
DATEADJ INDATE(*SYSTEM) OUTDATE(&NEWDTE)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
CHGVAR VAR(&NEWDTE) VALUE('**dummy**')
|
||||
/* Yesterday*/
|
||||
DATEADJ INDATE(*JOBDATE) OUTDATE(&NEWDTE) ADJAMT(-1)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
CHGVAR VAR(&NEWDTE) VALUE('**dummy**')
|
||||
/* Day before arbitrary date & reformat */
|
||||
DATEADJ INDATE('2019-03-21') OUTDATE(&NEWDTE) +
|
||||
ADJAMT(-1) INFMT(*ISO) OUTFMT(*JOBFMT)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
CHGVAR VAR(&NEWDTE) VALUE('**dummy**')
|
||||
/* Just reformat and output as Julian date */
|
||||
DATEADJ INDATE('2019-03-21') OUTDATE(&NEWDTE) +
|
||||
ADJAMT(0) INFMT(*ISO) OUTFMT(*JUL)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
CHGVAR VAR(&NEWDTE) VALUE('**dummy**')
|
||||
/* Add a month and output in input format */
|
||||
DATEADJ INDATE('2024-02-28') OUTDATE(&NEWDTE) +
|
||||
ADJAMT(1) ADJTYPE(*MONTHS) INFMT(*ISO) +
|
||||
OUTFMT(*INFMT)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
CHGVAR VAR(&NEWDTE) VALUE('**dummy**')
|
||||
/* Add a year and output in input format */
|
||||
DATEADJ INDATE('2024-02-29') OUTDATE(&NEWDTE) +
|
||||
ADJAMT(2) ADJTYPE(*YEARS) INFMT(*ISO) +
|
||||
OUTFMT(*INFMT)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
CHGVAR VAR(&NEWDTE) VALUE('**dummy**')
|
||||
/* Add a year and output in input format */
|
||||
DATEADJ INDATE('03/21/99') OUTDATE(&NEWDTE) +
|
||||
ADJAMT(2) ADJTYPE(*YEARS) INFMT(*SYSTEM) +
|
||||
OUTFMT(*INFMT)
|
||||
SNDMSG MSG(&NEWDTE) TOUSR(*REQUESTER)
|
||||
|
||||
ENDPGM
|
||||
@@ -0,0 +1,20 @@
|
||||
PGM
|
||||
/* Calculate last month beginning and ending dates */
|
||||
DCL VAR(&THISDAY) TYPE(*CHAR) LEN(2)
|
||||
DCL VAR(&ADJ) TYPE(*CHAR) LEN(3)
|
||||
DCL VAR(&WKDATE) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&EOML) TYPE(*CHAR) LEN(10)
|
||||
DCL VAR(&BOML) TYPE(*CHAR) LEN(10)
|
||||
/* Adjustment is minus day value of today in system date*/
|
||||
RTVSYSVAL SYSVAL(QDAY) RTNVAR(&THISDAY)
|
||||
CHGVAR VAR(&ADJ) VALUE('-' *TCAT &THISDAY)
|
||||
/* Last day of last month */
|
||||
DATEADJ INDATE(*SYSTEM) OUTDATE(&EOML) ADJAMT(&ADJ)
|
||||
/* 1st day of this month */
|
||||
DATEADJ INDATE(&EOML) OUTDATE(&WKDATE) ADJAMT(1)
|
||||
/* 1st day of last month */
|
||||
DATEADJ INDATE(&WKDATE) OUTDATE(&BOML) ADJAMT(-1) +
|
||||
ADJTYPE(*MONTHS) INFMT('*SYSTEM')
|
||||
SNDMSG MSG('Last month is' *BCAT &BOML *BCAT +
|
||||
'through' *BCAT &EOML) TOUSR(*REQUESTER)
|
||||
ENDPGM
|
||||
Reference in New Issue
Block a user