- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAFUNC1 4945 printed Jan 18, 2025@03:07:26 Page 2
- LRAFUNC1 ;SLC/MRH/FHS - FUNCTION CALL DATE/TIME A5AFUNC1
- +1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- +2 ;
- +3 NEW I,X
- +4 WRITE !!,"Routine: "_$TEXT(+0),!
- FOR I=8:1
- SET X=$TEXT(LRAFUNC1+I)
- if '$LENGTH(X)
- QUIT
- IF X[";;"
- WRITE !,X
- +5 WRITE !!
- +6 QUIT
- +7 ;
- 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 ;