DIDTC ;SFISC/XAK-DATE/TIME OPERATIONS ;3JAN2011
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
D N %T
I 'X1!'X2 S X="",%Y=0 Q
S X=X1 D H S X1=%H,X=X2,X2=%Y+1 D H S X=X1-%H,%Y=%Y+1&X2
K %H,X1,X2 Q
;
C N %,%T,%Y
S X=X1,X2=$J($G(X2),0,0) I 'X S (X,%H)="" Q
D H S %H=%H+X2 D YMD S:$P(X1,".",2) X=X_"."_$P(X1,".",2) K X1,X2 Q
S S %=%#60/100+(%#3600\60)/100+(%\3600)/100 Q
;
H ;called from DIG, DIP4
I X<1410000 S (%H,%T)=0,%Y=-1 Q
S %Y=$E(X,1,3),%M=$E(X,4,5),%D=$E(X,6,7)
S %T=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14)
TOH N DILEAP D
. N Y S Y=%Y+1700 S:%M<3 Y=Y-1
. S DILEAP=(Y\4)-(Y\100)+(Y\400)-446 Q
S %H=$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
S %=('%M!'%D),%Y=%Y-141
S %H=(%H+(%Y*365)+DILEAP+%),%Y=$S(%:-1,1:%H+4#7)
K %M,%D,% Q
;
DOW D H S Y=%Y K %H,%Y Q
;
DW D H S Y=%Y,X=$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",Y+1)_"DAY"
S:Y<0 X="" Q
;
7 I '%H S (%,X)="" Q
S %=(%H>21608)+(%H>94657)+%H-.1,%Y=%\365.25+141,%=%#365.25\1
S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
S X=%Y_"00"+%M_"00"+%D Q
;
YX ;called from DIV, etc
D YMD S Y=X_% Q:Y="" G DD^%DT
;
YMD ;called from DIP5. Documented entry point for converting a date/time %H in $H format into a date (in X) and time (in %) in FileMan internal format.
I %H[",0" S %=%H N %H S %H=%-1_",86400"
N %D,%M,%Y D 7 S %=$P(%H,",",2) D S
Q
;
;
T ;from %DT
F %=1:1 S Y=$E(X,%) Q:"+-"[Y G 1^%DT:$E("TODAY",%)'=Y
S X=$E(X,%+1,99) G PM:Y=""
I X?1.N1"M" S %H=$H D MONTH G D^%DT
I +X'=X D DMW S X=%
G:'X 1^%DT
PM S @("%H=$H"_Y_X) D TT G 1^%DT:%I(3)'?3N,D^%DT
;
;
N ;from %DT
F %=2:1 S Y=$E(X,%) Q:"+-"[Y G 1^%DT:$E("NOW",%)'=Y
I Y="" S %H=$H D %H G RT
S X=$E(X,%+1,99)
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
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
I X?1.N1"M" S %H=$H D %H,MONTH G RT1
D DMW G 1^%DT:'% S @("%H=$H"_Y_%),%H=%H_","_$P($H,",",2) D %H
RT D TT
RT1 S %=$P(%H,",",2) D S S %=X_$S(%:%,1:.24) I %DT'["S" S %=+$E(%,1,12)
Q:'$D(%(0)) S Y=% G E^%DT
;
;
PF ;from %DT
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
Q
;
;
MONTH ;Add months to current date
S Y=Y_+X
D TT
S %=%I(1)+Y,%I(1)=%-1#12+1,%I(3)=%I(3)+(%-$S(%>0:1,1:12)\12)
S %="31^"_($$LEAP(%I(3))+28)_"^31^30^31^30^31^31^30^31^30^31"
I %I(2)>$P(%,U,%I(1)) S %I(2)=$P(%,U,%I(1))
S X=%I(3)_"00"+%I(1)_"00"+%I(2)
Q
;
LEAP(X) ;Return 1 if leap year
S:X<1700 X=X+1700
Q '(X#4)&(X#100)!'(X#400)
;
TT N %M,%D,%Y D 7 S %I(1)=%M,%I(2)=%D,%I(3)=%Y
Q
;
NOW S %H=$H,%H=$S($P(%H,",",2):%H,1:%H-1)
D TT S %=$P(%H,",",2) D S S %=X_$S(%:%,1:.24) Q
;
DMW S %=$S(X?1.N1"D":+X,X?1.N1"W":X*7,X?1.N1"M":X*30,+X=X:X,1:0)
Q
;
%H I '$P(%H,",",2) S %H=%H-1 Q
I $P(%H,",",2)<60&(%DT'["S") S $P(%H,",",2)=60
Q
;
COMMA ;
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)
F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99)
S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",%D)_X_$E(" )",%D+1),%L) K %,%D,%L
Q
;
;
;
HELP S DDH=$S($D(DDH):DDH,1:0),A1="Examples of Valid Dates:" D %
I %DT["M" D G 0
. S A1=" "_$S(%DT["I":1.1957,1:"JAN 1957 or JAN 57")_$S(%DT'["N":" or 0157",1:"") D %
. S A1=" T (for this month)" D %
. S A1=" T+3M (for 3 months in the future)" D %
. S A1=" T-3M (for 3 months ago)" D %
. S A1="Only month and year are accepted. You must omit the precise day." D %
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 %
S A1=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc." D %
S A1=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc." D %
S A1="If the year is omitted, the computer " D D %
. I %DT["P" S A1=A1_"assumes a date in the PAST." Q
. I %DT["F" S A1=A1_"assumes a date in the FUTURE." Q
. S A1=A1_"uses CURRENT YEAR. Two digit year" D %
. S A1=" assumes no more than 20 years in the future, or 80 years in the past."
. Q
I %DT'["X" S A1="You may omit the precise day, as: "_$S(%DT["I":1,1:"JAN,")_" 1957" D %
I %DT'["T",%DT'["R" G 0
S A1="If only the time is entered, the current date is assumed." D %
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 %
S A1="You may enter a time, such as NOON, MIDNIGHT or NOW." D %
S A1="You may enter NOW+3' (for current date and time Plus 3 minutes" D %
S A1=" *Note--the Apostrophe following the number of minutes)" D %
I %DT["S" S A1="Seconds may be entered as 10:30:30 or 103030AM." D %
I %DT["R" S A1="Time is REQUIRED in this response." D %
0 Q:'$D(%DT(0))
S A1=" " D % S A1="Enter a date which is "_$S(%DT(0)["-":"less",1:"greater")_" than or equal to " D %
S Y=$S(%DT(0)["-":$P(%DT(0),"-",2),1:%DT(0)) D DD^%DT:Y'["NOW"
I '$D(DDS) W Y,"." K A1 Q
S DDH(DDH,"T")=DDH(DDH,"T")_Y_"." K A1 Q
;
% I '$D(DDS) W !," ",A1 Q
S DDH=DDH+1,DDH(DDH,"T")=" "_A1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIDTC 5502 printed Mar 13, 2025@21:51:38 Page 2
DIDTC ;SFISC/XAK-DATE/TIME OPERATIONS ;3JAN2011
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
D NEW %T
+1 IF 'X1!'X2
SET X=""
SET %Y=0
QUIT
+2 SET X=X1
DO H
SET X1=%H
SET X=X2
SET X2=%Y+1
DO H
SET X=X1-%H
SET %Y=%Y+1&X2
+3 KILL %H,X1,X2
QUIT
+4 ;
C NEW %,%T,%Y
+1 SET X=X1
SET X2=$JUSTIFY($GET(X2),0,0)
IF 'X
SET (X,%H)=""
QUIT
+2 DO H
SET %H=%H+X2
DO YMD
if $PIECE(X1,".",2)
SET X=X_"."_$PIECE(X1,".",2)
KILL X1,X2
QUIT
S SET %=%#60/100+(%#3600\60)/100+(%\3600)/100
QUIT
+1 ;
H ;called from DIG, DIP4
+1 IF X<1410000
SET (%H,%T)=0
SET %Y=-1
QUIT
+2 SET %Y=$EXTRACT(X,1,3)
SET %M=$EXTRACT(X,4,5)
SET %D=$EXTRACT(X,6,7)
+3 SET %T=$EXTRACT(X_0,9,10)*60+$EXTRACT(X_"000",11,12)*60+$EXTRACT(X_"00000",13,14)
TOH NEW DILEAP
Begin DoDot:1
+1 NEW Y
SET Y=%Y+1700
if %M<3
SET Y=Y-1
+2 SET DILEAP=(Y\4)-(Y\100)+(Y\400)-446
QUIT
End DoDot:1
+3 SET %H=$PIECE("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
+4 SET %=('%M!'%D)
SET %Y=%Y-141
+5 SET %H=(%H+(%Y*365)+DILEAP+%)
SET %Y=$SELECT(%:-1,1:%H+4#7)
+6 KILL %M,%D,%
QUIT
+7 ;
DOW DO H
SET Y=%Y
KILL %H,%Y
QUIT
+1 ;
DW DO H
SET Y=%Y
SET X=$PIECE("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",Y+1)_"DAY"
+1 if Y<0
SET X=""
QUIT
+2 ;
7 IF '%H
SET (%,X)=""
QUIT
+1 SET %=(%H>21608)+(%H>94657)+%H-.1
SET %Y=%\365.25+141
SET %=%#365.25\1
+2 SET %D=%+306#(%Y#4=0+365)#153#61#31+1
SET %M=%-%D\29+1
+3 SET X=%Y_"00"+%M_"00"+%D
QUIT
+4 ;
YX ;called from DIV, etc
+1 DO YMD
SET Y=X_%
if Y=""
QUIT
GOTO DD^%DT
+2 ;
YMD ;called from DIP5. Documented entry point for converting a date/time %H in $H format into a date (in X) and time (in %) in FileMan internal format.
+1 IF %H[",0"
SET %=%H
NEW %H
SET %H=%-1_",86400"
+2 NEW %D,%M,%Y
DO 7
SET %=$PIECE(%H,",",2)
DO S
+3 QUIT
+4 ;
+5 ;
T ;from %DT
+1 FOR %=1:1
SET Y=$EXTRACT(X,%)
if "+-"[Y
QUIT
if $EXTRACT("TODAY",%)'=Y
GOTO 1^%DT
+2 SET X=$EXTRACT(X,%+1,99)
if Y=""
GOTO PM
+3 IF X?1.N1"M"
SET %H=$HOROLOG
DO MONTH
GOTO D^%DT
+4 IF +X'=X
DO DMW
SET X=%
+5 if 'X
GOTO 1^%DT
PM SET @("%H=$H"_Y_X)
DO TT
if %I(3)'?3N
GOTO 1^%DT
GOTO D^%DT
+1 ;
+2 ;
N ;from %DT
+1 FOR %=2:1
SET Y=$EXTRACT(X,%)
if "+-"[Y
QUIT
if $EXTRACT("NOW",%)'=Y
GOTO 1^%DT
+2 IF Y=""
SET %H=$HOROLOG
DO %H
GOTO RT
+3 SET X=$EXTRACT(X,%+1,99)
+4 IF X?1.N1"H"
SET X=X*3600
SET %H=$HOROLOG
SET @("X=$P(%H,"","",2)"_Y_X)
SET %=$SELECT(X<0:-1,1:0)+(X\86400)
SET X=X#86400
SET %H=$PIECE(%H,",")+%_","_X
GOTO RT
+5 IF X?1.N1"'"
SET X=X*60
SET %H=$HOROLOG
SET @("X=$P(%H,"","",2)"_Y_X)
SET %=$SELECT(X<0:-1,1:0)+(X\86400)
SET X=X#86400
SET %H=$PIECE(%H,",")+%_","_X
GOTO RT
+6 IF X?1.N1"M"
SET %H=$HOROLOG
DO %H
DO MONTH
GOTO RT1
+7 DO DMW
if '%
GOTO 1^%DT
SET @("%H=$H"_Y_%)
SET %H=%H_","_$PIECE($HOROLOG,",",2)
DO %H
RT DO TT
RT1 SET %=$PIECE(%H,",",2)
DO S
SET %=X_$SELECT(%:%,1:.24)
IF %DT'["S"
SET %=+$EXTRACT(%,1,12)
+1 if '$DATA(%(0))
QUIT
SET Y=%
GOTO E^%DT
+2 ;
+3 ;
PF ;from %DT
+1 SET %H=$HOROLOG
DO YMD
SET %(9)=X
SET X=%DT["F"*2-1
IF @("%I(1)*100+%I(2)"_$EXTRACT("> <",X+2)_"$E(%(9),4,7)")
SET %I(3)=%I(3)+X
+2 QUIT
+3 ;
+4 ;
MONTH ;Add months to current date
+1 SET Y=Y_+X
+2 DO TT
+3 SET %=%I(1)+Y
SET %I(1)=%-1#12+1
SET %I(3)=%I(3)+(%-$SELECT(%>0:1,1:12)\12)
+4 SET %="31^"_($$LEAP(%I(3))+28)_"^31^30^31^30^31^31^30^31^30^31"
+5 IF %I(2)>$PIECE(%,U,%I(1))
SET %I(2)=$PIECE(%,U,%I(1))
+6 SET X=%I(3)_"00"+%I(1)_"00"+%I(2)
+7 QUIT
+8 ;
LEAP(X) ;Return 1 if leap year
+1 if X<1700
SET X=X+1700
+2 QUIT '(X#4)&(X#100)!'(X#400)
+3 ;
TT NEW %M,%D,%Y
DO 7
SET %I(1)=%M
SET %I(2)=%D
SET %I(3)=%Y
+1 QUIT
+2 ;
NOW SET %H=$HOROLOG
SET %H=$SELECT($PIECE(%H,",",2):%H,1:%H-1)
+1 DO TT
SET %=$PIECE(%H,",",2)
DO S
SET %=X_$SELECT(%:%,1:.24)
QUIT
+2 ;
DMW SET %=$SELECT(X?1.N1"D":+X,X?1.N1"W":X*7,X?1.N1"M":X*30,+X=X:X,1:0)
+1 QUIT
+2 ;
%H IF '$PIECE(%H,",",2)
SET %H=%H-1
QUIT
+1 IF $PIECE(%H,",",2)<60&(%DT'["S")
SET $PIECE(%H,",",2)=60
+2 QUIT
+3 ;
COMMA ;
+1 SET %D=X<0
if %D
SET X=-X
SET %=$SELECT($DATA(X2):+X2,1:2)
SET X=$JUSTIFY(X,1,%)
SET %=$LENGTH(X)-3-$EXTRACT(23456789,%)
SET %L=$SELECT($DATA(X3):X3,1:12)
+2 FOR %=%:-3
if $EXTRACT(X,%)=""
QUIT
SET X=$EXTRACT(X,1,%)_","_$EXTRACT(X,%+1,99)
+3 if $DATA(X2)
SET X=$EXTRACT("$",X2["$")_X
SET X=$JUSTIFY($EXTRACT("(",%D)_X_$EXTRACT(" )",%D+1),%L)
KILL %,%D,%L
+4 QUIT
+5 ;
+6 ;
+7 ;
HELP SET DDH=$SELECT($DATA(DDH):DDH,1:0)
SET A1="Examples of Valid Dates:"
DO %
+1 IF %DT["M"
Begin DoDot:1
+2 SET A1=" "_$SELECT(%DT["I":1.1957,1:"JAN 1957 or JAN 57")_$SELECT(%DT'["N":" or 0157",1:"")
DO %
+3 SET A1=" T (for this month)"
DO %
+4 SET A1=" T+3M (for 3 months in the future)"
DO %
+5 SET A1=" T-3M (for 3 months ago)"
DO %
+6 SET A1="Only month and year are accepted. You must omit the precise day."
DO %
End DoDot:1
GOTO 0
+7 SET A1=" "_$SELECT(%DT["I":"20.1.1957",1:"JAN 20 1957 or 20 JAN 57")_" or "_$SELECT(%DT["I":"20/1",1:"1/20")_"/57"_$SELECT(%DT'["N":" or "_$SELECT(%DT["I":200157,1:"012057"),1:"")
DO %
+8 SET A1=" T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc."
DO %
+9 SET A1=" T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc."
DO %
+10 SET A1="If the year is omitted, the computer "
Begin DoDot:1
+11 IF %DT["P"
SET A1=A1_"assumes a date in the PAST."
QUIT
+12 IF %DT["F"
SET A1=A1_"assumes a date in the FUTURE."
QUIT
+13 SET A1=A1_"uses CURRENT YEAR. Two digit year"
DO %
+14 SET A1=" assumes no more than 20 years in the future, or 80 years in the past."
+15 QUIT
End DoDot:1
DO %
+16 IF %DT'["X"
SET A1="You may omit the precise day, as: "_$SELECT(%DT["I":1,1:"JAN,")_" 1957"
DO %
+17 IF %DT'["T"
IF %DT'["R"
GOTO 0
+18 SET A1="If only the time is entered, the current date is assumed."
DO %
+19 SET A1="Follow the date with a time, such as "_$SELECT(%DT["I":"20.1",1:"JAN 20")_"@10, T@10AM, 10:30, etc."
DO %
+20 SET A1="You may enter a time, such as NOON, MIDNIGHT or NOW."
DO %
+21 SET A1="You may enter NOW+3' (for current date and time Plus 3 minutes"
DO %
+22 SET A1=" *Note--the Apostrophe following the number of minutes)"
DO %
+23 IF %DT["S"
SET A1="Seconds may be entered as 10:30:30 or 103030AM."
DO %
+24 IF %DT["R"
SET A1="Time is REQUIRED in this response."
DO %
0 if '$DATA(%DT(0))
QUIT
+1 SET A1=" "
DO %
SET A1="Enter a date which is "_$SELECT(%DT(0)["-":"less",1:"greater")_" than or equal to "
DO %
+2 SET Y=$SELECT(%DT(0)["-":$PIECE(%DT(0),"-",2),1:%DT(0))
if Y'["NOW"
DO DD^%DT
+3 IF '$DATA(DDS)
WRITE Y,"."
KILL A1
QUIT
+4 SET DDH(DDH,"T")=DDH(DDH,"T")_Y_"."
KILL A1
QUIT
+5 ;
% IF '$DATA(DDS)
WRITE !," ",A1
QUIT
+1 SET DDH=DDH+1
SET DDH(DDH,"T")=" "_A1
QUIT
+2 QUIT
