/* REXX */

/* Date: 08/20/1999
*/
/* Name: DATE
*/
/* Author: Bruce Gillispie - [email protected]
*/
/*
*/
/* Updates: 08/20/1999 - Initial offering
brg */
/*
*/
/* Usage: DATE i
*/
/*
*/
/* i = yyyyddd or yyyy.ddd or yyyy ddd or ddd Julian to USA */
/* or mmddyyyy or mm/dd/yyyy or mm dd yyyy
USA to Julian */
/* or today
Display USA
*/
/* or +n
Add n days to todays date
*/
/* or -n
Subtract n days from todays date
*/
/*
*/
/*---------------------------------------------------------------*/
/* Disclaimer:
*/
/* The "DATE" REXX IS NOT in the Public Domain Freeware Software.*/
/* You may use the "DATE" REXX AT YOUR OWN RISK, it is provided */
/* for your enjoyment and neither the Author or his Employer
*/
/* provides any warranty for its use.
*/
/*---------------------------------------------------------------*/
/* Special thanks to IBM for the "Handling DATES with REXX" URL */
*/
/* located at: http://rexx.hursley.ibm.com/rexx/datec.htm
*/
/*---------------------------------------------------------------*/
/* Developed/Tested using:
*/
/* Regina Rexx Interpreter Version 0.08g Win95/NT and IBM's
*/
/* OS/390 2.4
*/
/*---------------------------------------------------------------*/
'cls'
/* Clear the screen "clear" on some systems */
signal on syntax
arg data
call validate data
call pullnums data
call leap_year_test pnums adj
call classify_error data
exit 00
/* /\/\_00_/\/\ ~~~ /\/\_00_/\/\ ~~~ /\/\_00_/\/\ ~~~ /\/\_00_/\/\ */
validate: procedure expose data n;
if data == 'TODAY' then
do
call default;
exit 01
end ;
if substr(data,1,1) == '+',
| substr(data,1,1) == '-' then
do
n = strip(data,,b);
call c_date_time;
call moving_dates n;
exit 02
end ;
if (datatype(substr(data,1,1)) <> 'NUM',
| strip(data) == '') then
do
'cls'
call default

call default_syntax
exit 03
end ;
return data
pullnums: procedure expose data pnums adj ly;
pnums = ''; ln = length(data);
do i = 1 to ln
do while datatype(substr(data,i,1))='NUM'
pnums=pnums||substr(data,i,1); i=i+1;
end
end i

/* init vars

/* it's a number */
/* concat & ink */

i = length(pnums);
/* - - - - - - - - - - - - - - - - - - - - /* test input for length
/* - - - - - - - - - - - - - - - - - - - - if i > '8' then
do
call classify_error data
exit 04
end
/* - - - - - - - - - - - - - - - - - - - - /* test input for leading zeros
/* - - - - - - - - - - - - - - - - - - - - if strip(pnums,l,0) == '' then
do
call classify_error data
exit 04
end
/* - - - - - - - - - - - - - - - - - - - - /* test input yyyyddd for ddd of zeros
/* - - - - - - - - - - - - - - - - - - - - if (i == '7') & (substr(pnums,5,3) == '000')
do
call classify_error data
exit 04
end
/* - - - - - - - - - - - - - - - - - - - - /* test input for Julian day 366 ddd
/* - - - - - - - - - - - - - - - - - - - - /* ddd not 366
if (i <= '3') & (pnums < '366') then
do
year = substr(date('S'),1,4);
adj = date('S',(year||0101),'S');
call leap_year_test adj
call j_date pnums
end
/* ddd is 366
if (i <= '3') & (pnums == '366') then
do
year = substr(date('S'),1,4);
adj = date('S',(year||0101),'S');
call leap_year_test adj
if result = '0' then call leap_error data
call j_date pnums
end
/* - - - - - - - - - - - - - - - - - - - - -

*/

- - - - - - - */
*/
- - - - - - - */

- - - - - - - */
*/
- - - - - - - */

- - - - - - - */
*/
- - - - - - - */
then

- - - - - - - */
*/
- - - - - - - */
*/

*/

- - - - - - - */

