The following is a command file that I have developed over time. I
find it has meet all the needs I have ever had for date processing at
the MPE level (in fact, some programs we have go out to MPE to let
this routine do their date processing.)
It will provide proper date values for any date since the start of the
Gregorian Calender, and properly recognizes the order of leap years
(every four years, except every 100 years, except every 400 years)
NOTE: The number returned representing the Lotus 1-2-3 date is
inaccurate for dates before Mar 1, 1900. This is because Lotus 1-2-3
has a bug - it incorrectly treats 1900 as a leap year.
If called by a session from the MPE prompt, information about the date
specified will be printed to $stdlist and the listed system variables
will be set. In all other cases, the system variables are set, but no
information is printed.
(Sorry about the wrap on some of the longer lines... I don't see a way
to change the margins in Free Agent)
Clive Pottinger
Hamilton Discount Corporation Limited
Stoney Creek, ON
[log in to unmask]
---------------------
parm parm1=*, parm2='*', parm3='*' ;delta=0
comment This comfile will provide information about any given date.
comment Syntax:
comment [[yyyy,] mm, ] dd
comment [[yyyy,] mmm,] dd
comment [[ yy,] mm, ] dd
comment DT [{ [[ yy,] mmm,] dd }] [;DELTA=offset]
comment [yyyy,] ddd
comment [ yy,] ddd
comment jjjjjjjj
comment lllll
comment [-]day
comment
comment where yyyy = year including century
comment default: current year
comment yy = year of the century (note DT uses a
forward/backward
comment cutoff date algorithm based on the year 49)
comment Current Year Specified yy Century assumed is
comment 00 - 49 00 - 49 current century
comment 00 - 49 50 - 99 previous century
comment 50 - 99 00 - 49 next century
comment 50 - 99 50 - 99 current century
comment default: current year
comment mm = month of the year (1-12)
comment default: current month
comment mmm = month of the year (JAN, FEB, MAR...)
comment default: current month
comment dd = day of the month (1-31)
comment default: current day
comment ddd = day of the year (001-366)
comment (must be 3 digits long)
comment jjjjjjj = julian date (Royal Astronomical Society format)
comment (must be 6 or more digits long)
comment lllll = julian date (Lotus 1-2-3, Quattro format)
comment (must be 4-5 digits long)
comment day = day of the week (eg 'SUNDAY', 'THU', 'FRIDAY' -
must
comment be 3 or more character) or 'TODAY'
comment day returns the next date (excluding today) for
the
comment given day.
comment -day returns the last date (including today) for
the
comment given day.
comment offset = a +ve/-ve number of days to add to date specified
by
comment the other parameters
comment
comment The information is returned in the following system variables:
comment dt_jd - julian date (astronomical format)
comment dt_jld - julian date (Lotus 1-2-3, Quattro format)
comment dt_yr - year (including century)
comment dt_moy - month of the year (1-12)
comment dt_fmoy - month of the year (JAN, FEB...)
comment dt_dom - day of the month (1-31)
comment dt_doy - day of the year (1-366)
comment dt_dow - day of the week (1-7, 1=Sun, 2=Mon, etc)
comment dt_fdow - day of the week (SUN, MON...)
comment dt_md - days in the month (1-31)
comment dt_ymd - date in the form YYYYMMDD
comment dt_ly - leap year (TRUE/FALSE)
comment dt_woy - week of year (0-53)
comment dt_error - indicates if date was correctly processed (true,
false)
comment
comment If executed interactively, DT will also display the date
comment information in the form:
comment lotus = julian = metric = imperial = standard (days in month)
comment week of year = week
comment Clive Pottinger (1992)
comment
comment V1.00.00 92/??/?? Original version C.P.
comment V1.04.00 95/08/03 Added alphanumeric day of week C.P.
comment V1.05.00 97/11/24 Added alphanumeric month of year C.P.
comment V1.06.00 98/03/05 Added -day and TODAY C.P.
comment V1.07.00 98/07/09 Added cutoff date for xx year C.P.
setvar dx_sub bound(dx_sub)
setvar dt_yr hpyear
setvar dt_moy '!hpmonth'
setvar dt_dom hpdate + !delta
setvar dx_fmt 'YMD'
if '!parm3' = '*'
if '!parm2' = '*'
setvar dx_dow pos(ups(lft('!parm1 ' - '-',3)) + ' ', &
' SUN MON TUE WED THU FRI SAT ') / 4
if dx_dow > 0
if lft('!parm1', 1) = '-'
setvar dt_dom dt_dom - (!hpday - dx_dow + 7) mod 7
else
setvar dt_dom dt_dom + 7 - (!hpday - dx_dow + 7) mod 7
endif
elseif ups('!parm1' - '-') = 'TODAY'
setvar dt_dom !hpdate
elseif len('!parm1') > 3
if len('!parm1') > 5
setvar dt_jd !parm1 + !delta
else
setvar dt_jd !parm1 + 2415019 + !delta
endif
setvar dx_fmt 'JD'
elseif len('!parm1') = 3
setvar dt_doy !parm1 + !delta
setvar dx_fmt 'YD'
elseif '!parm1' <> '*'
setvar dt_dom !parm1 + !delta
endif
elseif len('!parm2') = 3
setvar dt_yr !parm1
setvar dt_doy !parm2 + !delta
setvar dx_fmt 'YD'
else
setvar dt_moy '!parm1'
setvar dt_dom !parm2 + !delta
endif
else
setvar dt_yr !parm1
setvar dt_moy '!parm2'
setvar dt_dom !parm3 + !delta
endif
if lft(dx_fmt, 1) = 'Y' and dt_yr < 100
setvar dx_yr ![rht(hpdatef, 2)]
setvar dx_yr (dx_yr / 50) - (dt_yr / 50)
setvar dt_yr ![rht(hpdatef, 4)]-hpyear + dt_yr + 100 * dx_yr
endif
if numeric(dt_moy)
setvar dt_moy !dt_moy
else
setvar dt_moy pos(ups(lft('!dt_moy ',3)) + ' ', &
' JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC ')
/ 4
endif
if dx_fmt = 'JD'
setvar dx_x dt_jd - 1721425
setvar dx_x dx_x - ((dx_x+306)/146097)
setvar dx_x dx_x + ((dx_x+305)/36524)
setvar dx_x dx_x - ((dx_x+306)/1461)
setvar dt_yr (dx_x-1)/365 + 1
setvar dx_ld &
1-min(dt_yr mod 4,1)+min(dt_yr mod 100,1)-min(dt_yr mod
400,1)
setvar dx_x (365 * dt_yr - dx_x) * 100 + 50
setvar dx_x dx_x + 200*(dx_x/30650) - dx_ld
setvar dt_moy 12 - (dx_x /3059)
setvar dt_dom (3059*(13-dt_moy) - dx_x)/100 + 1
setvar dt_doy 365+dx_ld - (3059*(13-dt_moy)+50)/100 + dt_dom + &
(2-dx_ld)*((13-dt_moy)/11)
else
setvar dx_ld &
1-min(dt_yr mod 4,1)+min(dt_yr mod 100,1)-min(dt_yr mod
400,1)
if dx_fmt = 'YD'
setvar dx_x 366 + dx_ld - dt_doy
setvar dx_x dx_x + (2-dx_ld)*(dx_x/307)
setvar dt_moy 12 - (dx_x*100-50)/3059
setvar dt_dom ((13-dt_moy)*3059+150)/100 - dx_x
else
setvar dt_doy 365+dx_ld - (3059*(13-dt_moy)+50)/100 + dt_dom + &
(2-dx_ld)*((13-dt_moy)/11)
endif
setvar dt_jd 1721425 + 365*(dt_yr-1) + dt_doy &
+ (dt_yr-1) / 4 &
- (dt_yr-1) / 100 &
+ (dt_yr-1) / 400
endif
setvar dt_jld dt_jd - 2415019
setvar dt_md 30 + (dt_moy + (dt_moy/8)) mod 2 &
- ((1-abs(min((dt_moy-2), 1))) * (2-dx_ld))
setvar dt_dow (dt_jd+1) mod 7 + 1
setvar dt_woy 1 + ((dt_dow-1 - dt_doy) mod 7 + dt_doy) / 7 &
- ((dt_dow - dt_doy) mod 7) / 4
setvar dt_ly dx_ld = 1
if dt_doy < 1 or dt_doy > 365 + dx_ld or &
dt_dom < 1 or dt_dom > dt_md or &
dt_moy < 1 or dt_moy > 12
dt !dt_jd
endif
setvar dt_ymd dt_yr*10000 + dt_moy*100 + dt_dom
setvar dt_fmoy &
str(' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC', dt_moy*3,3)
setvar dt_fdow str(' SUNMONTUEWEDTHUFRISAT', dt_dow*3,3)
if hpusercmdepth < 2 and hpjobtype = 'S' and not dx_sub
echo !dt_jld = !dt_jd = !dt_yr/!dt_moy/!dt_dom =
![rht('00!dt_doy',3)]-&
!dt_yr = !dt_fdow, !dt_fmoy !dt_dom, !dt_yr (!dt_md days in !dt_fmoy)
echo week of year = !dt_woy
endif
if dx_sub
setvar dx_sub false
else
deletevar dx_@ > $null
setvar dt_error false
endif
|
