source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAFUNC1.m@ 1489

Last change on this file since 1489 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1LRAFUNC1 ;SLC/MRH/FHS - FUNCTION CALL DATE/TIME A5AFUNC1
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3 ;
4 N I,X
5 W !!,"Routine: "_$T(+0),! F I=8:1 S X=$T(LRAFUNC1+I) Q:'$L(X) I X[";;" W !,X
6 W !!
7 Q
8 ;
9DT() ;; $$VAR
10 ;; Returns current Date in Fileman form
11 ;; YYYMMDD
12 ;; Eg. S DT=$$DT^LRAFUNC1
13 Q $$NOW\1
14 ;;
15LRODT0() ;; $$VAR
16 ;; Returns current date in MM/DD/YY format
17 ;; Eg. S LRODT0=$$LRODT0^LRAFUNC1
18 N Y S Y=$$NOW\1
19 Q $$FMTE^XLFDT(Y,"5D")
20 ;;
21NOW() ;; $$VAR
22 ;; Returns Date-Time in Fileman form
23 ;; YYYMMDD.HHMMSS
24 ;; Eg. S X=$$NOW^LRAFUNC1
25 Q $$CDHTFM($H)
26 ;;
27DOW(X) ;;
28 ;; Call by value
29 ;; X is in $H or Fileman form
30 ;; Returns string day of week
31 ; Help from DIDTC
32 N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY,X1
33 I X'?7N.E S X1=X,X=$$CDHTFM(X)
34 D COMP
35 Q $P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",LRPERY+1)_"DAY"
36 ;;
37CDHTFM(X1) ;; convert $H Date-Time to Fileman Date-Time form
38 ;; Call by value
39 ;; X = Date-Time in $H format NNNNN,NNNNN
40 ;; Returns Date-Time in Fileman format YYYMMDD.HHMMSS
41 ;; eg. S X=$$CDHTFM($H)
42 ; help from DIDTC
43 N X,LRPER,LRPERD,LRPERI,LRPERM,LRPERY
44 S LRPER=X1>21608+X1-.1,LRPERY=LRPER\365.25+141,LRPER=LRPER#365.25\1
45 S LRPERD=LRPER+306#(LRPERY#4=0+365)#153#61#31+1,LRPERM=LRPER-LRPERD\29+1
46 S X=LRPERY_"00"+LRPERM_"00"+LRPERD
47 S LRPERI(1)=LRPERM,LRPERI(2)=LRPERD,LRPERI(3)=LRPERY
48 S LRPER=$P(X1,",",2)
49 S LRPER=LRPER#60/100+(LRPER#3600\60)/100+(LRPER\3600)/100
50 S LRPER=X_$S(LRPER:LRPER,1:"")
51 Q LRPER
52 ;;
53CFMTDH(X) ;; converts Fileman Date-Time to $H Date-time
54 ;; Call by value
55 ;; D = Date-Time in Fileman form YYYMMDD.HHMMSS
56 ;; Returns Date-Time in $H form NNNNN,NNNNN
57 ;; eg. S X=$$CFMTDH(2901225.1234)
58 ; Help from DIDTC
59 N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY
60 I X<1410000 Q 0
61 D COMP
62 I LRPERT>86400 S LRPERT=LRPERT-86400,D1=1
63 S LRPERH=LRPERH+$G(D1)
64 Q LRPERH_","_LRPERT
65 ;;
66DDDATE(Y1,Y2) ;;
67 ;; $$DDDATE(Y1,Y2)
68 ;; Call by value
69 ;; Y1 Date-Time in Fileman Format
70 ;; Returns External form of Date-Time MMM DD,YYYY (@HH:MM:SS) depending
71 ;; on the value of Y2
72 ;; if Y1 is NOT passed $$NOW^LRAFUNC1 will be used for the date
73 ;; if Y2=0 no time will return
74 ;; if Y2=1 time will be returned in hours and minutes
75 ;; if Y2=2 time will be returned in hours, minutes and seconds
76 ; with help from DD^DIDT
77 N Y
78 I '$G(Y1) S Y1=$$NOW
79 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
80 S Y=Y_$P("@"_$E(Y1_0,9,10)_":"_$E(Y1_"000",11,12),"^",Y1[".") Q:$G(Y2)'>1 Y
81 S Y=Y_$S($E(Y1,13,14):":"_$E(Y1_0,13,14),1:"")
82 Q Y
83 ;;
84ADDDATE(D,D1,H,M,S) ;; Adds Days, hours minutes seconds to D
85 ;; D date in Fileman format to which is to be added
86 ;; D1 Days * optional *
87 ;; H Hours * optional *
88 ;; M Minutes * optional *
89 ;; S Seconds * optional *
90 ;; Returns DATE in fileman Format
91 ;; eg. S X=$$ADDDATE(DT,0,12) would add 12 hours to the value of DT
92 ;N LRPER,LRPERD,LRPERH,LRPERM,LRPERT,LRPERY,X,LRPERA
93 I '$G(D) Q 0
94 S D1=+$G(D1),H=+$G(H),M=+$G(M),S=+$G(S)
95 S LRPERH=$$CFMTDH(D),LRPERT=$P(LRPERH,",",2),LRPERH=$P(LRPERH,",")
96 S LRPERH=LRPERH+D1,LRPERT=(LRPERT+(H*3600)+(M*60)+S)
97 S A=LRPERT\86400
98 S:A LRPERH=LRPERH+A,LRPERT=(LRPERT-(86400*A))
99 Q $$CDHTFM(LRPERH_","_LRPERT)
100 ;;
101DTC(X1,X2,X3) ;; Date-Time Compare
102 ;; Call by value
103 ;; X1 and X2 the dates for comparison
104 ;; X3 = 0 returns difference in whole days eg. 1
105 ;; X3 = 1 return difference in days and hours eg. 1.01 or 1.14
106 ;; X3 = 2 returns difference in days, hours and minutes 1.0103 or 1.1423
107 ;; X3 = 3 returns difference in days, hours, minutes and seconds
108 ;; 1.010234 or 1.142322
109 ; Help from DIDTC
110 N LRPERD,LRPERH,LRPERM,LRPERY,X12,X22,X
111 I '$G(X1)!'$G(X2) Q ""
112 S X=X1,X(1)=$P(X1,".",2) D COMP S X1=LRPERH,X12=LRPER
113 S X=X2,X(1)=$P(X2,".",2) D COMP S X22=LRPER
114 S X=X1-LRPERH
115 I $G(X3) D
116 . S LRPER=X12-X22,LRPER=LRPER#60/100+(LRPER#3600\60)/100+(LRPER\3600)/100
117 . S LRPER=$E(LRPER,1,$S(X3=1:3,X3=2:5,1:7))
118 . S X=X_LRPER
119 Q X
120 ;
121COMP ;
122 I X<1410000 S LRPERH=0,LRPERY=-1 Q
123 S LRPERY=$E(X,1,3),LRPERM=$E(X,4,5),LRPERD=$E(X,6,7)
124 S LRPERT=$E(X_0,9,10)*60+$E(X_"000",11,12)*60+$E(X_"00000",13,14)
125 S LRPERH=LRPERM>2&'(LRPERY#4)+$P("^31^59^90^120^151^181^212^243^273^304^334","^",LRPERM)+LRPERD
126 S LRPER='LRPERM!'LRPERD,LRPERY=LRPERY-141,LRPERH=LRPERH+(LRPERY*365)+(LRPERY\4)-(LRPERY>59)+LRPER,LRPERY=$S(LRPER:-1,1:LRPERH+4#7)
127 I $G(X(1)) D
128 . S LRPER=$E(X(1)_"0",1,2)*60+$E(X(1)_"000",3,4)*60+$E(X(1)_"00000",5,6)
129 Q
130DTF(Y1) ;; Convert Fileman Date format to mmm dd yyyy:hhmm.ss
131 N Y
132 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)
133 S Y=Y_$P("@"_$E(Y1_0,9,10)_":"_$E(Y1_"000",11,12),"^",Y1[".")
134 S Y=Y_$S($E(Y1,13,14):":"_$E(Y1_0,13,14),1:"")
135 Q Y
136 ;
Note: See TracBrowser for help on using the repository browser.