source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULO.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1TIULO ; SLC/JER - Embedded Objects ;11/29/02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**34,70,101,148,204**;Jun 20, 1997
3DEM(DFN,VADM) ; Calls DEM^VADPT
4 D DEM^VADPT
5 Q
6NAME(DFN) ; Patient NAME
7 I '$D(VADM(1)) D DEM(DFN,.VADM)
8 Q $S(VADM(1)]"":VADM(1),1:"NAME UNKNOWN")
9SSN(DFN) ; Patient SSN
10 I '$D(VADM(2)) D DEM(DFN,.VADM)
11 Q $S($P(VADM(2),U,2)]"":$P(VADM(2),U,2),1:"SSN UNKNOWN")
12AGE(DFN) ; Patient AGE
13 I '$D(VADM(4)) D DEM(DFN,.VADM)
14 Q $S(VADM(4)]"":VADM(4),1:"AGE UNKNOWN")
15DOB(DFN) ; Patient DATE OF BIRTH
16 I '$D(VADM(3)) D DEM(DFN,.VADM)
17 Q $S($P(VADM(3),U,2)]"":$P(VADM(3),U,2),1:"DOB UNKNOWN")
18DOD(DFN) ; Patient DATE OF DEATH
19 I '$D(VADM(6)) D DEM(DFN,.VADM)
20 Q $S($P(VADM(6),U,2)]"":$P(VADM(6),U,2),1:"DATE OF DEATH UNKNOWN")
21SEX(DFN) ; Patient SEX
22 I '$D(VADM(5)) D DEM(DFN,.VADM)
23 Q $S($P(VADM(5),U,2)]"":$P(VADM(5),U,2),1:"SEX UNKNOWN")
24RACE(DFN) ; Patient RACE TIU*148
25 N TIUI
26 I '$D(VADM(12)) D DEM(DFN,.VADM)
27 I +$G(VADM(12))=1 S X=$P($G(VADM(12,1)),U,2)
28 I +$G(VADM(12))>1 D
29 . S X=$P($G(VADM(12,1)),U,2) F TIUI=2:1:VADM(12) D
30 . . S X=X_", "_$P($G(VADM(12,TIUI)),U,2)
31 I +$G(VADM(12))=0,$P(VADM(8),U,2)="" S X="RACE UNKNOWN"
32 I +$G(VADM(12))=0,$P(VADM(8),U,2)]"" S X=$P(VADM(8),U,2)
33 Q X
34ETHNIC(DFN) ; Patient ETHNICITY TIU*148
35 N TIUI
36 I '$D(VADM(11,1)) D DEM(DFN,.VADM)
37 I +$G(VADM(11))=0 S X="ETHNICITY UNKNOWN"
38 I +$G(VADM(11))=1 S X=$P($G(VADM(11,1)),U,2)
39 I +$G(VADM(11))>1 D
40 . S X=$P($G(VADM(11,1)),U,2) F TIUI=2:1:VADM(11) D
41 . . S X=X_", "_$P($G(VADM(11,TIUI)),U,2)
42 I +$G(VADM(11))=0 S X="ETHNICITY UNKNOWN"
43 Q X
44HEIGHT(DFN) ; Gets most recent Height from VITALS
45 Q $$DOVITALS(DFN,"HT")
46WEIGHT(DFN) ; Gets most recent Weight from VITALS
47 Q $$DOVITALS(DFN,"WT")
48TEMP(DFN) ; Gets most recent Temperature from VITALS
49 Q $$DOVITALS(DFN,"T")
50PULSE(DFN) ; Gets most recent Pulse from VITALS
51 Q $$DOVITALS(DFN,"P")
52RESP(DFN) ; Gets most recent Respiration from VITALS
53 Q $$DOVITALS(DFN,"R")
54BP(DFN) ; Gets most recent Blood Pressure from VITALS
55 Q $$DOVITALS(DFN,"BP")
56PAIN(DFN) ; Gets most recent Pain score from VITALS
57 Q $$DOVITALS(DFN,"PN")
58DOVITALS(DFN,TIUVITC) ; INTERNAL ROUTINE TO GET SPECIFIED VITALS (**34**)
59 N TIUVIT,TIUVT,TIUVDT,TIUVDA,TIUY,VDT,TIUI,TIUCWRAP,TIUMAXW
60 N TIUVCNT,TIUVCNT2,TIUVDONE,TIUVDATE,TIUY1,TIUVTEMP,CONV
61 D VITALS(.TIUVIT,DFN,TIUVITC)
62 S (TIUVDT,TIUVDONE,TIUVCNT)=0
63 F S TIUVDT=$O(TIUVIT(TIUVITC,TIUVDT)) Q:+TIUVDT'>0!TIUVDONE D
64 . S TIUVDA=0
65 . F S TIUVDA=$O(TIUVIT(TIUVITC,TIUVDT,TIUVDA)) Q:+TIUVDA'>0!TIUVDONE D
66 . . I $D(TIUVDATE),TIUVDATE'=TIUVDT S TIUVDONE=1
67 . . E D
68 . . . S TIUVDATE=TIUVDT,TIUVCNT=TIUVCNT+1
69 . . . S TIUVTEMP=$G(TIUVIT(TIUVITC,TIUVDT,TIUVDA))
70 . . . S VDT=$$DATE^TIULS($P(TIUVTEMP,U,1),"MM/DD/CCYY HR:MIN")
71 . . . S TIUY=$P(TIUVTEMP,U,8)
72 . . . I TIUVITC="WT" D
73 . . . . Q:+TIUY'>0
74 . . . . S CONV=$J((+TIUY/2.2),3,1)
75 . . . . S TIUY=TIUY_" lb ["_CONV_" kg]"
76 . . . I TIUVITC="HT" D
77 . . . . Q:+TIUY'>0
78 . . . . S CONV=$J((+TIUY*2.54),3,1)
79 . . . . S TIUY=TIUY_" in ["_CONV_" cm]"
80 . . . I TIUVITC="T" D
81 . . . . Q:+TIUY'>0
82 . . . . S CONV=+TIUY-32
83 . . . . S CONV=$J((CONV*(5/9)),3,1)
84 . . . . S TIUY=TIUY_" F ["_CONV_" C]"
85 . . . S TIUY=TIUY_" ("_VDT
86 . . . S TIUCWRAP=$L(TIUY)+17
87 . . . I TIUVCNT=1 S TIUY1=TIUY_")",TIUMAXW=59
88 . . . E S TIUY=" "_TIUY,TIUMAXW=74
89 . . . S TIUVTEMP=$P(TIUVTEMP,U,17)
90 . . . I $L(TIUVTEMP)>0 D
91 . . . . S TIUVTEMP=", "_TIUVTEMP
92 . . . . F S TIUI=$F(TIUVTEMP,";") Q:TIUI'>0 D
93 . . . . . S TIUVTEMP=$E(TIUVTEMP,1,TIUI-2)_", "_$E(TIUVTEMP,TIUI,999)
94 . . . S TIUY=TIUY_TIUVTEMP_")"
95 . . . I $L(TIUY)<TIUMAXW S TIUVITMP(TIUVCNT,0)=TIUY
96 . . . E D ; Wrap the line if it's too long
97 . . . . S TIUVCNT2=0,TIUVTEMP="",$P(TIUVTEMP," ",TIUCWRAP)=" "
98 . . . . F Q:$L(TIUY)'>0 D
99 . . . . . F TIUI=TIUMAXW:-1:1 Q:$E(TIUY,TIUI,TIUI+1)=", "
100 . . . . . I TIUI>1 D
101 . . . . . . S TIUVITMP(TIUVCNT+TIUVCNT2,0)=$E(TIUY,1,TIUI)
102 . . . . . . S TIUVCNT2=TIUVCNT2+.01
103 . . . . . . S TIUY=TIUVTEMP_$E(TIUY,TIUI+2,999)
104 . . . . . E D
105 . . . . . . S TIUVITMP(TIUVCNT+TIUVCNT2,0)=TIUY
106 . . . . . . S TIUY=""
107 I TIUVCNT<2 D
108 . S TIUY=$G(TIUY1)
109 . K TIUVITMP
110 E S TIUY="~@TIUVITMP"
111 Q $G(TIUY)
112VITALS(TIUY,DFN,GMRVSTR,TIUEDT,TIULDT,TIUOCC) ; Vital measurements
113 N TIUVT,TIUVDT,TIUVDA K ^UTILITY($J,"GMRVD")
114 S GMRVSTR(0)=$G(TIUEDT)_U_$G(TIULDT)_U_$G(TIUOCC,1)_"^0"
115 I $L($T(EN1^GMRVUT0)) D EN1^GMRVUT0
116 I +$D(^UTILITY($J,"GMRVD")) D
117 . S TIUVT=""
118 . F S TIUVT=$O(^UTILITY($J,"GMRVD",TIUVT)) Q:TIUVT']"" D
119 . . S TIUVDT=0
120 . . F S TIUVDT=$O(^UTILITY($J,"GMRVD",TIUVT,TIUVDT)) Q:+TIUVDT'>0 D
121 . . . S TIUVDA=0
122 . . . F S TIUVDA=$O(^UTILITY($J,"GMRVD",TIUVT,TIUVDT,TIUVDA)) Q:+TIUVDA'>0 D
123 . . . . S TIUY(TIUVT,TIUVDT,TIUVDA)=$G(^UTILITY($J,"GMRVD",TIUVT,TIUVDT,TIUVDA))
124 K ^UTILITY($J,"GMRVD")
125 Q
126LIPIDS(TIUY,DFN,TIUEDT,TIULDT) ; Get LIPID profile
127 N TIUTST,TIUI,TIURY,TIUDT,TIULDT
128 S TIUTST=$O(^LAB(60,"B","LIPID PROFILE",0))
129 I '+$G(TIUTST) Q
130 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUTST)
131 I '$D(TIUY)!($G(TIUY(1))="No Lab Data") Q
132 S TIUI=0 F S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0 D
133 . S TIUTST=$$MAPPER($P(@TIUY@(TIUI),U,17)),TIUDT=+@TIUY@(TIUI)
134 . S:TIUDT'=+$G(TIULDT) TIURY("BASELINE LIPID PROFILES",TIUDT)=$$DATE^TIULS(TIUDT,"MM/DD/YY")
135 . S TIURY(TIUTST,TIUDT)=$P(@TIUY@(TIUI),U,4)
136 F TIUI="CHYLOMI","TURBID","VLDL" K TIURY(TIUI)
137 K @TIUY
138 I $D(TIURY) M TIUY=TIURY
139 Q
140MAPPER(TIUX,TIUI) ; Remap test names
141 N TIUNM,Y S TIUNM("CHOL","TOTAL CHOLESTEROL")=""
142 S (TIUNM("HDL","HDL CHOLESTEROL"),TIUNM("LDL","LDL CHOLESTEROL"))=""
143 S TIUNM("TRIGLYC","TRIGLYCERIDES")=""
144 S Y=$O(TIUNM(TIUX,"")) I Y']"" S Y=TIUX
145 Q Y
146TSHT4(DFN,TIUEDT,TIULDT) ; Get TSH/T4
147 N TIUY,TIUTSH,TIUT4 S TIUTSH=+$O(^LAB(60,"B","TSH",0))
148 S TIUT4=+$O(^LAB(60,"B","T-4",0))
149 I '+$G(TIUTSH)!'+$G(TIUT4) G TSHX
150 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUTSH)
151 S TIUTSH=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
152 I $D(TIUY)#2 K @TIUY
153 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUT4)
154 S TIUT4=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
155 I $D(TIUY)#2 K @TIUY
156 S TIUY=TIUTSH_"/"_TIUT4
157TSHX Q $G(TIUY)
158SGOT(DFN,TIUEDT,TIULDT) ; Get SGOT
159 N TIUY,TIUSGOT S TIUSGOT=+$O(^LAB(60,"B","SGOT",0))
160 I '+$G(TIUSGOT) Q
161 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUSGOT)
162 S TIUSGOT=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
163 I $D(TIUY)#2 K @TIUY
164SGOTX Q $G(TIUSGOT)
165HGBA1C(DFN,TIUEDT,TIULDT) ; Get Hemoglobin A1C
166 N TIUY,TIUHGB S TIUHGB=+$O(^LAB(60,"B","HEMOGLOBIN A1C",0))
167 I '+$G(TIUHGB) G HGBX
168 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUHGB)
169 S TIUHGB=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
170 I $D(TIUY)#2 K @TIUY
171HGBX Q $G(TIUHGB)
172URICACID(DFN,TIUEDT,TIULDT) ; Get Uric Acid
173 N TIUY,TIUURIC S TIUURIC=+$O(^LAB(60,"B","URIC ACID",0))
174 I '+$G(TIUURIC) G URICX
175 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUURIC)
176 S TIUURIC=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
177 I $D(TIUY)#2 K @TIUY
178URICX Q $G(TIUURIC)
179FBG(DFN,TIUEDT,TIULDT) ; Get FBG
180 N TIUY,TIUFBG S TIUFBG=+$O(^LAB(60,"B","FBS",0))
181 I '+$G(TIUFBG) G FBGX
182 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUFBG)
183 S TIUFBG=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
184 I $D(TIUY)#2 K @TIUY
185FBGX Q $G(TIUFBG)
186ADM(DFN) ;Current Admission Date/Time
187 N VAIN,J
188 D INP^VADPT
189 S J=$P(VAIN(7),U,2),J(1)=$P(J,"@",1),J(2)=$P(J,"@",2),J(3)=$E(J(2),1,5),Y=J(1)_" "_J(3) K J
190ADMX Q Y
191TODAY() ;Today's Date
192 N X,Y
193 S X=$G(DT) I X'="" S Y=X D DD^%DT
194TODAYX Q Y
195NOW() ;Current Date/Time
196NOWX Q $$DATE^TIULS($$NOW^TIULC,"AMTH DD, CCYY HR:MIN")
Note: See TracBrowser for help on using the repository browser.