%ZTFDT ; jch,EdM ; 10 Dec 97 12:26;Function Library, Date and Time functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;CHCS TLS_4603; GEN 1; 21-MAY-1999
;COPYRIGHT 1997 SAIC
N %,N,R,L,T W !,"Available functions in library ^"_$T(+0)
S N=0 F %=2:1 S R=$T(+%) Q:R="" D
.S L=$P(R," "),T=$E(R,$F(R," "),999)
.I $L(L),$E(T)=";" W !!,$P(L,"(")_" ("_$P(L,"(",2,99) S N=1
.I N,$E(T)=";" W !," "_T Q
.S N=0
Q
ADDT(D,D0,H,M,S) ;Add days, Hours, Minutes, Seconds to Date D
N T S D=$$CDATF2H(D,0,0,0,0,.T),T=$G(H)*60+$G(M)*60+$G(S)+T
I T<0 S D=D+(T+1\86400)-1,T=T#86400 ; *21508
S D=T\86400+D+D0,T=T#86400 Q $$CDATH2F(D_","_T)
ADDM(D,M) ;Add months to Date D
N I,X,Y
I 'M Q D
I M<0 S X=D F I=1:1:-M S X=X-100 S:$E(X,4,5)="00" X=X-8800
I M>0 S X=D F I=1:1:M S X=X+100 S:$E(X,4,5)="13" X=X+8800
S I=$P("31 28 31 30 31 30 31 31 30 31 30 31"," ",$E(X,4,5))
I I=28 S Y=X\10000+1700 S:'(Y#4) I=29 S:'(I#100) I=28 S:'(I#400) I=29
S:$E(X,6,7)>I X=X-$E(X,6,7)+I Q X
CDATA2F(D,F) ;Convert ASCII date to fileman format
;D = date in almost any format (JULY 20, 1969; 20JUL69; 7/20/69; 20-JUL-1969; 20JUL; etc.)
;F = Flags as follows:
; F["T" Time value may be included
; F["R" Time value is Required
; F["R" Imprecise dates allowed
N %,%0,%1,%2,%3,T S F=$G(F),T=F["T"!(F["R")
S D=$$UPCASE^%ZTF(D),%=$P(D,"@"),%0=$P(D,"@",2),%2=0 S:%="" %="T"
I T,%[":"!(%?2.4N)!(%?1.2N.1" "1.2A) S %0=%,%="T" ;Time only was passed
I %?1.U1P1.N.1U F %1=2:1:$L(%) I $E(%,%1)?1P,"+-"[$E(%,%1) S %2=$E(%,%1+1,99),%=$E(%,1,%1-1),%3=$E(%2,$L(%2)),%2=$E(D,%1)_$S(%3="W":%2*7,%3="M":%2*30,%3="H":"."_+%2,1:+%2) Q
I %?1.U D S:$$ABS^%ZTF(%2)'<1 %=%+%2_","_$P(%,",",2) S %=$$CDATH2F(%) S:%2?.1P1"."1.N %=$$ADDT(%,0,$TR(%2,".")) Q:'$L(%0) %
.I $P("NOW",%)="" S %=$H Q
.I $P("TODAY",%)="" S %=+$H Q
.I $P("NOON",%)="" S %=+$H_",43200" Q ;note that N and NO mean NOW
.I $P("MIDNIGHT",%)="" S %=+$H Q
E N %5 S %3=$S($E(%)?1N:"1N",1:"1A"),%5=0,%1=0 D
.I %?6N S %(1)=$E(%,1,2),%(2)=$E(%,3,4),%(3)=$E(%,5,6)
.E F %2=1:1 I $E(%,%2)'?@%3 S %1=%1+1,%(%1)=$E(%,1,%2-1) S:%3="1A" %5=%1 Q:%2>$L(%) F %2=%2:1 I $E(%,%2)'?1P S %=$E(%,%2,99),%2=0,%3=$S($E(%)?1N:"1N",1:"1A") Q
.I %5 S:%5=2 %5=%(1),%(1)=%(2),%(2)=%5 S %(1)=$F("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",$E(%(1),1,3)),%(1)=$S(%(1)-1#3:0,1:%(1)\3) I '%(1) S %=0 Q
.I %(1)>12 S %=0 Q
.I F["I",%1<3,%(%1)>31 S %2=$S(%(%1)?2N:200,1:-1700),%=%(%1)+%2*100+$S(%1=2:%(1),1:0)_"00" Q
.S:%1=2 %(3)=$H+.9\365.25+1841,%1=%1+1 I %1'=3 S %=0 Q
.S:%(3)?2N %(3)=$S($H<58074:19,1:20)_%(3) S %1=%(1)*2,%=$S(%(2)>$E(" 31"_(%(3)#4=0+28)_"31303130313130313031",%1,%1+1):0,1:%(3)-1700*100+%(1)*100+%(2)) Q
Q:%'?7N "" I '$L(%0) Q $S(F'["R":%,1:"")
Q:'T "" S %3=$S(%0["A":1,%0["P":2,1:0) Q:%0?5N&'$E(%0) "" Q:%0?3N&(%0<100) ""
S:%0?3N&$E(%0) %0=0_%0 I %0[":" S %1=$P(%0,":",2),%2=$P(%0,":",3),%0=$P(%0,":")
E S %3=$S($L(%0)>1:-1,1:0),%1=$E(%0,3,4),%2=$E(%0,5,6),%0=$E(%0,1,2)
Q:'%0&'%1&'%2 "" Q:%0>24!(%1>59)!(%2>59) "" Q:%0>23&((%1>0)!(%2>0)) "" S:%1<10&(%1'?1"0"1N) %1=0_%1 S:%2<10&(%2'?1"0"1N) %2=0_%2
S %0=$S(%3=1:%0#12,%3=2&(%0<13):%0+12,%0<6&'%3:%0+12,1:%0)
S %0=$S(%0<24:%0#24,1:%0) S:%0<10 %0=0_%0 Q +(%_"."_%0_%1_%2)
CDATASC(D,DF,TF) ;Convert internal date value to ASCII
;D = date in $H or Fileman format. D?7N.E assumes Fileman format.
;DF = 1 dd Mon YYYY dd padded with a zero (default format)
; 2 nn/nn/nn date and month are zero padded
; 3 Month day, year
; 4 Day, dd Mon yyyy hh:mm:ss Arpa RFC822 format
;TF = 1 @hhmm If TF not present, no time in output
; 2 @hh:mm:ss
; 3 hh:mm:ss leading space instead of @
N %,%0,%1,W S DF=$G(DF),TF=$G(TF) S:DF<1!(DF>4) DF=1 S:TF<1!(TF>3) TF=0
I D'?7N,D'?7N1"."1.6N S D=$$CDATH2F(D,.W) ;$H date to Fileman date
Q:'D "" S %=$E(D,1,3)+1700,%0=$E(D,4,5),%1=$E(D,6,7) D S %0=""
.S:'(%0&%1) DF=9 G CDA2:DF=2,CDA3:DF=3,CDA4:DF=4,CDA9:DF=9
CDA1 .S %1=%1_" "
CDA1A .S %0=%0*3,%=%1_$E("JanFebMarAprMayJunJulAugSepOctNovDec",%0-2,%0)_" "_% Q
CDA2 .S %=%0_"/"_%1_"/"_$E(%,3,4) Q
CDA3 .S %=$P("January,February,March,April,May,June,July,August,September,October,November,December",",",%0)_" "_(+%1)_", "_% Q
CDA4 .S:'$D(W) TF=$$CDATF2H(D,.W) S W=W*3+1,%1=$E("SatSunMonTueWedThuFri",W,W+2)_", "_%1_" ",TF=3 G CDA1A
CDA9 .Q:'%0 S %1="" G CDA1A
I TF S %1=$E($P(D,".",2)_"000000",1,$S(TF=1:4,1:6)),%0=$S(TF=3:" ",1:"@")_$S(TF=1:%1,1:$E(%1,1,2)_":"_$E(%1,3,4)_":"_$E(%1,5,6))
Q %_%0
CDATF2H(F,W,Y,M,D,T) ;Convert Fileman date to $H format
;If passed by reference, variables returned:
; W = Weekday (Sat=0, Sun=1, ... Fri=6), Y = Year (4 digits), M = Month (1-12), D = Day (1-31), T = 2nd piece of $H result (Time portion)
N %,H S Y=$E(F,1,3)+1700,M=$E(F,4,5),D=$E(F,6,7),T=""
I $L(F)>8 S F=$P(F,".",2)_"000",T=$E(F,1,2)*60+$E(F,3,4)*60+$E(F,5,6)
S:'M M=1 S:'D D=1 ;Imprecise dates (no day/month) convert to the 1st
S H=M>2&'(Y#4)+$P("^31^59^90^120^151^181^212^243^273^304^334","^",M)+D-(M>2&'(Y#100))+(M>2&'(Y#400)),%=Y-1841,H=H+(%*365)+(%\4)-(%>59)
S %=$E(F+.000000001#1,2,7),%=$E(%,1,2)*3600+($E(%,3,4)*60)+$E(%,5,6),W=H+5#7 Q H_$S(T]"":","_T,1:"")
CDATH2F(H,W,Y,M,D) ;Convert date in $H format to Fileman format
;If passed by reference, variables returned:
; W = Weekday (Sat=0, Sun=1, ... Fri=6), Y = Year (4 digits), M = Month (1-12), D = Day (1-31)
Q:'H "" N T S T=$P(H,",",2),M=H>21608+(H>94657)+H-.1,Y=M\365.25+1841,M=M#365.25\1,D=M+306#(Y#4=0+365)#153#61#31+1,M=M-D\29+1,W=H+5#7
I $L(T) S T="."_$TR($J(T\3600,2)_$J(T#3600\60,2)_$J(T#60,2)," ",0)
Q Y-1700*10000+(M*100)+D+T
DT() ;Return the current date in Fileman format
Q $$CDATH2F(+$H)
DTC(D1,D2) ;Compare two dates and return the number of days between them
Q $S(D1?7N.E:$$CDATF2H(D1),1:D1)-$S(D2?7N.E:$$CDATF2H(D2),1:D2)
NOW() ;Return the current date and time in Fileman format
Q $$CDATH2F($H)
DATEOUT(DT,F) ;Return date as specified in SSPM
; DT is a date (in FileMan or $H format) to be translated to
; F format. If DT is an invalid date then a -1 is returned.
; 1 "02 Aug 1987"
; 2 "02 Aug 1987@1300"
; 3 "02 Aug 87"
; 4 "02Aug"
; 5 "02Aug@1300"
; 6 "02Aug87"
; 7 "02Aug87@1300"
; 8 "02 August 1987 @ 1300"
; 9 "02 August 1987 1300"
; 10 "02 Aug 87 @ 1300"
;
N FF,T,TM,X,Y,%DT
I (DT'?1.N)&(DT'?7N1"."1.6N)&(DT'?1.6N1","1.N)!(DT<1) Q -1
I DT?1.N1","1.N!($L(DT)<7) S DT=$$CDATH2F(DT) ;Convert DT to FileMan format
S X=DT\1 D ^%DT I Y=-1 Q -1 ;Checks for invalid date
S T=$$CDATASC(DT,1,1)
I '$E(X,4,5)!'$E(X,6,7) S T=$P(T,"@") ;Remove time if month or day is 00
S TM=$P(T,"@",2) I TM>2399!(TM#100>59) Q -1 ;Checks for invalid time
;
; Formats the output in T
S FF=" "_F_" "
S Y=$S($P(T," ",2)="":T,+T:$E(T,8,11),1:$E(T,5,8)) ;*S21525
S:" 3 6 7 10 "[FF Y=$E(Y,3,4) S:" 4 5 "[FF Y=""
S T=$S($P(T," ",2)="":Y,+T:$E(T,1,7)_Y_$E(T,12,$L(T)),1:$E(T,1,4)_Y_$E(T,9,$L(T))) ;*S21525
S:" 1 3 4 6 "[FF T=$P(T,"@") S:" 4 5 6 7 "[FF T=$TR(T," ")
S:" 8 10 "[FF&(T["@") T=$P(T,"@")_" @ "_TM
S:" 9 "[FF&(T["@") T=$P(T,"@")_" "_TM
I " 8 9 "[FF D
.S X=1 I $P(T," ")'?3A S X=2 I $P(T," ",2)'?3A Q
.S $P(T," ",X)=$P("January,February,March,April,May,June,July,August,September,October,November,December",",",$E(DT,4,5))
Q T
;
ERRNL Q "" ;RETURN NULL STRING ON ERROR
ERR0 Q 0 ;RETURN 0 ON ERROR
%ZTFDT ; jch,EdM ; 10 Dec 97 12:26;Function Library, Date and Time functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;CHCS TLS_4603; GEN 1; 21-MAY-1999
+3 ;COPYRIGHT 1997 SAIC
+4 NEW %,N,R,L,T
WRITE !,"Available functions in library ^"_$TEXT(+0)
+5 SET N=0
FOR %=2:1
SET R=$TEXT(+%)
IF R=""
QUIT
Begin DoDot:1
+6 SET L=$PIECE(R," ")
SET T=$EXTRACT(R,$FIND(R," "),999)
+7 IF $LENGTH(L)
IF $EXTRACT(T)=";"
WRITE !!,$PIECE(L,"(")_" ("_$PIECE(L,"(",2,99)
SET N=1
+8 IF N
IF $EXTRACT(T)=";"
WRITE !," "_T
QUIT
+9 SET N=0
End DoDot:1
+10 QUIT
ADDT(D,D0,H,M,S) ;Add days, Hours, Minutes, Seconds to Date D
+1 NEW T
SET D=$$CDATF2H(D,0,0,0,0,.T)
SET T=$GET(H)*60+$GET(M)*60+$GET(S)+T
+2 ; *21508
IF T<0
SET D=D+(T+1\86400)-1
SET T=T#86400
+3 SET D=T\86400+D+D0
SET T=T#86400
QUIT $$CDATH2F(D_","_T)
ADDM(D,M) ;Add months to Date D
+1 NEW I,X,Y
+2 IF 'M
QUIT D
+3 IF M<0
SET X=D
FOR I=1:1:-M
SET X=X-100
IF $EXTRACT(X,4,5)="00"
SET X=X-8800
+4 IF M>0
SET X=D
FOR I=1:1:M
SET X=X+100
IF $EXTRACT(X,4,5)="13"
SET X=X+8800
+5 SET I=$PIECE("31 28 31 30 31 30 31 31 30 31 30 31"," ",$EXTRACT(X,4,5))
+6 IF I=28
SET Y=X\10000+1700
IF '(Y#4)
SET I=29
IF '(I#100)
SET I=28
IF '(I#400)
SET I=29
+7 IF $EXTRACT(X,6,7)>I
SET X=X-$EXTRACT(X,6,7)+I
QUIT X
CDATA2F(D,F) ;Convert ASCII date to fileman format
+1 ;D = date in almost any format (JULY 20, 1969; 20JUL69; 7/20/69; 20-JUL-1969; 20JUL; etc.)
+2 ;F = Flags as follows:
+3 ; F["T" Time value may be included
+4 ; F["R" Time value is Required
+5 ; F["R" Imprecise dates allowed
+6 NEW %,%0,%1,%2,%3,T
SET F=$GET(F)
SET T=F["T"!(F["R")
+7 SET D=$$UPCASE^%ZTF(D)
SET %=$PIECE(D,"@")
SET %0=$PIECE(D,"@",2)
SET %2=0
IF %=""
SET %="T"
+8 ;Time only was passed
IF T
IF %[":"!(%?2.4N)!(%?1.2N.1" "1.2A)
SET %0=%
SET %="T"
+9 IF %?1.U1P1.N.1U
FOR %1=2:1:$LENGTH(%)
IF $EXTRACT(%,%1)?1P
IF "+-"[$EXTRACT(%,%1)
SET %2=$EXTRACT(%,%1+1,99)
SET %=$EXTRACT(%,1,%1-1)
SET %3=$EXTRACT(%2,$LENGTH(%2))
SET %2=$EXTRACT(D,%1)_$SELECT(%3="W":%2*7,%3="M":%2*30,%3="H":"."_+%2,1:+%2)
QUIT
+10 IF %?1.U
Begin DoDot:1
+11 IF $PIECE("NOW",%)=""
SET %=$HOROLOG
QUIT
+12 IF $PIECE("TODAY",%)=""
SET %=+$HOROLOG
QUIT
+13 ;note that N and NO mean NOW
IF $PIECE("NOON",%)=""
SET %=+$HOROLOG_",43200"
QUIT
+14 IF $PIECE("MIDNIGHT",%)=""
SET %=+$HOROLOG
QUIT
End DoDot:1
IF $$ABS^%ZTF(%2)'<1
SET %=%+%2_","_$PIECE(%,",",2)
SET %=$$CDATH2F(%)
IF %2?.1P1"."1.N
SET %=$$ADDT(%,0,$TRANSLATE(%2,"."))
IF '$LENGTH(%0)
QUIT %
+15 IF '$TEST
NEW %5
SET %3=$SELECT($EXTRACT(%)?1N:"1N",1:"1A")
SET %5=0
SET %1=0
Begin DoDot:1
+16 IF %?6N
SET %(1)=$EXTRACT(%,1,2)
SET %(2)=$EXTRACT(%,3,4)
SET %(3)=$EXTRACT(%,5,6)
+17 IF '$TEST
FOR %2=1:1
IF $EXTRACT(%,%2)'?@%3
SET %1=%1+1
SET %(%1)=$EXTRACT(%,1,%2-1)
IF %3="1A"
SET %5=%1
IF %2>$LENGTH(%)
QUIT
FOR %2=%2:1
IF $EXTRACT(%,%2)'?1P
SET %=$EXTRACT(%,%2,99)
SET %2=0
SET %3=$SELECT($EXTRACT(%)?1N:"1N",1:"1A")
QUIT
+18 IF %5
IF %5=2
SET %5=%(1)
SET %(1)=%(2)
SET %(2)=%5
SET %(1)=$FIND("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",$EXTRACT(%(1),1,3))
SET %(1)=$SELECT(%(1)-1#3:0,1:%(1)\3)
IF '%(1)
SET %=0
QUIT
+19 IF %(1)>12
SET %=0
QUIT
+20 IF F["I"
IF %1<3
IF %(%1)>31
SET %2=$SELECT(%(%1)?2N:200,1:-1700)
SET %=%(%1)+%2*100+$SELECT(%1=2:%(1),1:0)_"00"
QUIT
+21 IF %1=2
SET %(3)=$HOROLOG+.9\365.25+1841
SET %1=%1+1
IF %1'=3
SET %=0
QUIT
+22 IF %(3)?2N
SET %(3)=$SELECT($HOROLOG<58074:19,1:20)_%(3)
SET %1=%(1)*2
SET %=$SELECT(%(2)>$EXTRACT(" 31"_(%(3)#4=0+28)_"31303130313130313031",%1,%1+1):0,1:%(3)-1700*100+%(1)*100+%(2))
QUIT
End DoDot:1
+23 IF %'?7N
QUIT ""
IF '$LENGTH(%0)
QUIT $SELECT(F'["R":%,1:"")
+24 IF 'T
QUIT ""
SET %3=$SELECT(%0["A":1,%0["P":2,1:0)
IF %0?5N&'$EXTRACT(%0)
QUIT ""
IF %0?3N&(%0<100)
QUIT ""
+25 IF %0?3N&$EXTRACT(%0)
SET %0=0_%0
IF %0[":"
SET %1=$PIECE(%0,":",2)
SET %2=$PIECE(%0,":",3)
SET %0=$PIECE(%0,":")
+26 IF '$TEST
SET %3=$SELECT($LENGTH(%0)>1:-1,1:0)
SET %1=$EXTRACT(%0,3,4)
SET %2=$EXTRACT(%0,5,6)
SET %0=$EXTRACT(%0,1,2)
+27 IF '%0&'%1&'%2
QUIT ""
IF %0>24!(%1>59)!(%2>59)
QUIT ""
IF %0>23&((%1>0)!(%2>0))
QUIT ""
IF %1<10&(%1'?1"0"1N)
SET %1=0_%1
IF %2<10&(%2'?1"0"1N)
SET %2=0_%2
+28 SET %0=$SELECT(%3=1:%0#12,%3=2&(%0<13):%0+12,%0<6&'%3:%0+12,1:%0)
+29 SET %0=$SELECT(%0<24:%0#24,1:%0)
IF %0<10
SET %0=0_%0
QUIT +(%_"."_%0_%1_%2)
CDATASC(D,DF,TF) ;Convert internal date value to ASCII
+1 ;D = date in $H or Fileman format. D?7N.E assumes Fileman format.
+2 ;DF = 1 dd Mon YYYY dd padded with a zero (default format)
+3 ; 2 nn/nn/nn date and month are zero padded
+4 ; 3 Month day, year
+5 ; 4 Day, dd Mon yyyy hh:mm:ss Arpa RFC822 format
+6 ;TF = 1 @hhmm If TF not present, no time in output
+7 ; 2 @hh:mm:ss
+8 ; 3 hh:mm:ss leading space instead of @
+9 NEW %,%0,%1,W
SET DF=$GET(DF)
SET TF=$GET(TF)
IF DF<1!(DF>4)
SET DF=1
IF TF<1!(TF>3)
SET TF=0
+10 ;$H date to Fileman date
IF D'?7N
IF D'?7N1"."1.6N
SET D=$$CDATH2F(D,.W)
+11 IF 'D
QUIT ""
SET %=$EXTRACT(D,1,3)+1700
SET %0=$EXTRACT(D,4,5)
SET %1=$EXTRACT(D,6,7)
Begin DoDot:1
+12 IF '(%0&%1)
SET DF=9
IF DF=2
GOTO CDA2
IF DF=3
GOTO CDA3
IF DF=4
GOTO CDA4
IF DF=9
GOTO CDA9
CDA1 SET %1=%1_" "
CDA1A SET %0=%0*3
SET %=%1_$EXTRACT("JanFebMarAprMayJunJulAugSepOctNovDec",%0-2,%0)_" "_%
QUIT
CDA2 SET %=%0_"/"_%1_"/"_$EXTRACT(%,3,4)
QUIT
CDA3 SET %=$PIECE("January,February,March,April,May,June,July,August,September,October,November,December",",",%0)_" "_(+%1)_", "_%
QUIT
CDA4 IF '$DATA(W)
SET TF=$$CDATF2H(D,.W)
SET W=W*3+1
SET %1=$EXTRACT("SatSunMonTueWedThuFri",W,W+2)_", "_%1_" "
SET TF=3
GOTO CDA1A
CDA9 IF '%0
QUIT
SET %1=""
GOTO CDA1A
End DoDot:1
SET %0=""
+1 IF TF
SET %1=$EXTRACT($PIECE(D,".",2)_"000000",1,$SELECT(TF=1:4,1:6))
SET %0=$SELECT(TF=3:" ",1:"@")_$SELECT(TF=1:%1,1:$EXTRACT(%1,1,2)_":"_$EXTRACT(%1,3,4)_":"_$EXTRACT(%1,5,6))
+2 QUIT %_%0
CDATF2H(F,W,Y,M,D,T) ;Convert Fileman date to $H format
+1 ;If passed by reference, variables returned:
+2 ; W = Weekday (Sat=0, Sun=1, ... Fri=6), Y = Year (4 digits), M = Month (1-12), D = Day (1-31), T = 2nd piece of $H result (Time portion)
+3 NEW %,H
SET Y=$EXTRACT(F,1,3)+1700
SET M=$EXTRACT(F,4,5)
SET D=$EXTRACT(F,6,7)
SET T=""
+4 IF $LENGTH(F)>8
SET F=$PIECE(F,".",2)_"000"
SET T=$EXTRACT(F,1,2)*60+$EXTRACT(F,3,4)*60+$EXTRACT(F,5,6)
+5 ;Imprecise dates (no day/month) convert to the 1st
IF 'M
SET M=1
IF 'D
SET D=1
+6 SET H=M>2&'(Y#4)+$PIECE("^31^59^90^120^151^181^212^243^273^304^334","^",M)+D-(M>2&'(Y#100))+(M>2&'(Y#400))
SET %=Y-1841
SET H=H+(%*365)+(%\4)-(%>59)
+7 SET %=$EXTRACT(F+.000000001#1,2,7)
SET %=$EXTRACT(%,1,2)*3600+($EXTRACT(%,3,4)*60)+$EXTRACT(%,5,6)
SET W=H+5#7
QUIT H_$SELECT(T]"":","_T,1:"")
CDATH2F(H,W,Y,M,D) ;Convert date in $H format to Fileman format
+1 ;If passed by reference, variables returned:
+2 ; W = Weekday (Sat=0, Sun=1, ... Fri=6), Y = Year (4 digits), M = Month (1-12), D = Day (1-31)
+3 IF 'H
QUIT ""
NEW T
SET T=$PIECE(H,",",2)
SET M=H>21608+(H>94657)+H-.1
SET Y=M\365.25+1841
SET M=M#365.25\1
SET D=M+306#(Y#4=0+365)#153#61#31+1
SET M=M-D\29+1
SET W=H+5#7
+4 IF $LENGTH(T)
SET T="."_$TRANSLATE($JUSTIFY(T\3600,2)_$JUSTIFY(T#3600\60,2)_$JUSTIFY(T#60,2)," ",0)
+5 QUIT Y-1700*10000+(M*100)+D+T
DT() ;Return the current date in Fileman format
+1 QUIT $$CDATH2F(+$HOROLOG)
DTC(D1,D2) ;Compare two dates and return the number of days between them
+1 QUIT $SELECT(D1?7N.E:$$CDATF2H(D1),1:D1)-$SELECT(D2?7N.E:$$CDATF2H(D2),1:D2)
NOW() ;Return the current date and time in Fileman format
+1 QUIT $$CDATH2F($HOROLOG)
DATEOUT(DT,F) ;Return date as specified in SSPM
+1 ; DT is a date (in FileMan or $H format) to be translated to
+2 ; F format. If DT is an invalid date then a -1 is returned.
+3 ; 1 "02 Aug 1987"
+4 ; 2 "02 Aug 1987@1300"
+5 ; 3 "02 Aug 87"
+6 ; 4 "02Aug"
+7 ; 5 "02Aug@1300"
+8 ; 6 "02Aug87"
+9 ; 7 "02Aug87@1300"
+10 ; 8 "02 August 1987 @ 1300"
+11 ; 9 "02 August 1987 1300"
+12 ; 10 "02 Aug 87 @ 1300"
+13 ;
+14 NEW FF,T,TM,X,Y,%DT
+15 IF (DT'?1.N)&(DT'?7N1"."1.6N)&(DT'?1.6N1","1.N)!(DT<1)
QUIT -1
+16 ;Convert DT to FileMan format
IF DT?1.N1","1.N!($LENGTH(DT)<7)
SET DT=$$CDATH2F(DT)
+17 ;Checks for invalid date
SET X=DT\1
DO ^%DT
IF Y=-1
QUIT -1
+18 SET T=$$CDATASC(DT,1,1)
+19 ;Remove time if month or day is 00
IF '$EXTRACT(X,4,5)!'$EXTRACT(X,6,7)
SET T=$PIECE(T,"@")
+20 ;Checks for invalid time
SET TM=$PIECE(T,"@",2)
IF TM>2399!(TM#100>59)
QUIT -1
+21 ;
+22 ; Formats the output in T
+23 SET FF=" "_F_" "
+24 ;*S21525
SET Y=$SELECT($PIECE(T," ",2)="":T,+T:$EXTRACT(T,8,11),1:$EXTRACT(T,5,8))
+25 IF " 3 6 7 10 "[FF
SET Y=$EXTRACT(Y,3,4)
IF " 4 5 "[FF
SET Y=""
+26 ;*S21525
SET T=$SELECT($PIECE(T," ",2)="":Y,+T:$EXTRACT(T,1,7)_Y_$EXTRACT(T,12,$LENGTH(T)),1:$EXTRACT(T,1,4)_Y_$EXTRACT(T,9,$LENGTH(T)))
+27 IF " 1 3 4 6 "[FF
SET T=$PIECE(T,"@")
IF " 4 5 6 7 "[FF
SET T=$TRANSLATE(T," ")
+28 IF " 8 10 "[FF&(T["@")
SET T=$PIECE(T,"@")_" @ "_TM
+29 IF " 9 "[FF&(T["@")
SET T=$PIECE(T,"@")_" "_TM
+30 IF " 8 9 "[FF
Begin DoDot:1
+31 SET X=1
IF $PIECE(T," ")'?3A
SET X=2
IF $PIECE(T," ",2)'?3A
QUIT
+32 SET $PIECE(T," ",X)=$PIECE("January,February,March,April,May,June,July,August,September,October,November,December",",",$EXTRACT(DT,4,5))
End DoDot:1
+33 QUIT T
+34 ;
ERRNL ;RETURN NULL STRING ON ERROR
QUIT ""
ERR0 ;RETURN 0 ON ERROR
QUIT 0
