source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGDQR03.m@ 1538

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1MAGDQR03 ;WOIFO/EdM - Imaging RPCs for Query/Retrieve ; 05/16/2005 08:45
2 ;;3.0;IMAGING;**51**;26-August-2005
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20RESULT N E,L,OK,V,X,T
21 S OK=1
22 S T="" F S T=$O(REQ(T)) Q:T="" D
23 . S L=$TR(T,",")
24 . S E=$TR($E(L,1),"0123456789abcdef","QRSTUVWXYZABCDEF")
25 . S $E(L,1)=E S:L'?8UN L=""
26 . I L'="",$T(@L)'="" D @L Q
27 . D ERR^MAGDQR01("Undefined tag: """_T_""".") S OK=0
28 . Q
29 Q:'OK
30 ;
31 S ANY=ANY+1
32 D
33 . N R1,V1,V2,VAL
34 . S R1=$O(^MAGDQR(2006.5732,RESULT,1," "),-1)+1
35 . S ^MAGDQR(2006.5732,RESULT,1,R1,0)="0000,0902^Result # "_ANY
36 . S T="" F S T=$O(V(T)) Q:T="" D
37 . . S VAL=$G(V(T))
38 . . S V1="" F S V1=$O(V(T,V1)) Q:V1="" D
39 . . . Q:$G(V(T,V1))=""
40 . . . S:VAL'="" VAL=VAL_"\" S VAL=VAL_V(T,V1)
41 . . . Q
42 . . S R1=R1+1,^MAGDQR(2006.5732,RESULT,1,R1,0)=T_"^"_VAL
43 . . S ^MAGDQR(2006.5732,RESULT,1,"B",T,R1)=""
44 . . Q:$D(V(T))<10
45 . . S V1="" F S V1=$O(V(T,V1)) Q:V1="" D
46 . . . S V2="" F S V2=$O(V(T,V1,V2)) Q:V2="" D
47 . . . . S VAL=$G(V(T,V1,V2)) Q:VAL=""
48 . . . . S R1=R1+1,^MAGDQR(2006.5732,RESULT,1,R1,0)=T_"^"_VAL
49 . . . . S ^MAGDQR(2006.5732,RESULT,1,"B",T,R1)=""
50 . . . . Q
51 . . . Q
52 . . Q
53 . Q
54 Q
55 ;
56COMPARE(TAG,ACTUAL) N LOC,TMP,WILD
57 Q:'$G(REQ(TAG)) 1
58 S WILD=$G(REQ(TAG,1)) Q:WILD="" 0
59 Q:$G(ACTUAL)="" 0
60 S LOC(ACTUAL)=""
61 Q $$MATCHD(WILD,"LOC(LOOP)","TMP(LOOP)")
62 ;
63MATCH1(X,Y) N I,M
64 F Q:X="" Q:Y="" D
65 . I $E(X,1)=$E(Y,1) S X=$E(X,2,$L(X)),Y=$E(Y,2,$L(Y)) Q
66 . I $E(Y,1)="?" S X=$E(X,2,$L(X)),Y=$E(Y,2,$L(Y)) Q
67 . I $E(Y,1)="*" D Q:M
68 . . I Y="*" S (X,Y)="",M=1 Q
69 . . S Y=$E(Y,2,$L(Y)),M=0
70 . . F I=1:1:$L(X) I $$MATCH1($E(X,I,$L(X)),Y) S M=1,X=$E(X,I,$L(X)) Q
71 . . Q
72 . S X="!",Y=""
73 . Q
74 S:$TR(Y,"*")="" Y="" Q:X'="" 0 Q:Y'="" 0
75 Q 1
76 ;
77MATCHD(WILDCARD,STRUCTUR,FOUND) N C,LOOP,L1,L9,SEEK,X,Y
78 ; -- Scans a structure,
79 ; reports entries in @STRUCTUR that match WILDCARD;
80 ; the result is reported in local array @FOUND
81 S C=0
82 S L1=$P($P(WILDCARD,"?",1),"*",1),L9=L1_"~"
83 I L1=WILDCARD D Q C
84 . S LOOP=L1
85 . I $D(@STRUCTUR) S @FOUND="" Q
86 . Q
87 S LOOP=L1 F D S LOOP=$O(@STRUCTUR) Q:LOOP="" Q:LOOP]]L9
88 . Q:LOOP="" Q:'$D(@STRUCTUR)
89 . Q:'$$MATCH1(LOOP,WILDCARD)
90 . S C=C+1
91 . S @FOUND=""
92 . Q
93 Q C
94 ;
95Q0080020 ;R Study Date
96 S V(T)=$P($G(^MAG(2005,IMAGE,2)),"^",5)\1+17000000
97 Q
98 ;
99Q0080030 ;R Study Time
100 S V(T)=$TR($J("."_$P($P($G(^MAG(2005,IMAGE,2)),"^",5),".",2)*1E6,6)," ",0)
101 Q
102 ;
103Q0080050 ;R Accession Number
104 S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) ; IA # 1172
105 S V(T)=$P($G(^RARPT(+X,0)),"^",1) ; IA # 1171
106 Q
107 ;
108Q0100010 ;R Patient's Name
109 S V(T)=$P($G(^DPT(MAGD0,0)),"^",1) ; No IA needed, PIMS 5.3
110 Q
111 ;
112Q0100020 ;R Patient ID
113 S V(T)=$P($G(^DPT(MAGD0,0)),"^",9) ; No IA needed, PIMS 5.3
114 Q
115 ;
116Q0200010 ;R Study ID
117 S V(T)=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",1) ; IA # 1172
118 Q
119 ;
120Q020000D ;U Study Instance UID
121 S V(T)=$P($G(^MAG(2005,IMAGE,"PACS")),"^",1)
122 Q
123 ;
124Q0080061 ;O Modalities in Study
125 N P1,P2,R
126 S R=""
127 S P1=0 F S P1=$O(^MAG(2005,IMAGE,1,P1)) Q:'P1 D
128 . S P2=+$G(^MAG(2005,IMAGE,1,P1,0)) Q:'P2
129 . S X=$P($G(^MAG(2005,P2,0)),"^",8) Q:$E(X,1,4)'="RAD"
130 . S:R'="" R=R_"," S R=R_$E(X,5,$L(X))
131 . Q
132 S V(T)=R
133 S:'$$COMPARE(T,V(T)) OK=0
134 Q
135 ;
136Q0080062 ;O SOP Classes in Study
137 ; --- probably not supported --- ?
138 ; ? ? ?
139 Q
140 S:'$$COMPARE(T,V(T)) OK=0
141 Q
142 ;
143Q0080090 ;O Referring Physician's Name
144 S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",14) ; IA # 1172
145 S V(T)=$P($G(^VA(200,+X,0)),"^",1)
146 S:'$$COMPARE(T,V(T)) OK=0
147 Q
148 ;
149Q0081030 ;O Study Description
150 S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",2) ; IA # 1172
151 S V(T)=$P($G(^RAMIS(71,+X,0)),"^",1) ; IA # 1174
152 S:'$$COMPARE(T,V(T)) OK=0
153 Q
154 ;
155Q0081032 ;O Procedure Code Sequence
156 Q
157 ;
158Q0080100 ;O >Code Value
159 S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",2) ; IA # 1172
160 S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174
161 S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference
162 S V("0008,1030",1,T)=$P(X,"^",2)
163 Q
164 ;
165Q0080102 ;O >Coding Scheme Designator
166 S V("0008,1030",1,T)="C4"
167 Q
168 ;
169Q0080103 ;O >Coding Scheme Version
170 S V("0008,1030",1,T)=4
171 Q
172 ;
173Q0080104 ;O >Code Meaning
174 S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",2) ; IA # 1172
175 S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174
176 S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference
177 S V("0008,1030",1,T)=$P(X,"^",3)
178 Q
179 ;
180Q0081060 ;O Name of Physician(s) Reading Study
181 S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) ; IA # 1172
182 S X=$P($G(^RARPT(+X,0)),"^",9) ; IA # 1171
183 S V(T)=$P($G(^VA(200,+X,0)),"^",1)
184 S:'$$COMPARE(T,V(T)) OK=0
185 Q
186 ;
187Q0081080 ;O Admitting Diagnoses Description
188 ; ? ? ?
189 ;;;S:'$$COMPARE(T,V(T)) OK=0
190 Q
191 ;
192Q0100021 ;O Issuer of Patient ID
193 S V(T)="USSSA"
194 S:'$$COMPARE(T,V(T)) OK=0
195 Q
196 ;
197Q0100030 ;O Patient's Birth Date
198 S V(T)=$P($G(^DPT(MAGD0,0)),"^",3)\1+17000000
199 S:'$$COMPARE(T,V(T)) OK=0
200 Q
201 ;
202Q0100032 ;O Patient's Birth Time
203 S V(T)=$TR($J("."_$P($P($G(^DPT(MAGD0,0)),"^",3),".",2)*1E6,6)," ",0)
204 S:'$$COMPARE(T,V(T)) OK=0
205 Q
206 ;
207Q0100040 ;O Patient's Sex
208 S V(T)=$P($G(^DPT(MAGD0,0)),"^",2)
209 S:'$$COMPARE(T,V(T)) OK=0
210 Q
211 ;
212Q0101000 ;O Other Patient IDs
213 N DFN,I,VA,VADPT
214 S DFN=+MAGD0 D DEM^VADPT
215 S X=$P(^DPT(DFN,0),"^",9) S:X'="" DFN(X)=""
216 S:$G(VA("PID"))'="" DFN(VA("PID"))=""
217 S:$G(VA("BID"))'="" DFN(VA("BID"))=""
218 S X=$$GETICN^MPIF001(DFN) S:X'="" DFN(X)=""
219 S I=0,X="" F S X=$O(DFN(X)) Q:X="" S I=I+1,V(T,I)=DFN(X)
220 ;;;S:'$$COMPARE(T,V(T)) OK=0
221 Q
222 ;
223Q0101001 ;O Other Patient Names
224 N D1,I
225 S (I,D1)=0 F S D1=$O(^DPT(MAGD0,0.01,D1)) Q:'D1 D
226 . S X=$P($G(^DPT(MAGD0,0.01,D1,0)),"^",1)
227 . S:X'="" I=I+1,V(T,I)=X
228 . Q
229 ;;;S:'$$COMPARE(T,V(T)) OK=0
230 Q
231 ;
232Q0101010 ;O Patient's Age
233 N DD,DM,DY,WHEN
234 S X=$P($G(^DPT(MAGD0,0)),"^",3)
235 S WHEN=9999999.9999-MAGD1 ;;; select one of these two
236 S WHEN=DT ;;; select one of these two
237 S DY=$E(WHEN,1,3)-$E(X,1,3)
238 S DM=$E(WHEN,4,5)-$E(X,4,5)
239 S DD=$E(WHEN,6,7)-$E(X,6,7)
240 S:DD<0 DM=DM-1 S:DM<0 DY=DY-1
241 S V(T)=DY
242 ;;;S:'$$COMPARE(T,V(T)) OK=0
243 Q
244 ;
245Q0001020 ;O Patient's Size
246 S V(T)=$P($G(^DPT(MAGD0,57)),"^",1) ; height in cm - field not populated
247 S:'$$COMPARE(T,V(T)) OK=0
248 Q
249 ;
250Q0101030 ;O Patient's Weight
251 S V(T)=$P($G(^DPT(MAGD0,57)),"^",2) ; weight in kg - field not populated
252 S:'$$COMPARE(T,V(T)) OK=0
253 Q
254 ;
255Q0102160 ;O Ethnic Group
256 S V(T)=$P($G(^DPT(MAGD0,0)),"^",6)
257 S:'$$COMPARE(T,V(T)) OK=0
258 Q
259 ;
260Q0102180 ;O Occupation
261 S V(T)=$P($G(^DPT(MAGD0,0)),"^",7)
262 S:'$$COMPARE(T,V(T)) OK=0
263 Q
264 ;
265Q01021B0 ;O Additional Patient History
266 N D1,I
267 S X=+$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) ; IA # 1172
268 S (D1,I)=0 F S D1=$O(^RARPT(X,"H",D1)) Q:'D1 D ; IA # 1171
269 . S I=I+1,V(T,I)=$G(^RARPT(X,"H",D1,0)) ; IA # 1171
270 . Q
271 ;;;S:'$$COMPARE(T,V(T)) OK=0
272 Q
273 ;
274Q0104000 ;O Patient Comments
275 ; ? ? ?
276 ; (there is a modality that passes the accession number in this field)
277 ;;;S:'$$COMPARE(T,V(T)) OK=0
278 Q
279 ;
280Q0201206 ;O Number of Study Related Series
281 N N,S,UID
282 S UID=$G(V("0020,000D")),N=0
283 I UID'="" S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" S N=N+1
284 S V(T)=N
285 S:'$$COMPARE(T,V(T)) OK=0
286 Q
287 ;
288Q0201208 ;O Number of Study Related Instances
289 N N,P1,P2,S,UID
290 S UID=$G(V("0020,000D")),N=0
291 I UID'="" S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" D
292 . S P1=0 F S P1=$O(^MAG(2005,S,1,P1)) Q:'P1 D
293 . . S P2=+$G(^MAG(2005,S,1,P1,0)) Q:'P2
294 . . S N=N+1
295 . . Q
296 . Q
297 S V(T)=N
298 S:'$$COMPARE(T,V(T)) OK=0
299 Q
300 ;
301U008010C ;O Interpretation Author
302 S X=+$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",12) ; IA # 1172
303 S V(T)=$P($G(^VA(200,X,0)),"^",1)
304 S:'$$COMPARE(T,V(T)) OK=0
305 Q
306 ;
Note: See TracBrowser for help on using the repository browser.