94 lines
3.7 KiB
Mathematica
94 lines
3.7 KiB
Mathematica
SPNLRUDT ; ISC-SF/GMB - SCD DATE UTILITIES; 6 JUL 94 [ 07/12/94 6:54 AM ] ;3/27/98 08:34
|
|
;;2.0;Spinal Cord Dysfunction;**4,5**;01/02/1997
|
|
; This routine contains all the date utilities.
|
|
; TESTMATH routine to test DATEMATH
|
|
; DATEMATH function to increment/decrement any FM date
|
|
; DATEEOM function to return the last date of the month
|
|
; DATEFMT function to format an FM date into a more common form
|
|
TESTMATH ;
|
|
N IDATE,INCR
|
|
W !,"Welcome to the DATEMATH test!"
|
|
W !,"Date must be in FM yyymmdd format."
|
|
W !,"Increment must be a positive or negative number followed by D,W,M, or Y."
|
|
W !,"(Stands for Day, Week, Month, or Year)"
|
|
W !,"For example, 2940331 and 1W equals 2940407. Now you try it...",!
|
|
F D Q:IDATE=""!(INCR="")
|
|
. R !,"Enter date: ",IDATE:DTIME Q:IDATE=""
|
|
. R !,"Enter increment: ",INCR:DTIME Q:INCR=""
|
|
. W !,"Result is: ",$$DATEMATH(IDATE,INCR),!
|
|
Q
|
|
DATEMATH(IDATE,INCR) ;
|
|
; DATEMATH is a function which will add (or subtract) any number of
|
|
; days, weeks, months, or years to (or from) a given date.
|
|
;
|
|
; IDATE The given date (FM yyymmdd format)
|
|
; INCR The increment, a positive or negative number followed by
|
|
; D (day), W (week), M (month), or Y (year).
|
|
;
|
|
; Examples:
|
|
;
|
|
; S NEXTYEAR=$$DATEMATH("2940501","1Y") ... sets NEXTYEAR to "2950501"
|
|
; S YESTRDAY=$$DATEMATH("2940501","-1D")... sets YESTRDAY to "2940430"
|
|
;
|
|
N RESULT,LEN,TYPE,QUAN,X,X1,X2,ZDAY,MONTHS,MONTH,YEAR,YEARS
|
|
S LEN=$L(INCR)
|
|
S TYPE=$E(INCR,LEN)
|
|
S QUAN=$E(INCR,1,LEN-1)
|
|
I TYPE="W" S QUAN=QUAN*7,TYPE="D"
|
|
I TYPE="D" D Q X
|
|
. S X1=IDATE
|
|
. S X2=QUAN
|
|
. D C^%DTC
|
|
I TYPE="M" D
|
|
. S MONTHS=$E(IDATE,4,5)+QUAN
|
|
. S YEARS=MONTHS\12
|
|
. S MONTH=MONTHS#12
|
|
. I MONTHS<1 D
|
|
. . S YEARS=YEARS-1
|
|
. . I MONTH=0 S MONTH=12
|
|
. S YEAR=$E(IDATE,1,3)+YEARS
|
|
. S MONTH=$TR($J(MONTH,2)," ","0")
|
|
. S ZDAY=$E(IDATE,6,7) ; Now make sure month may have 31 days...
|
|
. I ZDAY="31","/04/06/09/11/"["/"_MONTH_"/" S ZDAY="30" ; We'll check Feb later.
|
|
. S RESULT=YEAR_MONTH_ZDAY
|
|
E S RESULT=($E(IDATE,1,3)+QUAN)_$E(IDATE,4,7) ; (TYPE=Y)
|
|
; Now we need to check for Feb 29,30,31. Any year divisible by 4 is a
|
|
I $E(RESULT,4,5)="02",$E(RESULT,6,7)>28 D ;leap year. However, if the
|
|
. S YEAR=$E(RESULT,1,3) ;year is a century year, it
|
|
. I YEAR#4=0 D ;must also be divisible by 400.
|
|
. . I YEAR#100=0 S RESULT=YEAR_"02"_$S((YEAR+100)#400=0:"29",1:"28")
|
|
. . E S RESULT=YEAR_"0229"
|
|
. E S RESULT=YEAR_"0228"
|
|
Q RESULT
|
|
DATEEOM(IDATE) ;
|
|
; Given a FileMan date (yyymmdd), this function returns the
|
|
; end-of-month date for the month of the given date.
|
|
;
|
|
; Example: S EOM=$$DATEEOM("2940411")
|
|
; ...sets EOM to the last date in April: "2940430"
|
|
;
|
|
Q $$DATEMATH($$DATEMATH($E(IDATE,1,5)_"01","1M"),"-1D")
|
|
DATEFMT(IDATE,TYPEFMT,CHAR) ;
|
|
; Given a FileMan date (yyymmdd), and optionally, the type of format
|
|
; desired, and the character to be used, this function returns a
|
|
; formatted date.
|
|
;
|
|
; IDATE the FileMan date to format
|
|
; TYPEFMT 1 = mm/dd/yy (default)
|
|
; 2 = dd/mm/yy
|
|
; 3 = dd mmm yy
|
|
; 4 = mm/dd/yyyy ;**MOD,SD/AB,1/27/98, 4-digit year (YR 2000 Compliancy)
|
|
; CHAR the character to use as the separator (default="/")
|
|
;
|
|
; Example: W !,$$DATEFMT("2940411",1,"/")
|
|
; ... returns 04/11/94
|
|
;
|
|
S:'$D(TYPEFMT) TYPEFMT=1
|
|
S:'$D(CHAR) CHAR="/"
|
|
I TYPEFMT=1 Q $E(IDATE,4,5)_CHAR_$E(IDATE,6,7)_CHAR_$E(IDATE,2,3)
|
|
I TYPEFMT=2 Q $E(IDATE,6,7)_CHAR_$E(IDATE,4,5)_CHAR_$E(IDATE,2,3)
|
|
I TYPEFMT=3 Q +$E(IDATE,6,7)_" "_$P("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec",",",$E(IDATE,4,5))_" "_$E(IDATE,2,3)
|
|
;**MOD,SD/AB,1/27/98, Added TYPEFMT=4 to return 4-digit year
|
|
I TYPEFMT=4 Q $E(IDATE,4,5)_CHAR_$E(IDATE,6,7)_CHAR_(1700+$E(IDATE,1,3))
|
|
Q "???"
|