[628] | 1 | SPNLRUDT ; ISC-SF/GMB - SCD DATE UTILITIES; 6 JUL 94 [ 07/12/94 6:54 AM ] ;3/27/98 08:34
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**4,5**;01/02/1997
|
---|
| 3 | ; This routine contains all the date utilities.
|
---|
| 4 | ; TESTMATH routine to test DATEMATH
|
---|
| 5 | ; DATEMATH function to increment/decrement any FM date
|
---|
| 6 | ; DATEEOM function to return the last date of the month
|
---|
| 7 | ; DATEFMT function to format an FM date into a more common form
|
---|
| 8 | TESTMATH ;
|
---|
| 9 | N IDATE,INCR
|
---|
| 10 | W !,"Welcome to the DATEMATH test!"
|
---|
| 11 | W !,"Date must be in FM yyymmdd format."
|
---|
| 12 | W !,"Increment must be a positive or negative number followed by D,W,M, or Y."
|
---|
| 13 | W !,"(Stands for Day, Week, Month, or Year)"
|
---|
| 14 | W !,"For example, 2940331 and 1W equals 2940407. Now you try it...",!
|
---|
| 15 | F D Q:IDATE=""!(INCR="")
|
---|
| 16 | . R !,"Enter date: ",IDATE:DTIME Q:IDATE=""
|
---|
| 17 | . R !,"Enter increment: ",INCR:DTIME Q:INCR=""
|
---|
| 18 | . W !,"Result is: ",$$DATEMATH(IDATE,INCR),!
|
---|
| 19 | Q
|
---|
| 20 | DATEMATH(IDATE,INCR) ;
|
---|
| 21 | ; DATEMATH is a function which will add (or subtract) any number of
|
---|
| 22 | ; days, weeks, months, or years to (or from) a given date.
|
---|
| 23 | ;
|
---|
| 24 | ; IDATE The given date (FM yyymmdd format)
|
---|
| 25 | ; INCR The increment, a positive or negative number followed by
|
---|
| 26 | ; D (day), W (week), M (month), or Y (year).
|
---|
| 27 | ;
|
---|
| 28 | ; Examples:
|
---|
| 29 | ;
|
---|
| 30 | ; S NEXTYEAR=$$DATEMATH("2940501","1Y") ... sets NEXTYEAR to "2950501"
|
---|
| 31 | ; S YESTRDAY=$$DATEMATH("2940501","-1D")... sets YESTRDAY to "2940430"
|
---|
| 32 | ;
|
---|
| 33 | N RESULT,LEN,TYPE,QUAN,X,X1,X2,ZDAY,MONTHS,MONTH,YEAR,YEARS
|
---|
| 34 | S LEN=$L(INCR)
|
---|
| 35 | S TYPE=$E(INCR,LEN)
|
---|
| 36 | S QUAN=$E(INCR,1,LEN-1)
|
---|
| 37 | I TYPE="W" S QUAN=QUAN*7,TYPE="D"
|
---|
| 38 | I TYPE="D" D Q X
|
---|
| 39 | . S X1=IDATE
|
---|
| 40 | . S X2=QUAN
|
---|
| 41 | . D C^%DTC
|
---|
| 42 | I TYPE="M" D
|
---|
| 43 | . S MONTHS=$E(IDATE,4,5)+QUAN
|
---|
| 44 | . S YEARS=MONTHS\12
|
---|
| 45 | . S MONTH=MONTHS#12
|
---|
| 46 | . I MONTHS<1 D
|
---|
| 47 | . . S YEARS=YEARS-1
|
---|
| 48 | . . I MONTH=0 S MONTH=12
|
---|
| 49 | . S YEAR=$E(IDATE,1,3)+YEARS
|
---|
| 50 | . S MONTH=$TR($J(MONTH,2)," ","0")
|
---|
| 51 | . S ZDAY=$E(IDATE,6,7) ; Now make sure month may have 31 days...
|
---|
| 52 | . I ZDAY="31","/04/06/09/11/"["/"_MONTH_"/" S ZDAY="30" ; We'll check Feb later.
|
---|
| 53 | . S RESULT=YEAR_MONTH_ZDAY
|
---|
| 54 | E S RESULT=($E(IDATE,1,3)+QUAN)_$E(IDATE,4,7) ; (TYPE=Y)
|
---|
| 55 | ; Now we need to check for Feb 29,30,31. Any year divisible by 4 is a
|
---|
| 56 | I $E(RESULT,4,5)="02",$E(RESULT,6,7)>28 D ;leap year. However, if the
|
---|
| 57 | . S YEAR=$E(RESULT,1,3) ;year is a century year, it
|
---|
| 58 | . I YEAR#4=0 D ;must also be divisible by 400.
|
---|
| 59 | . . I YEAR#100=0 S RESULT=YEAR_"02"_$S((YEAR+100)#400=0:"29",1:"28")
|
---|
| 60 | . . E S RESULT=YEAR_"0229"
|
---|
| 61 | . E S RESULT=YEAR_"0228"
|
---|
| 62 | Q RESULT
|
---|
| 63 | DATEEOM(IDATE) ;
|
---|
| 64 | ; Given a FileMan date (yyymmdd), this function returns the
|
---|
| 65 | ; end-of-month date for the month of the given date.
|
---|
| 66 | ;
|
---|
| 67 | ; Example: S EOM=$$DATEEOM("2940411")
|
---|
| 68 | ; ...sets EOM to the last date in April: "2940430"
|
---|
| 69 | ;
|
---|
| 70 | Q $$DATEMATH($$DATEMATH($E(IDATE,1,5)_"01","1M"),"-1D")
|
---|
| 71 | DATEFMT(IDATE,TYPEFMT,CHAR) ;
|
---|
| 72 | ; Given a FileMan date (yyymmdd), and optionally, the type of format
|
---|
| 73 | ; desired, and the character to be used, this function returns a
|
---|
| 74 | ; formatted date.
|
---|
| 75 | ;
|
---|
| 76 | ; IDATE the FileMan date to format
|
---|
| 77 | ; TYPEFMT 1 = mm/dd/yy (default)
|
---|
| 78 | ; 2 = dd/mm/yy
|
---|
| 79 | ; 3 = dd mmm yy
|
---|
| 80 | ; 4 = mm/dd/yyyy ;**MOD,SD/AB,1/27/98, 4-digit year (YR 2000 Compliancy)
|
---|
| 81 | ; CHAR the character to use as the separator (default="/")
|
---|
| 82 | ;
|
---|
| 83 | ; Example: W !,$$DATEFMT("2940411",1,"/")
|
---|
| 84 | ; ... returns 04/11/94
|
---|
| 85 | ;
|
---|
| 86 | S:'$D(TYPEFMT) TYPEFMT=1
|
---|
| 87 | S:'$D(CHAR) CHAR="/"
|
---|
| 88 | I TYPEFMT=1 Q $E(IDATE,4,5)_CHAR_$E(IDATE,6,7)_CHAR_$E(IDATE,2,3)
|
---|
| 89 | I TYPEFMT=2 Q $E(IDATE,6,7)_CHAR_$E(IDATE,4,5)_CHAR_$E(IDATE,2,3)
|
---|
| 90 | 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)
|
---|
| 91 | ;**MOD,SD/AB,1/27/98, Added TYPEFMT=4 to return 4-digit year
|
---|
| 92 | I TYPEFMT=4 Q $E(IDATE,4,5)_CHAR_$E(IDATE,6,7)_CHAR_(1700+$E(IDATE,1,3))
|
---|
| 93 | Q "???"
|
---|