| [613] | 1 | MAGDQR04 ;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 | ;
|
|---|
| 20 | TIM ; Overflow from MAGDQR02
|
|---|
| 21 | N SDT,V
|
|---|
| 22 | ; The references below to ^RADPT are permitted according to the
|
|---|
| 23 | ; existing Integration Agreement # 1172
|
|---|
| 24 | S V="" F S V=$O(^RADPT("ADC",V)) Q:V="" D
|
|---|
| 25 | . S MAGD0="" F S MAGD0=$O(^RADPT("ADC",V,MAGD0)) Q:MAGD0="" D
|
|---|
| 26 | . . S MAGD1="" F S MAGD1=$O(^RADPT("ADC",V,MAGD0,MAGD1)) Q:MAGD1="" D
|
|---|
| 27 | . . . S SDT=9999999.9999-MAGD1 Q:SDT<FD Q:SDT>LD
|
|---|
| 28 | . . . S MAGD2="" F S MAGD2=$O(^RADPT("ADC",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2="" D
|
|---|
| 29 | . . . . S ^TMP("MAG",$J,"QR",10,MAGD0_"^"_MAGD1_"^"_MAGD2)="",TIM=2
|
|---|
| 30 | . . . . S ANY=1,SID=1
|
|---|
| 31 | . . . . Q
|
|---|
| 32 | . . . Q
|
|---|
| 33 | . . Q
|
|---|
| 34 | . Q
|
|---|
| 35 | I TIM=1 D Q
|
|---|
| 36 | . D ERR^MAGDQR01("No matches for tag 0008,0020 / 0008,0030")
|
|---|
| 37 | . D ERRSAV^MAGDQR01
|
|---|
| 38 | . Q
|
|---|
| 39 | ;
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | STUDY(OUT,UID) ; RPC = MAG STUDY UID QUERY
|
|---|
| 43 | N D1,F1,F2,F3,IMAGE,N,NET,PASS,SERIES,USER,X
|
|---|
| 44 | I $G(UID)="" S OUT(1)="-1,No UID specified." Q
|
|---|
| 45 | I UID'?1.64(1N,1".") S OUT(1)="-2,Invalid UID format: """_UID_"""." Q
|
|---|
| 46 | S N=1
|
|---|
| 47 | S SERIES="" F S SERIES=$O(^MAG(2005,"P",UID,SERIES)) Q:SERIES="" D
|
|---|
| 48 | . Q:$P($G(^MAG(2005,SERIES,0)),"^",10)
|
|---|
| 49 | . S D1=0 F S D1=$O(^MAG(2005,SERIES,1,D1)) Q:'D1 D
|
|---|
| 50 | . . S IMAGE=+$G(^MAG(2005,SERIES,1,D1,0)) Q:'IMAGE
|
|---|
| 51 | . . S NET=$P($G(^MAG(2005,IMAGE,0)),"^",3),(USER,PASS)=""
|
|---|
| 52 | . . I NET S X=$G(^MAG(2005.2,NET,2)),USER=$P(X,"^",1),PASS=$P(X,"^",2)
|
|---|
| 53 | . . D FILEFIND^MAGDFB(IMAGE,"FULL",0,0,.F1,.F2,.F3)
|
|---|
| 54 | . . S N=N+1,OUT(N)=IMAGE_"^"_F2_"^"_USER_"^"_PASS
|
|---|
| 55 | . . Q
|
|---|
| 56 | . Q
|
|---|
| 57 | S X=" image" S:N'=2 X=X_"s" S X=X_" found"
|
|---|
| 58 | S OUT(1)=(N-1)_X
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | INFO(OUT,IMAGE) ; RPC = MAG IMAGE CURRENT INFO
|
|---|
| 62 | ;
|
|---|
| 63 | ; 0008,0020 Study Date
|
|---|
| 64 | ; 0008,0050 Accession Number
|
|---|
| 65 | ; 0008,0060 Modality
|
|---|
| 66 | ; 0008,0090 Referring Physician's Name
|
|---|
| 67 | ; 0008,1030 Study Description (may be VA procedure name)
|
|---|
| 68 | ; 0008,1050 Performing (attending) Physician
|
|---|
| 69 | ; 0010,0010 Patient Name
|
|---|
| 70 | ; 0010,0020 Patient ID
|
|---|
| 71 | ; 0010,0030 Patient's Birth Date
|
|---|
| 72 | ; 0010,0040 Patient's Sex
|
|---|
| 73 | ; 0010,1000 Other Patient IDs (= ICN, Integration Control Number)
|
|---|
| 74 | ; 0010,1040 Address
|
|---|
| 75 | ; 0010,2160 Ethnic Group
|
|---|
| 76 | ; 0010,2000 Medical Alerts
|
|---|
| 77 | ; 0020,000D Study Instance UID
|
|---|
| 78 | ; 0032,1032 Requesting Physician
|
|---|
| 79 | ; 0032,1033 Requesting Service
|
|---|
| 80 | ; 0032,1060 Requested Procedure Description (CPT name)
|
|---|
| 81 | ; 0032,1064 Requested Procedure Code Sequence
|
|---|
| 82 | ; 0008,0100 > Code Value (CPT code)
|
|---|
| 83 | ; 0008,0102 > Coding Scheme Designator ("C4")
|
|---|
| 84 | ; 0008,0104 > Code Meaning (CPT name)
|
|---|
| 85 | ; 0038,0300 Current Patient Location (ward)
|
|---|
| 86 | ;
|
|---|
| 87 | N ACN,ATP,CPT,D0,D1,D2,D3,DFN,I,MO,N,P,REQP,RFP,RQL,T,TAG,UID,V,WRD,X
|
|---|
| 88 | I '$G(IMAGE) S OUT(1)="-1,No Image Specified." Q
|
|---|
| 89 | I '$D(^MAG(2005,IMAGE)) S OUT(1)="-2,No Such Image ("_IMAGE_")." Q
|
|---|
| 90 | ;
|
|---|
| 91 | S X=$G(^MAG(2005,IMAGE,0)),P=$P(X,"^",10)
|
|---|
| 92 | S TAG("0008,1030")=$P(X,"^",8) ; Procedure
|
|---|
| 93 | S DFN=$P(X,"^",7) D:DFN
|
|---|
| 94 | . ; The following references to ^DPT are allowed according to
|
|---|
| 95 | . ; PIMS V5.3 Technical Manual, Section II.
|
|---|
| 96 | . S TAG("0010,0010")=$P(^DPT(DFN,0),"^",1) ; Patient Name
|
|---|
| 97 | . S TAG("0010,0020")=$P(^DPT(DFN,0),"^",9) ; Patient ID (SSN)
|
|---|
| 98 | . S TAG("0010,0030")=$P(^DPT(DFN,0),"^",3)\1+17000000 ; Patient's Birth Date
|
|---|
| 99 | . S TAG("0010,0032")=$TR($J("."_$P($P(^DPT(DFN,0),"^",3),".",2)*1E6,6)," ",0) ; Patient's Birth Time [probably always blank]
|
|---|
| 100 | . S TAG("0010,2160")=$P(^DPT(DFN,0),"^",6) ; Patient's Race
|
|---|
| 101 | . S TAG("0010,0040")=$P(^DPT(DFN,0),"^",2) ; Patient's Sex
|
|---|
| 102 | . S X=$$GETICN^MPIF001(DFN)
|
|---|
| 103 | . S:X'="" TAG("0010,1000")=X ; Other Patient ID
|
|---|
| 104 | . S X=$G(^DPT(DFN,0.11)) D:X'=""
|
|---|
| 105 | . . S P=$P(X,"^",5) S:P V=$P($G(^DIC(5,+P,0)),"^",1) ; IA # 10056
|
|---|
| 106 | . . S:V'="" $P(X,"^",5)=V ; State
|
|---|
| 107 | . . S TAG("0010,1040")=$P(X,"^",1,6) ; Patient's Address
|
|---|
| 108 | . . Q
|
|---|
| 109 | . Q
|
|---|
| 110 | ;
|
|---|
| 111 | S UID=$S(P:$G(^MAG(2005,+P,"PACS")),1:$G(^MAG(2005,IMAGE,"PACS")))
|
|---|
| 112 | S TAG("0020,000D")=UID ; Study Instance UID
|
|---|
| 113 | ; The following references to ^RADPT are allowed according to IA # 1172
|
|---|
| 114 | S I=0
|
|---|
| 115 | I UID'="" S D0="" F S D0=$O(^RADPT("ADC",UID,D0)) Q:D0="" D
|
|---|
| 116 | . S D1="" F S D1=$O(^RADPT("ADC",UID,D0,D1)) Q:D1="" D
|
|---|
| 117 | . . N VAINDT
|
|---|
| 118 | . . S I=I+1,TAG("0008,0020",I)=9999999.9999-D1\1+17000000 ; Study Date
|
|---|
| 119 | . . S VAINDT=9999999.9999-D1 D INP^VADPT ; Supported reference
|
|---|
| 120 | . . S:$G(VAIN(2))'="" RFP(VAIN(2))="" ; Referring Physician's Name
|
|---|
| 121 | . . S:$G(VAIN(4))'="" RFP(VAIN(4))="" ; Current Ward
|
|---|
| 122 | . . S:$G(VAIN(11))'="" ATP(VAIN(11))="" ; Performing (attending) Physician
|
|---|
| 123 | . . S D2="" F S D2=$O(^RADPT("ADC",UID,D0,D1,D2)) Q:D2="" D
|
|---|
| 124 | . . . S X=$G(^RADPT(D0,"DT",D1,"P",D2,0))
|
|---|
| 125 | . . . S P=$P(X,"^",2) D:P
|
|---|
| 126 | . . . . S M1=0 F S M1=$O(^RAMIS(71,+P,"MDL",M1)) Q:'M1 D ; IA # 1174
|
|---|
| 127 | . . . . . S V=$P($G(^RAMIS(71,+P,"MDL",M1,0)),"^",1) S:V'="" MO(V)="" ; IA # 1174
|
|---|
| 128 | . . . . . Q
|
|---|
| 129 | . . . . S V=$P($G(^RAMIS(71,+P,0)),"^",9) S:V CPT(+V)="" ; IA # 1174
|
|---|
| 130 | . . . . Q
|
|---|
| 131 | . . . S P=$P(X,"^",14) D:P
|
|---|
| 132 | . . . . S V=$P($G(^VA(200,+P,0)),"^",1)
|
|---|
| 133 | . . . . S:V'="" REQP(V)=""
|
|---|
| 134 | . . . . Q
|
|---|
| 135 | . . . S P=$P(X,"^",17) D:P
|
|---|
| 136 | . . . . S X=$G(^RARPT(+P,0)) Q:X="" ; IA # 1171
|
|---|
| 137 | . . . . S V=$P(X,"^",1) S:V'="" ACN(V)=""
|
|---|
| 138 | . . . . Q
|
|---|
| 139 | . . . S P=$P(X,"^",22) D:P
|
|---|
| 140 | . . . . S X=$G(^SC(+P,0)) Q:X="" ; IA # 10040
|
|---|
| 141 | . . . . S V=$P(X,"^",1) S:V'="" RQL(V)=""
|
|---|
| 142 | . . . . Q
|
|---|
| 143 | . . . S P=0,D3=0 F S D3=$O(^RADPT(D0,"P",D1,"DT",D2,"H",D3)) Q:'D3 D
|
|---|
| 144 | . . . . S X=$G(^RADPT(D0,"P",D1,"DT",D2,"H",D3,0)) Q:X=""
|
|---|
| 145 | . . . . S P=P+1,TAG("0010,2000 "_$J(P,5))=X
|
|---|
| 146 | . . . . Q
|
|---|
| 147 | . . . Q
|
|---|
| 148 | . . Q
|
|---|
| 149 | . Q
|
|---|
| 150 | S V="" F S V=$O(ACN(V)) Q:V="" D
|
|---|
| 151 | . S I=I+1,TAG("0008,0050",I)=ACN(V) ; Accession Number
|
|---|
| 152 | . Q
|
|---|
| 153 | S V="" F S V=$O(WRD(V)) Q:V="" D
|
|---|
| 154 | . S I=I+1,TAG("0038,0300",I)=$P(V,"^",2) ; Current Patient Location
|
|---|
| 155 | . Q
|
|---|
| 156 | S V="" F S V=$O(RFP(V)) Q:V="" D
|
|---|
| 157 | . S I=I+1,TAG("0008,0090",I)=$P(V,"^",2) ; Referring Physician's Name
|
|---|
| 158 | . Q
|
|---|
| 159 | S V="" F S V=$O(ATP(V)) Q:V="" D
|
|---|
| 160 | . S I=I+1,TAG("0008,1050",I)=$P(V,"^",2) ; Performing (attending) Physician
|
|---|
| 161 | . Q
|
|---|
| 162 | S V="" F S V=$O(RQL(V)) Q:V="" D
|
|---|
| 163 | . S I=I+1,TAG("0032,1033",I)=RQL(V) ; Requesting Service
|
|---|
| 164 | . Q
|
|---|
| 165 | S V="" F S V=$O(MO(V)) Q:V="" D
|
|---|
| 166 | . S I=I+1,TAG("0008,0060",I)=MO(V) ; Modality
|
|---|
| 167 | . Q
|
|---|
| 168 | S V="" F S V=$O(REQP(V)) Q:V="" D
|
|---|
| 169 | . S I=I+1,TAG("0032,1032",I)=REQP(V) ; Requesting Physician
|
|---|
| 170 | . Q
|
|---|
| 171 | S V="" F S V=$O(CPT(V)) Q:V="" D
|
|---|
| 172 | . S X=$$CPT^ICPTCOD(V) ; IA # 1995, supported reference
|
|---|
| 173 | . Q:$P(X,"^",2)=""
|
|---|
| 174 | . S I=I+1
|
|---|
| 175 | . S TAG("0031,1064 0008,0100",I)=$P(X,"^",2) ; CPT Code
|
|---|
| 176 | . S TAG("0031,1064 0008,0104",I)=$P(X,"^",3) ; Code Meaning
|
|---|
| 177 | . S TAG("0031,1060",I)=$P(X,"^",3) ; Requested Procedure Description
|
|---|
| 178 | . S TAG("0031,1064 0008,0102",I)="C4" ; Coding Scheme Designator
|
|---|
| 179 | . Q
|
|---|
| 180 | ;
|
|---|
| 181 | S N=1,T="" F S T=$O(TAG(T)) Q:T="" D
|
|---|
| 182 | . S V=""
|
|---|
| 183 | . S:$D(TAG(T))#2 V=TAG(T)
|
|---|
| 184 | . S I="" F S I=$O(TAG(T,I)) Q:I="" S:V'="" V=V_"\" S V=V_TAG(T,I)
|
|---|
| 185 | . S:V'="" N=N+1,OUT(N)=T_"^"_V
|
|---|
| 186 | . Q
|
|---|
| 187 | ;
|
|---|
| 188 | S OUT(1)=(N-1)_" data fields returned."
|
|---|
| 189 | Q
|
|---|
| 190 | ;
|
|---|
| 191 | CLEAN(OUT) ; RPC = MAG DICOM QUERY CLEANUP
|
|---|
| 192 | N D0,H,N,STAMP
|
|---|
| 193 | L +^MAGDQR(2006.5732,0):1E6 ; Background task MUST wait
|
|---|
| 194 | S D0=0 F S D0=$O(^MAGDQR(2006.5732,D0)) Q:'D0 D
|
|---|
| 195 | . S X=$G(^MAGDQR(2006.5732,D0,0)),STAMP=$P(X,"^",3)
|
|---|
| 196 | . Q:DT-STAMP<5
|
|---|
| 197 | . K ^MAGDQR(2006.5732,D0)
|
|---|
| 198 | . K ^MAGDQR(2006.5732,"B",D0)
|
|---|
| 199 | . Q
|
|---|
| 200 | S (D0,N,H)=0 F S D0=$O(^MAGDQR(2006.5732,D0)) Q:'D0 S N=N+1,H=D0
|
|---|
| 201 | S X="DICOM QUERY RETRIEVE RESULT^2006.2006.5732^"_H_"^"_N
|
|---|
| 202 | S ^MAGDQR(2006.5732,0)=X
|
|---|
| 203 | L -^MAGDQR(2006.5732,0)
|
|---|
| 204 | Q
|
|---|
| 205 | ;
|
|---|
