source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDKRPC1.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1MDKRPC1 ;HIOFO/FT-RPC to return patient data ;2/19/08 13:13
2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
3 ;
4 ; This routine uses the following IAs:
5 ; #1239 - ^PXRHS03 (controlled)
6 ; #1240 - ^PXRHS04 (private)
7 ; #1625 - ^XUA4A72 (supported)
8 ; #2263 - ^XPAR (supported)
9 ; #2864 - ^TIUPP3 calls (controlled)
10 ; #3065 - ^XLFNAME (supported)
11 ; #3556 - ^LA7QRY (controlled)
12 ; #10035 - ^DPT global refs (supported)
13 ; #10060 - ^FILE 200 refs (supported)
14 ; #10099 - ^GMRADPT calls (supported)
15 ; #10103 - ^XLFDT calls (supported)
16 ; #4868 - VA(200,"AUSER" (Private)
17 ;
18RPC(RESULT,OPTION,DATA) ; RPC to return existing VistA patient data for
19 ; renal dialysis data entry.
20 ; RPC: [MDK GET VISTA DATA]
21 ;
22 ; Input parameters
23 ; 1. RESULT [Reference/Required] RPC Return array
24 ; 2. OPTION [Literal/Required] RPC Option to execute
25 ; 3. DATA [Literal/Required] Other data as required for call
26 ;
27 K RESULT
28 D:$T(@OPTION)]"" @OPTION
29 S:'$D(RESULT) RESULT(0)="-1^No results returned"
30 Q
31DEMO ; demographic
32 N DFN,MDKNODE0,MDKSSN
33 S DFN=$G(DATA)
34 I '$G(DFN) D Q
35 .S RESULT(0)="-1^DFN is not defined"
36 .Q
37 I '$D(^DPT(DFN,0)) D Q
38 .S RESULT(0)="-1^Patient not found"
39 .Q
40 S MDKNODE0=$G(^DPT(DFN,0))
41 S RESULT(1)=$P(MDKNODE0,U,1) ;name
42 S RESULT(2)=$P(MDKNODE0,U,9) ;ssn
43 S RESULT(3)=$P(MDKNODE0,U,3) ;date of birth
44 S RESULT(0)=3
45 Q
46ALLERGY ; get allergy data
47 ; DATA = DFN
48 S DFN=$G(DATA)
49 N GMRAL
50 N MDKCNT,MDLOOP
51 S (MDKCNT,MDKLOOP)=0
52 D EN1^GMRADPT
53 I $O(GMRAL(0))'>0 D Q
54 .S:$G(GMRAL)="" RESULT(1)="No Allergy Assessment"
55 .S:$G(GMRAL)=0 RESULT(1)="No Known Allergies"
56 .S RESULT(0)=1
57 .Q
58 I $O(GMRAL(0))>0 D
59 .F S MDKLOOP=$O(GMRAL(MDKLOOP)) Q:MDKLOOP'>0 D
60 ..S MDKCNT=MDKCNT+1
61 ..S RESULT(MDKCNT)=$P($G(GMRAL(MDKLOOP)),U,2)
62 ..Q
63 .S RESULT(0)=MDKCNT
64 .Q
65 Q
66SHOTS ; get latest vaccination data
67 N MDKCNT,MDKDATE,MDKIEN,MDKIMMUM,MDKNAME,MDKNODE
68 S DFN=$G(DATA)
69 S (MDKCNT,RESULT(0))=0
70 S MDKIMMUM("HEP A")="HEPATITIS A"
71 S MDKIMMUM("HEP B")="HEPATITIS B"
72 S MDKIMMUM("INFLUENZA")="FLU"
73 S MDKIMMUM("PNEUMO-VAC")="PNEUMOCOCCAL"
74 ;S MDKIMMUM("PNEUMOCOCCAL")="PNEUMONIA"
75 S MDKIMMUM("PPD")="PPD"
76 D IMMUN^PXRHS03(DFN)
77 F MDKNAME="HEP A","HEP B","INFLUENZA","PNEUMO-VAC" D
78 .Q:'$D(^TMP("PXI",$J,MDKNAME))
79 .S MDKDATE=0
80 .F S MDKDATE=$O(^TMP("PXI",$J,MDKNAME,MDKDATE)) Q:'MDKDATE D
81 ..S MDKIEN=0
82 ..F S MDKIEN=$O(^TMP("PXI",$J,MDKNAME,MDKDATE,MDKIEN)) Q:'MDKIEN D
83 ...S MDKNODE=$G(^TMP("PXI",$J,MDKNAME,MDKDATE,MDKIEN,0))
84 ...Q:MDKNODE=""
85 ...S MDKCNT=MDKCNT+1
86 ...;RESULT(N)=shot name^date^reaction^contraindicated
87 ...S RESULT(MDKCNT)=MDKIMMUM(MDKNAME)_U_$P(MDKNODE,U,3)_U_$P(MDKNODE,U,6)_U_$P(MDKNODE,U,7)
88 ...Q
89 ..Q
90 .Q
91 S RESULT(0)=MDKCNT
92 K ^TMP("PXI",$J)
93 ; get PPD (skin) result
94 D SKIN^PXRHS04(DFN)
95 I $D(^TMP("PXS",$J)) D
96 .S MDKDATE=0
97 .F S MDKDATE=$O(^TMP("PXS",$J,"PPD",MDKDATE)) Q:'MDKDATE D
98 ..S MDKIEN=0
99 ..F S MDKIEN=$O(^TMP("PXS",$J,"PPD",MDKDATE,MDKIEN)) Q:'MDKIEN D
100 ...S MDKNODE=$G(^TMP("PXS",$J,"PPD",MDKDATE,MDKIEN,0))
101 ...Q:MDKNODE=""
102 ...S MDKCNT=MDKCNT+1
103 ...;RESULT(N)=skin test^date
104 ...S RESULT(MDKCNT)=$P(MDKNODE,U,1)_U_$P(MDKNODE,U,2)
105 ...S RESULT(0)=MDKCNT
106 ...Q
107 ..Q
108 .Q
109 K ^TMP("PXS",$J)
110 Q
111LAB ; get lab results
112 ; data = dfn^start date^end date^max # of entires to return
113 N LA7PTID,LA7SDT,LA7EDT,LA7SC,LA7SPEC
114 N MDK64PTR,MDKARRAY,MDKCNT,MDKCODE,MDKDATE,MDKEDT,MDKFLAG,MDKLOOP,MDKMAX,MDKNLT,MDKNODE,MDKODT,MDKRSULT
115 N MDKSC,MDKSDT,MDKSSN,MDKTEST,MDKTOT,MDKUNIT
116 S DATA=$G(DATA)
117 S DFN=$P(DATA,U,1)
118 Q:'DFN
119 S MDKSDT=$P(DATA,U,2) ;start date
120 S MDKEDT=$P(DATA,U,3) ;end date
121 S MDKMAX=+$P(DATA,U,4) ;# of entries per test
122 S MDKSSN=$P($G(^DPT(DFN,0)),U,9) ;patient ssn
123 I MDKEDT="" S MDKEDT=$$NOW^XLFDT()
124 ;I MDKSDT="" S MDKSDT=$$FMADD^XLFDT(DT,-90) ;go back 90 days
125 I MDKSDT="" S MDKSDT=$$FMADD^XLFDT(DT,-365) ;<-- TESTING ONLY
126 I 'MDKMAX S MDKMAX=3
127 ; array(nlt code)=test name
128 S MDKSC("84520.")="BUN"
129 S MDKSC("82565.")="CREATININE"
130 S MDKSC("84295.")="SODIUM"
131 S MDKSC("84140.")="POTASSIUM"
132 S MDKSC("82435.")="CHLORIDE"
133 S MDKSC("82830.")="CARBON DIOXIDE"
134 S MDKSC("82310.")="CALCIUM"
135 S MDKSC("84100.")="PHOSPHORUS"
136 S MDKSC("82040.")="ALBUMIN"
137 S MDKSC("84455.")="AST"
138 S MDKSC("84465.")="ALT"
139 S MDKSC("84075.")="ALKALINE PHOSPHATASE"
140 S MDKSC("82250.")="BILIRUBIN"
141 S MDKSC("83020.")="HEMOGLOBIN"
142 S MDKSC("85055.")="HEMATOCRIT"
143 S MDKSC("85569.")="WBC"
144 S MDKSC("86806.")="PLATELETS"
145 S MDKSC("83057.")="HEMOGLOBIN A1C"
146 S MDKSC("82466.")="CHOLESTEROL"
147 S MDKSC("84480.")="TRIGLYCERIDES"
148 S MDKSC("82370.")="FERRITIN"
149 S MDKSC("83540.")="IRON"
150 S MDKSC("82060.")="TRANSFERRIN"
151 S MDKSC("84012.")="PARATHRYROID HORMONE"
152 S MDKSC("81512.")="ALUMINUM"
153 S MDKSC("89068.")="HEPATITIS B SURFACE ANTIGEN"
154 S MDKSC("89065.")="HEPATITIS B SURFACE ANTIBODY"
155 S MDKSC("89067.")="HEPATITIS B SURFACE ANTIBODY"
156 S MDKSC("82013.")="HEPATITIS B SURFACE ANTIBODY"
157 S MDKSC("89095.")="HEPATITIS B SURFACE ANTIBODY"
158 S MDKSC("89127.")="HEPATITIS B SURFACE ANTIBODY"
159 S MDKSC("89128.")="HEPATITIS B SURFACE ANTIBODY"
160 S MDKSC("87398.")="HEPATITIS B SURFACE ANTIBODY"
161 S MDKSC("89699.")="HEPATITIS B SURFACE ANTIBODY"
162 S MDKSC("89070.")="HEPATITIS C ANTIBODY"
163 S MDKSC("87261.")="FLU"
164 K ^TMP("HLS",$J)
165 S LA7SDT=MDKSDT_"^RAD" ;start date
166 S LA7EDT=MDKEDT_"^RAD" ;end date
167 S LA7SC="CH" ;all chemistry tests
168 S LA7SPEC="*" ;all specimens
169 S LA7PTID=MDKSSN ;patient's ssn
170 S MDKARRAY=$$GCPR^LA7QRY(LA7PTID,LA7SDT,LA7EDT,.LA7SC,LA7SPEC,"","","")
171 S (MDKCNT,MDKTOT)=0
172 F S MDKCNT=$O(^TMP("HLS",$J,MDKCNT)) Q:'MDKCNT D
173 .S MDKNODE=$G(^TMP("HLS",$J,MDKCNT))
174 .Q:$E(MDKNODE,1,3)'="OBX"
175 .S MDKFLAG=0
176 .S MDKTEST=$P(MDKNODE,"|",4) ;test ids
177 .S MDKCODE=""
178 .F S MDKCODE=$O(MDKSC(MDKCODE)) Q:MDKCODE=""!(MDKFLAG=1) D
179 ..I MDKTEST[MDKCODE S MDKFLAG=1,MDKNLT=MDKCODE
180 ..Q
181 .Q:'MDKFLAG ;nlt code doesn't match
182 .S MDKDATE=$P(MDKNODE,"|",15) ;date
183 .S MDKDATE=$P(MDKDATE,"-",1) ;strip off time zone offset
184 .S MDKRSULT=$P(MDKNODE,"|",6) ;result
185 .S MDKUNIT=$P(MDKNODE,"|",7) ;unit
186 .S MDKTOT=MDKTOT+1
187 .S RESULT(MDKTOT)=$G(MDKSC(MDKNLT))_U_MDKDATE_U_MDKRSULT_U_MDKUNIT
188 .S RESULT(0)=$G(RESULT(0))+1
189 .Q
190 K ^TMP("HLS",$J)
191 Q
192AD ; get advance directives
193 ; DATA = DFN
194 S DFN=$G(DATA)
195 N MDKLOOP
196 K ^TMP("TIUPPCV",$J)
197 D ENCOVER^TIUPP3(DFN)
198 I '$D(^TMP("TIUPPCV",$J)) Q
199 S RESULT(1)="No",RESULT(0)=1
200 S MDKLOOP=0
201 F S MDKLOOP=$O(^TMP("TIUPPCV",$J,MDKLOOP)) Q:'MDKLOOP D
202 .I $P(^TMP("TIUPPCV",$J,MDKLOOP),U,2)'="D" Q
203 .S RESULT(1)="Yes"
204 .S RESULT(0)=1
205 .Q
206 K ^TMP("TIUPPCV",$J)
207 Q
208 ;
209CW ; get clinical warnings
210 ; DATA = DFN
211 S DFN=$G(DATA)
212 N MDKCNT,MDKLOOP
213 K ^TMP("TIUPPCV",$J)
214 D ENCOVER^TIUPP3(DFN)
215 S RESULT(1)="None",RESULT(0)=1
216 I '$D(^TMP("TIUPPCV",$J)) Q
217 S (MDKCNT,MDKLOOP)=0
218 F S MDKLOOP=$O(^TMP("TIUPPCV",$J,MDKLOOP)) Q:'MDKLOOP D
219 .I $P(^TMP("TIUPPCV",$J,MDKLOOP),U,2)'="W" Q
220 .S MDKCNT=MDKCNT+1
221 .S RESULT(MDKCNT)=^TMP("TIUPPCV",$J,MDKLOOP)
222 .Q
223 S RESULT(0)=MDKCNT
224 K ^TMP("TIUPPCV",$J)
225 Q
226 ;
227GETPROV ; Get list of available providers with name starting with P1
228 N MDDATE,MDDUP,MDRI,MDI1,MDI2,MDLAST,MDMAX,MDPREV,MDTTL
229 S MDRI=0,MDMAX=44,(MDLAST,MDPREV)="",X1=DT,MDFROM=DATA,MDDATE=DT
230 F Q:MDRI'<MDMAX S MDFROM=$O(^VA(200,"AUSER",MDFROM),1) Q:MDFROM="" D
231 .S MDI1=""
232 .F S MDI1=$O(^VA(200,"AUSER",MDFROM,MDI1),1) Q:'MDI1 D
233 ..I MDDATE>0,$$GET^XUA4A72(MDI1,MDDATE)<1 Q ; Check date?
234 ..S MDRI=MDRI+1,RESULT(MDRI)=MDI1_U_$$NAMEFMT^XLFNAME(MDFROM,"F","DcMPC")
235 I MDRI<1 S RESULT(0)="-1^No matches found." Q
236 S RESULT(0)=MDRI
237 Q
238 ;
239TIME ; Get time
240 S RESULT(0)=$$NOW^XLFDT()
241 Q
242GETLD ; Get MDK Application Install Info
243 N MDS
244 S MDS=$$GET^XPAR("SYS","MDK APPLICATION INSTALL","DATE_TIME_OF_LAUNCH")
245 S MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","USER")
246 S MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","OPTION_LOADED")
247 S MDS=MDS_"^"_$$GET^XPAR("SYS","MDK APPLICATION INSTALL","WORKSTATION")
248 S RESULT(0)=MDS
249 Q
250SETLD ; Set MDK Application Install Info
251 D EN^XPAR("SYS","MDK APPLICATION INSTALL","DATE_TIME_OF_LAUNCH",$P(DATA,"^"))
252 D EN^XPAR("SYS","MDK APPLICATION INSTALL","USER",$P(DATA,"^",2))
253 D EN^XPAR("SYS","MDK APPLICATION INSTALL","OPTION_LOADED",$P(DATA,"^",3))
254 D EN^XPAR("SYS","MDK APPLICATION INSTALL","WORKSTATION",$P(DATA,"^",4))
255 Q
Note: See TracBrowser for help on using the repository browser.