source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRAFUNC1.m@ 1154

LRAFUNC1 ;SLC/MRH/FHS -  FUNCTION CALL  DATE/TIME  A5AFUNC1
 ;;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
 ;