source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLRUDT.m@ 1128

Last change on this file since 1128 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1SPNLRUDT ; 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
8TESTMATH ;
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
20DATEMATH(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
63DATEEOM(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")
71DATEFMT(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 "???"
Note: See TracBrowser for help on using the repository browser.