source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGDQR02.m@ 1499

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1MAGDQR02 ;WOIFO/EdM - Imaging RPCs for Query/Retrieve ; 05/16/2005 09:30
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 ;
20QUERY ; --- perform actual query --- Called by TaskMan
21 N ACC,ANY,MAGD0,MAGD1,MAGD2,ERROR,FD,FT,I,IMAGE,L,LD,LT,OFFSET,P,PAT,SID,SSN,T,TIM,UID,V,X
22 ;
23 K ^TMP("MAG",$J,"QR")
24 S (PAT,SSN,ACC,UID,SID,SDT,TIM,ERROR)=0
25 S FD=0,LD=9999999,FT=0,LT=240000
26 ;
27 S T="0008,0020",I=0
28 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
29 . N F,U
30 . S I=I+1 I I>1 D ERR^MAGDQR01("More than one study date specified.") Q
31 . S (X,F,U)=REQ(T,P) S:X["-" F=$P(X,"-",1),U=$P(X,"-",2)
32 . I F'="",F'?8N D ERR^MAGDQR01("Invalid 'from' date: """_F_""".")
33 . I U'="",U'?8N D ERR^MAGDQR01("Invalid 'until' date: """_U_""".")
34 . S FD=+F S:FD FD=FD-17000000
35 . S LD=+U S:LD LD=LD-17000000
36 . S TIM=1
37 . Q
38 ;
39 S T="0008,0030",I=0
40 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
41 . N F,U
42 . S I=I+1 I I>1 D ERR^MAGDQR01("More than one study time specified.") Q
43 . S (X,F,U)=REQ(T,P) S:X["-" F=$P(X,"-",1),U=$P(X,"-",2)
44 . D CHKTIM(F,"from")
45 . D CHKTIM(U,"until")
46 . S FT=+$E(F_"000000",1,6)
47 . S LT=+$E(U_"000000",1,6)
48 . S TIM=1
49 . Q
50 I ERROR D ERRSAV^MAGDQR01 Q
51 ;
52 S FD=FT/1E6+FD,LD=LT/1E6+LD
53 ;
54 S T="0010,0010",ANY=0
55 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
56 . ; The references below to ^DPT are permitted according to the
57 . ; explicit permission in Section II of the PIMS V5.3 technical manual
58 . ; (dated 23 Nov 2004)
59 . S ANY=1
60 . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^DPT(""B"",LOOP)","^TMP(""MAG"",$J,""QR"",1,LOOP)")
61 . S V="" F S V=$O(^TMP("MAG",$J,"QR",1,V)) Q:V="" D
62 . . S I="" F S I=$O(^DPT("B",V,I)) Q:I="" S ^TMP("MAG",$J,"QR",2,I)="",PAT=1
63 . . Q
64 . Q
65 I ANY,'PAT D Q
66 . D ERR^MAGDQR01("No matches for tag "_T)
67 . D ERRSAV^MAGDQR01
68 . Q
69 ;
70 S T="0010,0020",ANY=0
71 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
72 . ; The references below to ^DPT are permitted according to the
73 . ; explicit permission in Section II of the PIMS V5.3 technical manual
74 . ; (dated 23 Nov 2004)
75 . S ANY=1
76 . S I=$$MATCHD^MAGDQR03($TR(REQ(T,P),"-"),"^DPT(""SSN"",LOOP)","^TMP(""MAG"",$J,""QR"",3,LOOP)")
77 . S V="" F S V=$O(^TMP("MAG",$J,"QR",3,V)) Q:V="" D
78 . . S I="" F S I=$O(^DPT("SSN",V,I)) Q:I="" S ^TMP("MAG",$J,"QR",4,I)="",SSN=1
79 . . Q
80 . Q
81 I ANY,'SSN D Q
82 . D ERR^MAGDQR01("No matches for tag "_T)
83 . D ERRSAV^MAGDQR01
84 . Q
85 ;
86 S T="0008,0050",ANY=0
87 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
88 . ; The references below to ^RADPT are permitted according to the
89 . ; existing Integration Agreement # 1172
90 . S ANY=1
91 . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^RADPT(""ADC"",LOOP)","^TMP(""MAG"",$J,""QR"",5,LOOP)")
92 . S V="" F S V=$O(^TMP("MAG",$J,"QR",5,V)) Q:V="" D
93 . . S MAGD0="" F S MAGD0=$O(^RADPT("ADC",V,MAGD0)) Q:MAGD0="" D
94 . . . S MAGD1="" F S MAGD1=$O(^RADPT("ADC",V,MAGD0,MAGD1)) Q:MAGD1="" D
95 . . . . S MAGD2="" F S MAGD2=$O(^RADPT("ADC",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2="" D
96 . . . . . S ^TMP("MAG",$J,"QR",6,MAGD0_"^"_MAGD1_"^"_MAGD2)="",ACC=1
97 . . . . . Q
98 . . . . Q
99 . . . Q
100 . . Q
101 . Q
102 I ANY,'ACC D Q
103 . D ERR^MAGDQR01("No matches for tag "_T)
104 . D ERRSAV^MAGDQR01
105 . Q
106 ;
107 S T="0020,0010",ANY=0
108 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
109 . ; The references below to ^RADPT are permitted according to the
110 . ; existing Integration Agreement # 1172
111 . S ANY=1
112 . S I=$$MATCHD^MAGDQR03("*-"_REQ(T,P),"^RADPT(""ADC"",LOOP)","^TMP(""MAG"",$J,""QR"",9,LOOP)")
113 . S V="" F S V=$O(^TMP("MAG",$J,"QR",9,V)) Q:V="" D
114 . . S MAGD0="" F S MAGD0=$O(^RADPT("ADC",V,MAGD0)) Q:MAGD0="" D
115 . . . S MAGD1="" F S MAGD1=$O(^RADPT("ADC",V,MAGD0,MAGD1)) Q:MAGD1="" D
116 . . . . S MAGD2="" F S MAGD2=$O(^RADPT("ADC",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2="" D
117 . . . . . S ^TMP("MAG",$J,"QR",10,MAGD0_"^"_MAGD1_"^"_MAGD2)="",SID=1
118 . . . . . Q
119 . . . . Q
120 . . . Q
121 . . Q
122 . Q
123 I ANY,'SID D Q
124 . D ERR^MAGDQR01("No matches for tag "_T)
125 . D ERRSAV^MAGDQR01
126 . Q
127 ;
128 S T="0020,000D",ANY=0
129 S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
130 . S ANY=1
131 . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^MAG(2005,""P"",LOOP)","^TMP(""MAG"",$J,""QR"",7,LOOP)")
132 . S V="" F S V=$O(^TMP("MAG",$J,"QR",7,V)) Q:V="" D
133 . . S I="" F S I=$O(^MAG(2005,"P",V,I)) Q:I="" D
134 . . . ; If this image has a parent, its UID is not a study UID
135 . . . Q:$P($G(^MAG(2005,I,0)),"^",10)
136 . . . S ^TMP("MAG",$J,"QR",8,I)="",UID=1
137 . . . Q
138 . . Q
139 . Q
140 I ANY,'UID D Q
141 . D ERR^MAGDQR01("No matches for tag "_T)
142 . D ERRSAV^MAGDQR01
143 . Q
144 ;
145 I TIM,'(PAT+SSN+SID+UID+ACC) D TIM^MAGDQR04
146 ;
147 I '(PAT+SSN+SID+UID+ACC) D Q
148 . D ERR^MAGDQR01("No Selection Specified.")
149 . D ERRSAV^MAGDQR01
150 . Q
151 ;
152 D ELIM(ACC,SID,6,10,"Accession and Study ID",0)
153 M ^TMP("MAG",$J,"QR",12)=^TMP("MAG",$J,"QR",6)
154 M ^TMP("MAG",$J,"QR",12)=^TMP("MAG",$J,"QR",10)
155 ;
156 D ELIM(PAT,SSN,2,4,"Patient Name and ID",0)
157 M ^TMP("MAG",$J,"QR",11)=^TMP("MAG",$J,"QR",2)
158 M ^TMP("MAG",$J,"QR",11)=^TMP("MAG",$J,"QR",4)
159 ;
160 D ELIM(PAT+SSN,ACC+SID,11,12,"Patient and Study Info",1)
161 I ERROR D ERRSAV^MAGDQR01 Q
162 ;
163 S ANY=0
164 D
165 . I UID D Q
166 . . S IMAGE="" F S IMAGE=$O(^TMP("MAG",$J,"QR",8,IMAGE)) Q:IMAGE="" D
167 . . . S X=$G(^MAG(2005,IMAGE,0)),P=$P(X,"^",7)
168 . . . I PAT+SSN,P,'$D(^TMP("MAG",$J,"QR",11,P)) Q
169 . . . S X=$G(^MAG(2005,IMAGE,2)),V=$P(X,"^",6) Q:V'=74
170 . . . S V=$P(X,"^",5) I V,(V<FD)!(V>LD) Q
171 . . . S X=$G(^RARPT(+$P(X,"^",7),0)) ; IA # 1171
172 . . . S MAGD0=$P(X,"^",2),MAGD1=9999999.9999-$P(X,"^",3),V=$P(X,"^",4)
173 . . . S MAGD2=$O(^RADPT(MAGD0,"DT",MAGD1,"P","B",V,"")) ; IA # 1172
174 . . . I ACC+SID,'$D(^TMP("MAG",$J,"QR",12,MAGD0_"^"_MAGD1_"^"_MAGD2)) Q
175 . . . D RESULT^MAGDQR03
176 . . . Q
177 . . Q
178 . ;
179 . I ACC+SID D Q
180 . . N OK,P1,P2,P3,P4
181 . . S P="" F S P=$O(^TMP("MAG",$J,"QR",12,P)) Q:P="" D
182 . . . S MAGD0=$P(P,"^",1),MAGD1=$P(P,"^",2),MAGD2=$P(P,"^",3)
183 . . . I PAT+SSN,'$D(^TMP("MAG",$J,"QR",11,MAGD0)) Q
184 . . . S OK=0 D Q:'OK
185 . . . . S V=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) Q:'V ; IA # 1172
186 . . . . S P1=0 F S P1=$O(^RARPT(V,2005,P1)) Q:'P1 D Q:OK ; IA # 1171
187 . . . . . S P2=+$G(^RARPT(V,2005,P1,0)) Q:'P2 ; IA # 1171
188 . . . . . I UID,$D(^TMP("MAG",$J,"QR",8,P2)) S OK=1,IMAGE=P2 Q
189 . . . . . I 'UID S OK=1,IMAGE=P2 Q
190 . . . . . S P3=0 F S P3=$O(^MAG(2005,P2,1,P3)) Q:'P3 D Q:OK
191 . . . . . . S P4=$P($G(^MAG(2005,P2,1,P3,0)),"^",1) Q:'P4
192 . . . . . . I UID,$D(^TMP("MAG",$J,"QR",8,P4)) S OK=1,IMAGE=P4 Q
193 . . . . . . I 'UID S OK=1,IMAGE=P4 Q
194 . . . . . . Q
195 . . . . . Q
196 . . . . Q
197 . . . D RESULT^MAGDQR03
198 . . . Q
199 . . Q
200 . ;
201 . I PAT+SSN D Q
202 . . S P="" F S P=$O(^TMP("MAG",$J,"QR",11,P)) Q:P="" D
203 . . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"AC",P,IMAGE)) Q:IMAGE="" D
204 . . . . Q:$P($G(^MAG(2005,IMAGE,0)),"^",10)
205 . . . . S X=$G(^MAG(2005,IMAGE,2)),V=$P(X,"^",6) Q:V'=74
206 . . . . S V=$P(X,"^",5) I V,(V<FD)!(V>LD) Q
207 . . . . S X=$G(^RARPT(+$P(X,"^",7),0)) ; IA # 1171
208 . . . . S MAGD0=$P(X,"^",2),MAGD1=9999999.9999-$P(X,"^",3),V=$P(X,"^",4)
209 . . . . S MAGD2=$O(^RADPT(MAGD0,"DT",MAGD1,"P","B",V,"")) ; IA # 1172
210 . . . . I ACC+SID,'$D(^TMP("MAG",$J,"QR",12,MAGD0_"^"_MAGD1_"^"_MAGD2)) Q
211 . . . . D RESULT^MAGDQR03
212 . . . . Q
213 . . . Q
214 . . Q
215 . Q
216 ;
217 S $P(^MAGDQR(2006.5732,RESULT,0),"^",2,3)="OK^"_$$NOW^XLFDT()
218 K ^TMP("MAG",$J,"QR")
219 Q
220 ;
221CHKTIM(V,L) ;
222 Q:V=""
223 I V'?1.6N D ERR^MAGDQR01("Invalid '"_L_"' time: """_V_""".")
224 I $E(V,1,2)>23 D ERR^MAGDQR01("Invalid hours in '"_L_"' time: """_V_""".")
225 I $E(V,3,4),$E(V,3,4)>59 D ERR^MAGDQR01("Invalid minutes in '"_L_"' time: """_V_""".")
226 I $E(V,5,6),$E(V,5,6)>59 D ERR^MAGDQR01("Invalid seconds '"_L_"' time: """_V_""".")
227 Q
228 ;
229ELIM(ONE,TWO,I1,I2,E,C) N ANY,I,O
230 Q:'ONE Q:'TWO
231 S I="" F S I=$O(^TMP("MAG",$J,"QR",I1,I)) Q:I="" D
232 . S O=I I C Q:I'["^" S O=+I
233 . I '$D(^TMP("MAG",$J,"QR",I2,O)) K ^TMP("MAG",$J,"QR",I1,I)
234 . Q
235 S I="" F S I=$O(^TMP("MAG",$J,"QR",I2,I)) Q:I="" D
236 . S O=I I C Q:I'["^" S O=+I
237 . I '$D(^TMP("MAG",$J,"QR",I1,O)) K ^TMP("MAG",$J,"QR",I2,I)
238 . Q
239 S ANY=$O(^TMP("MAG",$J,"QR",I1,""))*$O(^TMP("MAG",$J,"QR",I2,""))
240 D:'ANY ERR^MAGDQR01("No matches left, conflict between "_E)
241 Q
242 ;
Note: See TracBrowser for help on using the repository browser.