source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDQR01.m@ 1073

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1MAGDQR01 ;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 ;
20FIND(OUT,TAGS,RESULT,OFFSET,MAX) ; RPC = MAG CFIND QUERY
21 N ERROR,I,N,P,REQ,T,V,X,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
22 ;
23 S RESULT=$G(RESULT),OFFSET=$G(OFFSET)
24 S ERROR=0
25 ;
26 I 'RESULT D Q
27 . S REQ("0008,0020")=-1 ; Study Date
28 . S REQ("0008,0030")=-1 ; Study Time
29 . S REQ("0008,0050")=-1 ; Accession Number
30 . S REQ("0010,0010")=-1 ; Patient's Name
31 . S REQ("0010,0020")=-1 ; Patient ID
32 . S REQ("0020,0010")=-1 ; Study ID
33 . ; TAGS(i) = tag | VR | flag | value
34 . S I="" F S I=$O(TAGS(I)) Q:I="" D
35 . . S X=TAGS(I),T=$P(X,"|",1) Q:T=""
36 . . S V=$P(X,"|",4,$L(X)+2) S:V="*" V=""
37 . . S:$TR(V,"UNKOW","unkow")="<unknown>" V=""
38 . . S L=$L(V,"\") S:V="" L=0
39 . . S REQ(T)=L F P=1:1:L S REQ(T,P)=$P(V,"\",P)
40 . . Q
41 . S T="" F S T=$O(REQ(T)) Q:T="" D:REQ(T)<0 ERR("Missing required tag """_T_""".")
42 . I ERROR D ERRLOG Q
43 . ;
44 . ; Convert DICOM name to VA name
45 . ;
46 . S T="0010,0010"
47 . S P="" F S P=$O(REQ(T,P)) Q:P="" S REQ(T,P)=$$DCM2VA(REQ(T,P))
48 . ;
49 . ; Initialize Result Set
50 . ;
51 . L +^MAGDQR(2006.5732,0):1E9 ; Background process MUST wait
52 . S X=$G(^MAGDQR(2006.5732,0))
53 . S $P(X,"^",1,2)="DICOM QUERY RETRIEVE RESULT^2006.2006.5732"
54 . S RESULT=$O(^MAGDQR(2006.5732," "),-1)+1
55 . S $P(X,"^",3)=RESULT
56 . S $P(X,"^",4)=$P(X,"^",4)+1
57 . S ^MAGDQR(2006.5732,0)=X
58 . S ^MAGDQR(2006.5732,RESULT,0)=RESULT_"^IP^"_$$NOW^XLFDT()
59 . S ^MAGDQR(2006.5732,"B",RESULT,RESULT)=""
60 . L -^MAGDQR(2006.5732,0)
61 . ;
62 . ; Queue up actual query
63 . ;
64 . S ZTRTN="QUERY^MAGDQR02"
65 . S ZTDESC="Perform DICOM Query, result-set="_RESULT
66 . S ZTDTH=$H
67 . S ZTSAVE("RESULT")=RESULT
68 . S T="" F S T=$O(REQ(T)) Q:T="" D
69 . . S ZTSAVE("REQ("""_T_""")")=REQ(T)
70 . . S P="" F S P=$O(REQ(T,P)) Q:P="" S ZTSAVE("REQ("""_T_""","_P_")")=REQ(T,P)
71 . . Q
72 . D ^%ZTLOAD,HOME^%ZIS
73 . D:'$G(ZTSK) ERR("TaskMan did not Accept Request")
74 . S:$G(ZTSK) $P(^MAGDQR(2006.5732,RESULT,0),"^",4)=ZTSK
75 . I ERROR D ERRLOG Q
76 . S OUT(1)="0,"_RESULT_",Query Started through TaskMan"
77 . Q
78 ;
79 I OFFSET<0 D Q ; All done, clean up result-set
80 . S OUT(1)="1,Result Set Cleaned Up"
81 . Q:'$D(^MAGDQR(2006.5732,RESULT))
82 . L +^MAGDQR(2006.5732,0):1E9 ; Background process MUST wait
83 . S X=$G(^MAGDQR(2006.5732,0))
84 . S $P(X,"^",1,2)="DICOM QUERY RETRIEVE RESULT^2006.2006.5732"
85 . S:$P(X,"^",4)>0 $P(X,"^",4)=$P(X,"^",4)-1
86 . S ^MAGDQR(2006.5732,0)=X
87 . K ^MAGDQR(2006.5732,RESULT)
88 . K ^MAGDQR(2006.5732,"B",RESULT)
89 . L -^MAGDQR(2006.5732,0)
90 . Q
91 ;
92 I 'OFFSET D Q:V'="OK" ; Is the query done?
93 . S X=$G(^MAGDQR(2006.5732,RESULT,0))
94 . S V=$P(X,"^",2) Q:V="OK"
95 . I V="X" S OUT(1)="-2,No result returned" S V="OK" Q
96 . S ZTSK=$P(X,"^",4) D STAT^%ZTLOAD
97 . I $G(ZTSK(2))'["Inactive" S OUT(1)="-1,TaskMan still active" Q
98 . I ZTSK(2)["Finished" S V="OK" Q
99 . S OUT(1)="-13,TaskMan aborted: "_ZTSK(2)
100 . Q
101 ;
102 S:'$G(MAX) MAX=100
103 S I=OFFSET,N=1 F S I=$O(^MAGDQR(2006.5732,RESULT,1,I)) Q:'I D Q:N>MAX
104 . S OFFSET=I
105 . S N=N+1,OUT(N)=$G(^MAGDQR(2006.5732,RESULT,1,I,0))
106 . Q
107 I N=1 S OUT(1)="0,No more results." Q
108 S OUT(1)=(N-1)_","_OFFSET_",result(s)."
109 Q
110 ;
111DCM2VA(NAME) N I,P
112 S NAME=$TR(NAME,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
113 ; Ignore prefixes and suffices
114 F I=1:1:3 D
115 . S P(I)=$P(NAME,"^",I)
116 . F Q:$E(P(I),1)'=" " S P(I)=$E(P(I),2,$L(P(I)))
117 . F Q:$E(P(I),$L(P(I)))'=" " S P(I)=$E(P(I),1,$L(P(I))-1)
118 . Q
119 S NAME=P(1)_","_P(2) S:P(3)'="" NAME=NAME_" "_P(3)
120 Q NAME
121 ;
122ERR(X) S ERROR=ERROR+1,ERROR(ERROR)=X
123 Q
124 ;
125ERRLOG N I,O
126 S O=1,I="" F S I=$O(ERROR(I)) Q:I="" S O=O+1,OUT(O)=ERROR(I)
127 SET OUT(1)=(-O)_",Errors encountered"
128 Q
129 ;
130ERRSAV N I,O
131 S $P(^MAGDQR(2006.5732,RESULT,0),"^",2,3)="OK^"_$$NOW^XLFDT()
132 K ^MAGDQR(2006.5732,"RESULT",1)
133 S O=0,I="" F S I=$O(ERROR(I)) Q:I="" D
134 . S O=O+1,^MAGDQR(2006.5732,RESULT,1,O,0)="0000,0902^"_ERROR(I)
135 . Q
136 Q
137 ;
Note: See TracBrowser for help on using the repository browser.