LRAFUNC1 ; IHS/DIR/AAB - FUNCTION CALL DATE/TIME A5AFUNC1 ; [ 07/22/2002 1:04 PM ]
;;5.2;LR;**1006,1013**;JUL 15, 2002
;
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
;
N I,X
W !!,"Routine: "_$T(+0),! F I=8:1 S X=$T(LRAFUNC1+I) Q:'$L(X) I X[";;" W !,X
W !!
Q
;
DT() ;; $$VAR
;; Returns current Date in Fileman form
;; YYYMMDD
;; Eg. S DT=$$DT^LRAFUNC1
Q $$NOW\1
;;
LRODT0() ;; $$VAR
;; Returns current date in MM/DD/YY format
;; Eg. S LRODT0=$$LRODT0^LRAFUNC1
N Y S Y=$$NOW\1
Q $$FMTE^XLFDT(Y,"5D")
;;
NOW() ;; $$VAR
;; Returns Date-Time in Fileman form
;; YYYMMDD.HHMMSS
;; Eg. S X=$$NOW^LRAFUNC1
Q $$CDHTFM($H)
;;
DOW(X) ;;
;; Call by value
;; X is in $H or Fileman form
;; Returns string day of week
; Help from DIDTC
N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY,X1
I X'?7N.E S X1=X,X=$$CDHTFM(X)
D COMP
Q $P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",LRPERY+1)_"DAY"
;;
CDHTFM(X1) ;; convert $H Date-Time to Fileman Date-Time form
;; Call by value
;; X = Date-Time in $H format NNNNN,NNNNN
;; Returns Date-Time in Fileman format YYYMMDD.HHMMSS
;; eg. S X=$$CDHTFM($H)
; help from DIDTC
N X,LRPER,LRPERD,LRPERI,LRPERM,LRPERY
S LRPER=X1>21608+X1-.1,LRPERY=LRPER\365.25+141,LRPER=LRPER#365.25\1
S LRPERD=LRPER+306#(LRPERY#4=0+365)#153#61#31+1,LRPERM=LRPER-LRPERD\29+1
S X=LRPERY_"00"+LRPERM_"00"+LRPERD
S LRPERI(1)=LRPERM,LRPERI(2)=LRPERD,LRPERI(3)=LRPERY
S LRPER=$P(X1,",",2)
S LRPER=LRPER#60/100+(LRPER#3600\60)/100+(LRPER\3600)/100
S LRPER=X_$S(LRPER:LRPER,1:"")
Q LRPER
;;
CFMTDH(X) ;; converts Fileman Date-Time to $H Date-time
;; Call by value
;; D = Date-Time in Fileman form YYYMMDD.HHMMSS
;; Returns Date-Time in $H form NNNNN,NNNNN
;; eg. S X=$$CFMTDH(2901225.1234)
; Help from DIDTC
N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY
I X<1410000 Q 0
D COMP
I LRPERT>86400 S LRPERT=LRPERT-86400,D1=1
S LRPERH=LRPERH+$G(D1)
Q LRPERH_","_LRPERT
;;
DDDATE(Y1,Y2) ;;
;; $$DDDATE(Y1,Y2)
;; Call by value
;; Y1 Date-Time in Fileman Format
;; Returns External form of Date-Time MMM DD,YYYY (@HH:MM:SS) depending
;; on the value of Y2
;; if Y1 is NOT passed $$NOW^LRAFUNC1 will be used for the date
;; if Y2=0 no time will return
;; if Y2=1 time will be returned in hours and minutes
;; if Y2=2 time will be returned in hours, minutes and seconds
; with help from DD^DIDT
N Y
I '$G(Y1) S Y1=$$NOW
S Y=$S($E(Y1,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y1,4,5))_" ",1:"")_$S($E(Y1,6,7):+$E(Y1,6,7)_",",1:"")_($E(Y1,1,3)+1700) Q:'$G(Y2) Y
S Y=Y_$P("@"_$E(Y1_0,9,10)_":"_$E(Y1_"000",11,12),"^",Y1[".") Q:$G(Y2)'>1 Y
S Y=Y_$S($E(Y1,13,14):":"_$E(Y1_0,13,14),1:"")
Q Y
;;
ADDDATE(D,D1,H,M,S) ;; Adds Days, hours minutes seconds to D
;; D date in Fileman format to which is to be added
;; D1 Days * optional *
;; H Hours * optional *
;; M Minutes * optional *
;; S Seconds * optional *
;; Returns DATE in fileman Format
;; eg. S X=$$ADDDATE(DT,0,12) would add 12 hours to the value of DT
;N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY,X,LRPERA
I '$G(D) Q 0
S D1=+$G(D1),H=+$G(H),M=+$G(M),S=+$G(S)
S LRPERH=$$CFMTDH(D),LRPERT=$P(LRPERH,",",2),LRPERH=$P(LRPERH,",")
S LRPERH=LRPERH+D1,LRPERT=(LRPERT+(H*3600)+(M*60)+S)
S A=LRPERT\86400
S:A LRPERH=LRPERH+A,LRPERT=(LRPERT-(86400*A))
Q $$CDHTFM(LRPERH_","_LRPERT)
;;
DTC(X1,X2,X3) ;; Date-Time Compare
;; Call by value
;; X1 and X2 the dates for comparison
;; X3 = 0 returns difference in whole days eg. 1
;; X3 = 1 return difference in days and hours eg. 1.01 or 1.14
;; X3 = 2 returns difference in days, hours and minutes 1.0103 or 1.1423
;; X3 = 3 returns difference in days, hours, minutes and seconds
;; 1.010234 or 1.142322
; Help from DIDTC
N LRPERD,LRPERH,LRPERM,LRPERY,X12,X22,X
I '$G(X1)!'$G(X2) Q ""
S X=X1,X(1)=$P(X1,".",2) D COMP S X1=LRPERH,X12=LRPER
S X=X2,X(1)=$P(X2,".",2) D COMP S X22=LRPER
S X=X1-LRPERH
I $G(X3) D
. S LRPER=X12-X22,LRPER=LRPER#60/100+(LRPER#3600\60)/100+(LRPER\3600)/100
. S LRPER=$E(LRPER,1,$S(X3=1:3,X3=2:5,1:7))
. S X=X_LRPER
Q X
;
COMP ;
I X<1410000 S LRPERH=0,LRPERY=-1 Q
S LRPERY=$E(X,1,3),LRPERM=$E(X,4,5),LRPERD=$E(X,6,7)
S LRPERT=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14)
S LRPERH=LRPERM>2&'(LRPERY#4)+$P("^31^59^90^120^151^181^212^243^273^304^334","^",LRPERM)+LRPERD
S LRPER='LRPERM!'LRPERD,LRPERY=LRPERY-141,LRPERH=LRPERH+(LRPERY*365)+(LRPERY\4)-(LRPERY>59)+LRPER,LRPERY=$S(LRPER:-1,1:LRPERH+4#7)
I $G(X(1)) D
. S LRPER=$E(X(1)_"0",1,2)*60+$E(X(1)_"000",3,4)*60+$E(X(1)_"00000",5,6)
Q
DTF(Y1) ;; Convert Fileman Date format to mmm dd yyyy:hhmm.ss
N Y
S Y=$S($E(Y1,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y1,4,5))_" ",1:"")_$S($E(Y1,6,7):+$E(Y1,6,7)_",",1:"")_($E(Y1,1,3)+1700)
S Y=Y_$P("@"_$E(Y1_0,9,10)_":"_$E(Y1_"000",11,12),"^",Y1[".")
S Y=Y_$S($E(Y1,13,14):":"_$E(Y1_0,13,14),1:"")
Q Y
;
LRAFUNC1 ; IHS/DIR/AAB - FUNCTION CALL DATE/TIME A5AFUNC1 ; [ 07/22/2002 1:04 PM ]
+1 ;;5.2;LR;**1006,1013**;JUL 15, 2002
+2 ;
+3 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
+4 ;
+5 NEW I,X
+6 WRITE !!,"Routine: "_$TEXT(+0),!
FOR I=8:1
SET X=$TEXT(LRAFUNC1+I)
IF '$LENGTH(X)
QUIT
IF X[";;"
WRITE !,X
+7 WRITE !!
+8 QUIT
+9 ;
DT() ;; $$VAR
+1 ;; Returns current Date in Fileman form
+2 ;; YYYMMDD
+3 ;; Eg. S DT=$$DT^LRAFUNC1
+4 QUIT $$NOW\1
+5 ;;
LRODT0() ;; $$VAR
+1 ;; Returns current date in MM/DD/YY format
+2 ;; Eg. S LRODT0=$$LRODT0^LRAFUNC1
+3 NEW Y
SET Y=$$NOW\1
+4 QUIT $$FMTE^XLFDT(Y,"5D")
+5 ;;
NOW() ;; $$VAR
+1 ;; Returns Date-Time in Fileman form
+2 ;; YYYMMDD.HHMMSS
+3 ;; Eg. S X=$$NOW^LRAFUNC1
+4 QUIT $$CDHTFM($HOROLOG)
+5 ;;
DOW(X) ;;
+1 ;; Call by value
+2 ;; X is in $H or Fileman form
+3 ;; Returns string day of week
+4 ; Help from DIDTC
+5 NEW LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY,X1
+6 IF X'?7N.E
SET X1=X
SET X=$$CDHTFM(X)
+7 DO COMP
+8 QUIT $PIECE("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",LRPERY+1)_"DAY"
+9 ;;
CDHTFM(X1) ;; convert $H Date-Time to Fileman Date-Time form
+1 ;; Call by value
+2 ;; X = Date-Time in $H format NNNNN,NNNNN
+3 ;; Returns Date-Time in Fileman format YYYMMDD.HHMMSS
+4 ;; eg. S X=$$CDHTFM($H)
+5 ; help from DIDTC
+6 NEW X,LRPER,LRPERD,LRPERI,LRPERM,LRPERY
+7 SET LRPER=X1>21608+X1-.1
SET LRPERY=LRPER\365.25+141
SET LRPER=LRPER#365.25\1
+8 SET LRPERD=LRPER+306#(LRPERY#4=0+365)#153#61#31+1
SET LRPERM=LRPER-LRPERD\29+1
+9 SET X=LRPERY_"00"+LRPERM_"00"+LRPERD
+10 SET LRPERI(1)=LRPERM
SET LRPERI(2)=LRPERD
SET LRPERI(3)=LRPERY
+11 SET LRPER=$PIECE(X1,",",2)
+12 SET LRPER=LRPER#60/100+(LRPER#3600\60)/100+(LRPER\3600)/100
+13 SET LRPER=X_$SELECT(LRPER:LRPER,1:"")
+14 QUIT LRPER
+15 ;;
CFMTDH(X) ;; converts Fileman Date-Time to $H Date-time
+1 ;; Call by value
+2 ;; D = Date-Time in Fileman form YYYMMDD.HHMMSS
+3 ;; Returns Date-Time in $H form NNNNN,NNNNN
+4 ;; eg. S X=$$CFMTDH(2901225.1234)
+5 ; Help from DIDTC
+6 NEW LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY
+7 IF X<1410000
QUIT 0
+8 DO COMP
+9 IF LRPERT>86400
SET LRPERT=LRPERT-86400
SET D1=1
+10 SET LRPERH=LRPERH+$GET(D1)
+11 QUIT LRPERH_","_LRPERT
+12 ;;
DDDATE(Y1,Y2) ;;
+1 ;; $$DDDATE(Y1,Y2)
+2 ;; Call by value
+3 ;; Y1 Date-Time in Fileman Format
+4 ;; Returns External form of Date-Time MMM DD,YYYY (@HH:MM:SS) depending
+5 ;; on the value of Y2
+6 ;; if Y1 is NOT passed $$NOW^LRAFUNC1 will be used for the date
+7 ;; if Y2=0 no time will return
+8 ;; if Y2=1 time will be returned in hours and minutes
+9 ;; if Y2=2 time will be returned in hours, minutes and seconds
+10 ; with help from DD^DIDT
+11 NEW Y
+12 IF '$GET(Y1)
SET Y1=$$NOW
+13 SET Y=$SELECT($EXTRACT(Y1,4,5):$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$EXTRACT(Y1,4,5))_" ",1:"")_$SELECT($EXTRACT(Y1,6,7):+$EXTRACT(Y1,6,7)_",",1:"")_($EXTRACT(Y1,1,3)+1700)
IF '$GET(Y2)
QUIT Y
+14 SET Y=Y_$PIECE("@"_$EXTRACT(Y1_0,9,10)_":"_$EXTRACT(Y1_"000",11,12),"^",Y1[".")
IF $GET(Y2)'>1
QUIT Y
+15 SET Y=Y_$SELECT($EXTRACT(Y1,13,14):":"_$EXTRACT(Y1_0,13,14),1:"")
+16 QUIT Y
+17 ;;
ADDDATE(D,D1,H,M,S) ;; Adds Days, hours minutes seconds to D
+1 ;; D date in Fileman format to which is to be added
+2 ;; D1 Days * optional *
+3 ;; H Hours * optional *
+4 ;; M Minutes * optional *
+5 ;; S Seconds * optional *
+6 ;; Returns DATE in fileman Format
+7 ;; eg. S X=$$ADDDATE(DT,0,12) would add 12 hours to the value of DT
+8 ;N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY,X,LRPERA
+9 IF '$GET(D)
QUIT 0
+10 SET D1=+$GET(D1)
SET H=+$GET(H)
SET M=+$GET(M)
SET S=+$GET(S)
+11 SET LRPERH=$$CFMTDH(D)
SET LRPERT=$PIECE(LRPERH,",",2)
SET LRPERH=$PIECE(LRPERH,",")
+12 SET LRPERH=LRPERH+D1
SET LRPERT=(LRPERT+(H*3600)+(M*60)+S)
+13 SET A=LRPERT\86400
+14 IF A
SET LRPERH=LRPERH+A
SET LRPERT=(LRPERT-(86400*A))
+15 QUIT $$CDHTFM(LRPERH_","_LRPERT)
+16 ;;
DTC(X1,X2,X3) ;; Date-Time Compare
+1 ;; Call by value
+2 ;; X1 and X2 the dates for comparison
+3 ;; X3 = 0 returns difference in whole days eg. 1
+4 ;; X3 = 1 return difference in days and hours eg. 1.01 or 1.14
+5 ;; X3 = 2 returns difference in days, hours and minutes 1.0103 or 1.1423
+6 ;; X3 = 3 returns difference in days, hours, minutes and seconds
+7 ;; 1.010234 or 1.142322
+8 ; Help from DIDTC
+9 NEW LRPERD,LRPERH,LRPERM,LRPERY,X12,X22,X
+10 IF '$GET(X1)!'$GET(X2)
QUIT ""
+11 SET X=X1
SET X(1)=$PIECE(X1,".",2)
DO COMP
SET X1=LRPERH
SET X12=LRPER
+12 SET X=X2
SET X(1)=$PIECE(X2,".",2)
DO COMP
SET X22=LRPER
+13 SET X=X1-LRPERH
+14 IF $GET(X3)
Begin DoDot:1
+15 SET LRPER=X12-X22
SET LRPER=LRPER#60/100+(LRPER#3600\60)/100+(LRPER\3600)/100
+16 SET LRPER=$EXTRACT(LRPER,1,$SELECT(X3=1:3,X3=2:5,1:7))
+17 SET X=X_LRPER
End DoDot:1
+18 QUIT X
+19 ;
COMP ;
+1 IF X<1410000
SET LRPERH=0
SET LRPERY=-1
QUIT
+2 SET LRPERY=$EXTRACT(X,1,3)
SET LRPERM=$EXTRACT(X,4,5)
SET LRPERD=$EXTRACT(X,6,7)
+3 SET LRPERT=$EXTRACT(X_0,9,10)*60+$EXTRACT(X_"000",11,12)*60+$EXTRACT(X_"00000",13,14)
+4 SET LRPERH=LRPERM>2&'(LRPERY#4)+$PIECE("^31^59^90^120^151^181^212^243^273^304^334","^",LRPERM)+LRPERD
+5 SET LRPER='LRPERM!'LRPERD
SET LRPERY=LRPERY-141
SET LRPERH=LRPERH+(LRPERY*365)+(LRPERY\4)-(LRPERY>59)+LRPER
SET LRPERY=$SELECT(LRPER:-1,1:LRPERH+4#7)
+6 IF $GET(X(1))
Begin DoDot:1
+7 SET LRPER=$EXTRACT(X(1)_"0",1,2)*60+$EXTRACT(X(1)_"000",3,4)*60+$EXTRACT(X(1)_"00000",5,6)
End DoDot:1
+8 QUIT
DTF(Y1) ;; Convert Fileman Date format to mmm dd yyyy:hhmm.ss
+1 NEW Y
+2 SET Y=$SELECT($EXTRACT(Y1,4,5):$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$EXTRACT(Y1,4,5))_" ",1:"")_$SELECT($EXTRACT(Y1,6,7):+$EXTRACT(Y1,6,7)_",",1:"")_($EXTRACT(Y1,1,3)+1700)
+3 SET Y=Y_$PIECE("@"_$EXTRACT(Y1_0,9,10)_":"_$EXTRACT(Y1_"000",11,12),"^",Y1[".")
+4 SET Y=Y_$SELECT($EXTRACT(Y1,13,14):":"_$EXTRACT(Y1_0,13,14),1:"")
+5 QUIT Y
+6 ;