/* test input for Julian day 366 yyyyddd

*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* yyyyddd not 366
*/
if (i <= '7') & (substr(pnums,5,3) < '366') then
do
year = substr(pnums,1,4);
adj = date('S',(year||0101),'S');
call leap_year_test adj
call j_date pnums
end
/* ddd is 366
*/
if (i = '7') & (substr(pnums,5,3) == '366') then
do
year = substr(pnums,1,4);
adj = date('S',(year||0101),'S');
call leap_year_test adj
if result = '0' then call leap_error data
call j_date pnums
end
/* mmddyyyy routine
*/
if (i == '8') then
do
parse var pnums with mm +2 dd +2 yyyy +4;
adj = translate('56781234',pnums,'12345678')
call leap_year_test
if result ='0' & substr(adj,7,2) == '29' then
do
call leap_error
end
call s_date pnums
end
return
/* end of pullnums */
/* Display Current Date - used by Moving Dates */
c_date_time: procedure expose adj
adj = date('S',(date('B')),'B');
call leap_year_test adj
say ''
parse value date('S') with yyyy +4 mm +2 dd +2 ;
say translate('56/78/1234',date('S'),'12345678')'.'||,
right(date('D',(date('B')),'B'),3,0)' '||,
left(date('W',(date('B')),'B'),10)' '||,
left('Current Date',24)ly;
return
/* plus or minus x from current date
*/
moving_dates: procedure expose n adj
parse value n with x +1 y ;
if x == '+' then
adj = date('S',(date('B')+y),'B');
else
adj = date('S',(date('B')-y),'B');
call leap_year_test adj
if x == '+' then
say translate('56/78/1234',adj,'12345678')'.'||,
right(date('D',(date('B')+y),'B'),3,0)' '||,
left(date('W',(date('B')+y),'B'),10)' '||,
left('Adjusted:',10)n left('days',8)ly;
else
say translate('56/78/1234',adj,'12345678')'.'||,

right(date('D',(date('B')-y),'B'),3,0)' '||,
left(date('W',(date('B')-y),'B'),10)' '||,
left('Adjusted:',10)n left('days',8)ly;
say ''
return
/* process mmddyyyy formats
*/
s_date: procedure expose adj ly
say ''
say translate('56/78/1234',adj,'12345678')'.'||,
right(date('D',adj,'S'),3,0)' '||,
left(date('W',adj,'S'),10)' '||,
left(ly,11)' '||,
'Time is 'time('C') '('time('N')')';
exit 00
return
/* process ddd & yyyyddd formats
*/
j_date: procedure expose pnums ly
select
when length(pnums) <= '3' then
do
base_day = date('B',strip(pnums,l,0),'D');
say translate('56/78/1234',date('S',base_day,'B'),'12345678')'.'||,
right(date('D',base_day,'B'),3,0)' '||,
left(date('W',base_day,'B'),10)' '||,
left(ly,11)' '||,
'Time is 'time('C') '('time('N')')';
exit 00
end /* end do */
when length(pnums) <= '7' then
do
parse value pnums with yyyy +4 ddd
user_year = yyyy||0101;
base_day = date('B',user_year,'S');
base_day = base_day + ddd -1;
say translate('56/78/1234',date('S',base_day,'B'),'12345678')'.'||,
right(date('D',base_day,'B'),3,0)' '||,
left(date('W',base_day,'B'),10)' '||,
left(ly,11)' '||,
'Time is 'time('C') '('time('N')')';
exit 00
end /* end do */
otherwise nop;
end /* end select */
return
/* Leap Year test routine
*/
leap_year_test: procedure expose pnums adj ly
signal on syntax
testit = date(, substr(adj,1,4)'0229','S')
ly = 'Leap Year'
return '1' ly
/* valid date = leap year */
syntax:
ly = ''
return '0' ly /* invalid date = no leap year */
/* Default date & time routine
default: procedure expose data
error:

*/

say ''
parse value date('S') with yyyy +4 mm +2 dd +2 ;
say translate('56/78/1234',date('S'),'12345678')'.'||,
right(date('D',(date('B')),'B'),3,0)' '||,
left(date('W',(date('B')),'B'),10)' '||,
left(' ',12)||,
'Time is 'time('C') '('time('N')')';
return
/* Default Syntax routine
*/
default_syntax:
say '
'
say '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
say '
'
say 'DATEX is a general purpose DATE conversion utility.
'
say '
'
say 'Usage: DATEX i
'
say '
'
say ' i = yyyyddd or yyyy.ddd or yyyy ddd or ddd
Julian to USA '
say ' or mmddyyyy or mm/dd/yyyy or mm dd yyyy
USA to Julian '
say ' or today
Display USA '
say '
'
say ' or +n Add n days to todays date
'
say ' or -n Subtract n days from todays date
'
say '
'
say '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
say '
default display '
return
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* multi-use error routine - note placement of labels:
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
leap_error:
data ='"'||data||'" - not a Leap Year.';
classify_error:
'cls'
say ' '
say ' Invalid input, you entered:' data
call default_syntax
exit 99
return 99
/* end of exec */