VistA-WorldVistAEHR/r/IMAGING-MAG-ZMAG/MAGDQR03.m

307 lines
8.3 KiB
Mathematica

MAGDQR03 ;WOIFO/EdM - Imaging RPCs for Query/Retrieve ; 05/16/2005 08:45
;;3.0;IMAGING;**51**;26-August-2005
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
RESULT N E,L,OK,V,X,T
S OK=1
S T="" F S T=$O(REQ(T)) Q:T="" D
. S L=$TR(T,",")
. S E=$TR($E(L,1),"0123456789abcdef","QRSTUVWXYZABCDEF")
. S $E(L,1)=E S:L'?8UN L=""
. I L'="",$T(@L)'="" D @L Q
. D ERR^MAGDQR01("Undefined tag: """_T_""".") S OK=0
. Q
Q:'OK
;
S ANY=ANY+1
D
. N R1,V1,V2,VAL
. S R1=$O(^MAGDQR(2006.5732,RESULT,1," "),-1)+1
. S ^MAGDQR(2006.5732,RESULT,1,R1,0)="0000,0902^Result # "_ANY
. S T="" F S T=$O(V(T)) Q:T="" D
. . S VAL=$G(V(T))
. . S V1="" F S V1=$O(V(T,V1)) Q:V1="" D
. . . Q:$G(V(T,V1))=""
. . . S:VAL'="" VAL=VAL_"\" S VAL=VAL_V(T,V1)
. . . Q
. . S R1=R1+1,^MAGDQR(2006.5732,RESULT,1,R1,0)=T_"^"_VAL
. . S ^MAGDQR(2006.5732,RESULT,1,"B",T,R1)=""
. . Q:$D(V(T))<10
. . S V1="" F S V1=$O(V(T,V1)) Q:V1="" D
. . . S V2="" F S V2=$O(V(T,V1,V2)) Q:V2="" D
. . . . S VAL=$G(V(T,V1,V2)) Q:VAL=""
. . . . S R1=R1+1,^MAGDQR(2006.5732,RESULT,1,R1,0)=T_"^"_VAL
. . . . S ^MAGDQR(2006.5732,RESULT,1,"B",T,R1)=""
. . . . Q
. . . Q
. . Q
. Q
Q
;
COMPARE(TAG,ACTUAL) N LOC,TMP,WILD
Q:'$G(REQ(TAG)) 1
S WILD=$G(REQ(TAG,1)) Q:WILD="" 0
Q:$G(ACTUAL)="" 0
S LOC(ACTUAL)=""
Q $$MATCHD(WILD,"LOC(LOOP)","TMP(LOOP)")
;
MATCH1(X,Y) N I,M
F Q:X="" Q:Y="" D
. I $E(X,1)=$E(Y,1) S X=$E(X,2,$L(X)),Y=$E(Y,2,$L(Y)) Q
. I $E(Y,1)="?" S X=$E(X,2,$L(X)),Y=$E(Y,2,$L(Y)) Q
. I $E(Y,1)="*" D Q:M
. . I Y="*" S (X,Y)="",M=1 Q
. . S Y=$E(Y,2,$L(Y)),M=0
. . F I=1:1:$L(X) I $$MATCH1($E(X,I,$L(X)),Y) S M=1,X=$E(X,I,$L(X)) Q
. . Q
. S X="!",Y=""
. Q
S:$TR(Y,"*")="" Y="" Q:X'="" 0 Q:Y'="" 0
Q 1
;
MATCHD(WILDCARD,STRUCTUR,FOUND) N C,LOOP,L1,L9,SEEK,X,Y
; -- Scans a structure,
; reports entries in @STRUCTUR that match WILDCARD;
; the result is reported in local array @FOUND
S C=0
S L1=$P($P(WILDCARD,"?",1),"*",1),L9=L1_"~"
I L1=WILDCARD D Q C
. S LOOP=L1
. I $D(@STRUCTUR) S @FOUND="" Q
. Q
S LOOP=L1 F D S LOOP=$O(@STRUCTUR) Q:LOOP="" Q:LOOP]]L9
. Q:LOOP="" Q:'$D(@STRUCTUR)
. Q:'$$MATCH1(LOOP,WILDCARD)
. S C=C+1
. S @FOUND=""
. Q
Q C
;
Q0080020 ;R Study Date
S V(T)=$P($G(^MAG(2005,IMAGE,2)),"^",5)\1+17000000
Q
;
Q0080030 ;R Study Time
S V(T)=$TR($J("."_$P($P($G(^MAG(2005,IMAGE,2)),"^",5),".",2)*1E6,6)," ",0)
Q
;
Q0080050 ;R Accession Number
S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) ; IA # 1172
S V(T)=$P($G(^RARPT(+X,0)),"^",1) ; IA # 1171
Q
;
Q0100010 ;R Patient's Name
S V(T)=$P($G(^DPT(MAGD0,0)),"^",1) ; No IA needed, PIMS 5.3
Q
;
Q0100020 ;R Patient ID
S V(T)=$P($G(^DPT(MAGD0,0)),"^",9) ; No IA needed, PIMS 5.3
Q
;
Q0200010 ;R Study ID
S V(T)=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",1) ; IA # 1172
Q
;
Q020000D ;U Study Instance UID
S V(T)=$P($G(^MAG(2005,IMAGE,"PACS")),"^",1)
Q
;
Q0080061 ;O Modalities in Study
N P1,P2,R
S R=""
S P1=0 F S P1=$O(^MAG(2005,IMAGE,1,P1)) Q:'P1 D
. S P2=+$G(^MAG(2005,IMAGE,1,P1,0)) Q:'P2
. S X=$P($G(^MAG(2005,P2,0)),"^",8) Q:$E(X,1,4)'="RAD"
. S:R'="" R=R_"," S R=R_$E(X,5,$L(X))
. Q
S V(T)=R
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0080062 ;O SOP Classes in Study
; --- probably not supported --- ?
; ? ? ?
Q
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0080090 ;O Referring Physician's Name
S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",14) ; IA # 1172
S V(T)=$P($G(^VA(200,+X,0)),"^",1)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0081030 ;O Study Description
S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",2) ; IA # 1172
S V(T)=$P($G(^RAMIS(71,+X,0)),"^",1) ; IA # 1174
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0081032 ;O Procedure Code Sequence
Q
;
Q0080100 ;O >Code Value
S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",2) ; IA # 1172
S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174
S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference
S V("0008,1030",1,T)=$P(X,"^",2)
Q
;
Q0080102 ;O >Coding Scheme Designator
S V("0008,1030",1,T)="C4"
Q
;
Q0080103 ;O >Coding Scheme Version
S V("0008,1030",1,T)=4
Q
;
Q0080104 ;O >Code Meaning
S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",2) ; IA # 1172
S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174
S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference
S V("0008,1030",1,T)=$P(X,"^",3)
Q
;
Q0081060 ;O Name of Physician(s) Reading Study
S X=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) ; IA # 1172
S X=$P($G(^RARPT(+X,0)),"^",9) ; IA # 1171
S V(T)=$P($G(^VA(200,+X,0)),"^",1)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0081080 ;O Admitting Diagnoses Description
; ? ? ?
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100021 ;O Issuer of Patient ID
S V(T)="USSSA"
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100030 ;O Patient's Birth Date
S V(T)=$P($G(^DPT(MAGD0,0)),"^",3)\1+17000000
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100032 ;O Patient's Birth Time
S V(T)=$TR($J("."_$P($P($G(^DPT(MAGD0,0)),"^",3),".",2)*1E6,6)," ",0)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100040 ;O Patient's Sex
S V(T)=$P($G(^DPT(MAGD0,0)),"^",2)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101000 ;O Other Patient IDs
N DFN,I,VA,VADPT
S DFN=+MAGD0 D DEM^VADPT
S X=$P(^DPT(DFN,0),"^",9) S:X'="" DFN(X)=""
S:$G(VA("PID"))'="" DFN(VA("PID"))=""
S:$G(VA("BID"))'="" DFN(VA("BID"))=""
S X=$$GETICN^MPIF001(DFN) S:X'="" DFN(X)=""
S I=0,X="" F S X=$O(DFN(X)) Q:X="" S I=I+1,V(T,I)=DFN(X)
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101001 ;O Other Patient Names
N D1,I
S (I,D1)=0 F S D1=$O(^DPT(MAGD0,0.01,D1)) Q:'D1 D
. S X=$P($G(^DPT(MAGD0,0.01,D1,0)),"^",1)
. S:X'="" I=I+1,V(T,I)=X
. Q
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101010 ;O Patient's Age
N DD,DM,DY,WHEN
S X=$P($G(^DPT(MAGD0,0)),"^",3)
S WHEN=9999999.9999-MAGD1 ;;; select one of these two
S WHEN=DT ;;; select one of these two
S DY=$E(WHEN,1,3)-$E(X,1,3)
S DM=$E(WHEN,4,5)-$E(X,4,5)
S DD=$E(WHEN,6,7)-$E(X,6,7)
S:DD<0 DM=DM-1 S:DM<0 DY=DY-1
S V(T)=DY
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0001020 ;O Patient's Size
S V(T)=$P($G(^DPT(MAGD0,57)),"^",1) ; height in cm - field not populated
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101030 ;O Patient's Weight
S V(T)=$P($G(^DPT(MAGD0,57)),"^",2) ; weight in kg - field not populated
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0102160 ;O Ethnic Group
S V(T)=$P($G(^DPT(MAGD0,0)),"^",6)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0102180 ;O Occupation
S V(T)=$P($G(^DPT(MAGD0,0)),"^",7)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q01021B0 ;O Additional Patient History
N D1,I
S X=+$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) ; IA # 1172
S (D1,I)=0 F S D1=$O(^RARPT(X,"H",D1)) Q:'D1 D ; IA # 1171
. S I=I+1,V(T,I)=$G(^RARPT(X,"H",D1,0)) ; IA # 1171
. Q
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0104000 ;O Patient Comments
; ? ? ?
; (there is a modality that passes the accession number in this field)
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0201206 ;O Number of Study Related Series
N N,S,UID
S UID=$G(V("0020,000D")),N=0
I UID'="" S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" S N=N+1
S V(T)=N
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0201208 ;O Number of Study Related Instances
N N,P1,P2,S,UID
S UID=$G(V("0020,000D")),N=0
I UID'="" S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" D
. S P1=0 F S P1=$O(^MAG(2005,S,1,P1)) Q:'P1 D
. . S P2=+$G(^MAG(2005,S,1,P1,0)) Q:'P2
. . S N=N+1
. . Q
. Q
S V(T)=N
S:'$$COMPARE(T,V(T)) OK=0
Q
;
U008010C ;O Interpretation Author
S X=+$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",12) ; IA # 1172
S V(T)=$P($G(^VA(200,X,0)),"^",1)
S:'$$COMPARE(T,V(T)) OK=0
Q
;