source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIDTC.m@ 1361

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1DIDTC ;SFISC/XAK-DATE/TIME OPERATIONS ;11:49 AM 2 Dec 2002
2 ;;22.0;VA FileMan;**14,36,71,117**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4D I 'X1!'X2 S X="",%Y=0 Q
5 S X=X1 D H S X1=%H,X=X2,X2=%Y+1 D H S X=X1-%H,%Y=%Y+1&X2
6 K %H,X1,X2 Q
7 ;
8C S X=X1,X2=+$G(X2) I 'X S (X,%H)="" Q
9 D H S %H=%H+X2 D YMD S:$P(X1,".",2) X=X_"."_$P(X1,".",2) K X1,X2 Q
10S S %=%#60/100+(%#3600\60)/100+(%\3600)/100 Q
11 ;
12H I X<1410000 S (%H,%T)=0,%Y=-1 Q
13 S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7)
14 S %T=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14)
15TOH N DILEAP D
16 . N Y S Y=%Y+1700 S:%M<3 Y=Y-1
17 . S DILEAP=(Y\4)-(Y\100)+(Y\400)-446 Q
18 S %H=$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
19 S %=('%M!'%D),%Y=%Y-141
20 S %H=(%H+(%Y*365)+DILEAP+%),%Y=$S(%:-1,1:%H+4#7)
21 K %M,%D,% Q
22 ;
23DOW D H S Y=%Y K %H,%Y Q
24DW D H S Y=%Y,X=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",Y+1)_"DAY"
25 S:Y<0 X="" Q
267 I '%H S (%,X)="" Q
27 S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1
28 S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
29 S X=%Y_"00"+%M_"00"+%D Q
30 ;
31YX D YMD S Y=X_% Q:Y="" G DD^%DT
32YMD I %H[",0" S %=%H N %H S %H=%-1_",86400"
33 D 7 S %=$P(%H,",",2) D S K %D,%M,%Y Q
34T F %=1:1 S Y=$E(X,%) Q:"+-"[Y G 1^%DT:$E("TODAY",%)'=Y
35 S X=$E(X,%+1,99) G PM:Y=""
36 I X?1.N1"M" S %H=$H D MONTH G D^%DT
37 I +X'=X D DMW S X=%
38 G:'X 1^%DT
39PM S @("%H=$H"_Y_X) D TT G 1^%DT:%I(3)'?3N,D^%DT
40N F %=2:1 S Y=$E(X,%) Q:"+-"[Y G 1^%DT:$E("NOW",%)'=Y
41 I Y="" S %H=$H D %H G RT
42 S X=$E(X,%+1,99)
43 I X?1.N1"H" S X=X*3600,%H=$H,@("X=$P(%H,"","",2)"_Y_X),%=$S(X<0:-1,1:0)+(X\86400),X=X#86400,%H=$P(%H,",")+%_","_X G RT
44 I X?1.N1"'" S X=X*60,%H=$H,@("X=$P(%H,"","",2)"_Y_X),%=$S(X<0:-1,1:0)+(X\86400),X=X#86400,%H=$P(%H,",")+%_","_X G RT
45 I X?1.N1"M" S %H=$H D %H,MONTH G RT1
46 D DMW G 1^%DT:'% S @("%H=$H"_Y_%),%H=%H_","_$P($H,",",2) D %H
47RT D TT
48RT1 S %=$P(%H,",",2) D S S %=X_$S(%:%,1:.24) I %DT'["S" S %=+$E(%,1,12)
49 Q:'$D(%(0)) S Y=% G E^%DT
50PF S %H=$H D YMD S %(9)=X,X=%DT["F"*2-1 I @("%I(1)*100+%I(2)"_$E("> <",X+2)_"$E(%(9),4,7)") S %I(3)=%I(3)+X
51 Q
52MONTH ;Add months to current date
53 S Y=Y_+X
54 D TT
55 S %=%I(1)+Y,%I(1)=%-1#12+1,%I(3)=%I(3)+(%-$S(%>0:1,1:12)\12)
56 S %="31^"_($$LEAP(%I(3))+28)_"^31^30^31^30^31^31^30^31^30^31"
57 I %I(2)>$P(%,U,%I(1)) S %I(2)=$P(%,U,%I(1))
58 S X=%I(3)_"00"+%I(1)_"00"+%I(2)
59 Q
60LEAP(X) ;Return 1 if leap year
61 S:X<1700 X=X+1700
62 Q '(X#4)&(X#100)!'(X#400)
63TT D 7 S %I(1)=%M,%I(2)=%D,%I(3)=%Y K %M,%D,%Y Q
64NOW S %H=$H,%H=$S($P(%H,",",2):%H,1:%H-1)
65 D TT S %=$P(%H,",",2) D S S %=X_$S(%:%,1:.24) Q
66DMW S %=$S(X?1.N1"D":+X,X?1.N1"W":X*7,X?1.N1"M":X*30,+X=X:X,1:0)
67 Q
68%H I '$P(%H,",",2) S %H=%H-1 Q
69 I $P(%H,",",2)<60&(%DT'["S") S $P(%H,",",2)=60
70 Q
71COMMA ;
72 S %D=X<0 S:%D X=-X S %=$S($D(X2):+X2,1:2),X=$J(X,1,%),%=$L(X)-3-$E(23456789,%),%L=$S($D(X3):X3,1:12)
73 F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99)
74 S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",%D)_X_$E(" )",%D+1),%L) K %,%D,%L
75 Q
76HELP S DDH=$S($D(DDH):DDH,1:0),A1="Examples of Valid Dates:" D %
77 I %DT["M" D G 0
78 . S A1=" "_$S(%DT["I":1.1957,1:"JAN 1957 or JAN 57")_$S(%DT'["N":" or 0157",1:"") D %
79 . S A1=" T (for this month)" D %
80 . S A1=" T+3M (for 3 months in the future)" D %
81 . S A1=" T-3M (for 3 months ago)" D %
82 . S A1="Only month and year are accepted. You must omit the precise day." D %
83 S A1=" "_$S(%DT["I":"20.1.1957",1:"JAN 20 1957 or 20 JAN 57")_" or "_$S(%DT["I":"20/1",1:"1/20")_"/57"_$S(%DT'["N":" or "_$S(%DT["I":200157,1:"012057"),1:"") D %
84 S A1=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc." D %
85 S A1=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc." D %
86 S A1="If the year is omitted, the computer " D D %
87 . I %DT["P" S A1=A1_"assumes a date in the PAST." Q
88 . I %DT["F" S A1=A1_"assumes a date in the FUTURE." Q
89 . S A1=A1_"uses CURRENT YEAR. Two digit year" D %
90 . S A1=" assumes no more than 20 years in the future, or 80 years in the past."
91 . Q
92 I %DT'["X" S A1="You may omit the precise day, as: "_$S(%DT["I":1,1:"JAN,")_" 1957" D %
93 I %DT'["T",%DT'["R" G 0
94 S A1="If only the time is entered, the current date is assumed." D %
95 S A1="Follow the date with a time, such as "_$S(%DT["I":"20.1",1:"JAN 20")_"@10, T@10AM, 10:30, etc." D %
96 S A1="You may enter a time, such as NOON, MIDNIGHT or NOW." D %
97 S A1="You may enter NOW+3' (for current date and time Plus 3 minutes" D %
98 S A1=" *Note--the Apostrophe following the number of minutes)" D %
99 I %DT["S" S A1="Seconds may be entered as 10:30:30 or 103030AM." D %
100 I %DT["R" S A1="Time is REQUIRED in this response." D %
1010 Q:'$D(%DT(0))
102 S A1=" " D % S A1="Enter a date which is "_$S(%DT(0)["-":"less",1:"greater")_" than or equal to " D %
103 S Y=$S(%DT(0)["-":$P(%DT(0),"-",2),1:%DT(0)) D DD^%DT:Y'["NOW"
104 I '$D(DDS) W Y,"." K A1 Q
105 S DDH(DDH,"T")=DDH(DDH,"T")_Y_"." K A1 Q
106 ;
107% I '$D(DDS) W !," ",A1 Q
108 S DDH=DDH+1,DDH(DDH,"T")=" "_A1 Q
109 Q
Note: See TracBrowser for help on using the repository browser.