MAGDQR03 ;WOIFO/EdM,MLH,JSL,SAF,BT,DAC,NST - Imaging RPCs for Query/Retrieve ; 20 Jun 2015 1:36 PM
;;3.0;IMAGING;**51,54,66,123,118,138,162**;Mar 19, 2002;Build 22;Jun 20 2015
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | 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
;
; When RESULT^MAGDQR03 is called, the following input parameters
; should be properly defined:
; TYPE = R(adiology) or C(onsult)
; REQ = array of element tags being queried for
; RESULT = pointer into results global (#2006.5732)
; MAGIEN = pointer into the Image File (#2005)
; MAGDFN = pointer into the Patient File (#2)
; MAGRORD = second level pointer into the Rad/Nuc Med Patient File (#70)
; (Radiology orders only)
; MAGINTERP = third level pointer into the Rad/Nuc Med Patient File (#70)
; (Radiology orders only)
;
; This routine contains code to calculate values for DICOM Tags
; that can be derived from those two pointers.
; All other DICOM Tags are computed in MAGDQR06.
; (This routine does the things that are the same for all images.
; MAGDQR06 differentiates between Radiology, Consults, and anything else.)
;
RESULT(TYPE,REQ,RESULT,MAGIEN,MAGDUZ,MAGDFN,MAGRORD,MAGINTERP,ERROR,FATAL) ;
D ; validate input parameters
. I "^R^C^N^"'[("^"_TYPE_"^") D ERR^MAGDQRUE("Study type (radiology/consult/new DB) not defined") Q
. I '$G(RESULT) D ERR^MAGDQRUE("Invalid query result set "_RESULT_" specified") Q
. I $D(MAGIEN),($D(^MAG(2005,MAGIEN)))!($D(^MAGV(2005.64,MAGIEN)))
. E D ERR^MAGDQRUE("Invalid image ID "_MAGIEN_" specified for result") Q
. I $D(MAGDFN),$D(^DPT(MAGDFN))
. E D ERR^MAGDQRUE("Invalid patient ID "_MAGDFN_" specified for result") Q
. I TYPE="R",'$G(MAGRORD) D Q
. . D ERR^MAGDQRUE("Invalid Radiology order number "_MAGRORD_" specified")
. . Q
. I TYPE="R",'$G(MAGINTERP) D Q
. . D ERR^MAGDQRUE("Invalid Radiology interpretation "_MAGINTERP_" specified")
. . Q
. Q
I $D(^TMP("MAG",$J,"ERR")) D ERRLOG^MAGDQRUE Q
;
N E,L,OK,V,X,T
N SENSEMP ; ----- sensitive/employee flag
N ACCESSION ; --- accession number
N SERIESIX ; ---- new series index
N STUDYIX ; ----- new study index
N PROCIX ; ------ new procedure index
N PROCREC ; ----- new procedure record
N PROCIDTYP ; --- procedure ID type in new DB
N Y ; ----------- patient DFN
N DG1 ; --------- inpatient/outpatient indicator
N DGOPT ; ------- option Name
N DIC ; --------- DIC variable for the SETLOG entry point
S SENSEMP=0,OK=1
;
; new specs for sens/emp patients 3/20/09 - data will be picked up, but scrubbed
; 01/2010: suspend data suppression
; 05/2011: log access using supported PIMS entry point
;
S SENSEMP=SENSEMP+($$EMPL^DGSEC4(MAGDFN)=1) ; IA #3646
S SENSEMP=SENSEMP+($P($G(^DGSL(38.1,MAGDFN,0)),"^",2)=1) ; IA #767
S Y=MAGDFN,DG1="",DGOPT="MAG DICOM QUERY RETRIEVE^MAG CFIND QUERY",DIC(0)=""
I SENSEMP D SETLOG^DGSEC
S SENSEMP=0 ; sensitive/employee data suppression to be suspended as of Jan 2010
; increment (static) dummy Study Instance UID if sensitive/employee
S:SENSEMP ^("DUMMY SIUID")=^TMP("MAG",$J,"DICOMQR","DUMMY SIUID")+1
;
; calculate accession number here 2/17/10, moved from Q0080050^MAGDQR06
;
D:TYPE="R"
. S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17) ; IA # 1172
. S ^TMP("MAG",$J,"ACCESSION")=$P($G(^RARPT(+X,0)),"^",1) ; IA # 1171
. Q
D:TYPE="C"
. N R2,TIUNUM,CONSIX
. S R2=$G(^MAG(2005,MAGIEN,2)) Q:R2=""
. I $P(R2,"^",6)=2006.5839 D Q
. . S CONSIX=$P(R2,"^",7)
. . S ^TMP("MAG",$J,"ACCESSION")=$$GMRCACN^MAGDFCNV(CONSIX)
. . Q
. I $P(R2,"^",6)=8925 D Q
. . S TIUNUM=$P(R2,"^",7) Q:'TIUNUM
. . S CONSIX=$P($G(^TIU(8925,TIUNUM,14)),"^",5)
. . S:$P(CONSIX,";",2)="GMR(123," ^TMP("MAG",$J,"ACCESSION")=$$GMRCACN^MAGDFCNV($P(CONSIX,";",1))
. . Q
. Q
D:TYPE="N"
. S STUDYIX=$$STUDYIX^MAGUE004(MAGIEN) Q:'STUDYIX
. S PROCIX=$P($G(^MAGV(2005.62,STUDYIX,6)),"^",1) Q:'PROCIX
. S PROCREC=$G(^MAGV(2005.61,PROCIX,0)) Q:PROCREC=""
. S PROCIDTYP=$P(PROCREC,"^",3)
. S ^TMP("MAG",$J,"ACCESSION")=""
. D:"^RAD^CON^"[("^"_PROCIDTYP_"^")
. . S ^TMP("MAG",$J,"ACCESSION")=$P(PROCREC,"^",1)
. . Q
. Q
;
; retrieve element values, indicate unsupported elements
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 Q
. . S L=L_"(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)"
. . D @L S V(T)=$G(V(T))
. . Q
. ; unsupported tag <> fatal error
. D ERR^MAGDQRUE("Cannot calculate value for tag: """_T_""".") S ERROR=1
. Q
;
I $D(^TMP("MAG",$J,"ERR")) D ERRSAV^MAGDQRUE S FATAL=1 G RESULTX
;
G RESULTX:'OK ; don't return result on key mismatch
;
D G RESULTX:'OK ; There must be a valid Study Instance UID
. N T ; P162 - Removed the new of the local V array to prevent undefined error in MAGDQR13
. S T="0020,000D" D Q020000D(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
. S OK=(V(T)'="")
. Q
;
D SAVRSLT^MAGDQR13(RESULT,MAGDFN,MAGIEN,.V)
;
RESULTX ; single exit point
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="",C=C+1 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 @FOUND="",C=C+1
. Q
Q C
;
Q0080018(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Image Instance UID
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. S V(T)="1.2.840.113754.2.1.3.1.1.1.1.66."_$G(^TMP("MAG",$J,"DICOMQR","DUMMY SIUID"))
. Q
; no
N SOPUID
S V(T)=""
D:MAGIEN'=""
. I (TYPE="R")!(TYPE="C") D Q
. . S V(T)=$P($G(^MAG(2005,MAGIEN,"PACS")),"^",1)
. . S SOPUID=$P($G(^MAG(2005,MAGIEN,"SOP")),"^",2)
. . S:SOPUID'="" V(T)=SOPUID
. . Q
. I TYPE="N" D Q
. . S V(T)=$P($G(^MAGV(2005.64,MAGIEN,0)),"^",1)
. . Q
. Q
Q
;
Q0080020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study Date
; sensitive/employee?
N STUDYIX
I SENSEMP D Q ; yes, scrub
. N I,REQDT S I=$O(REQ(T,"")) S:I REQDT=$TR($P($G(REQ(T,I)),"-",1),"*")
. S V(T)=$S($G(REQDT)?8N:REQDT,1:$$DT^XLFDT+17000000)
. Q
; no
S V(T)=""
D:MAGIEN
. I (TYPE="R")!(TYPE="C") D Q
. . S V(T)=$P($G(^MAG(2005,MAGIEN,2)),"^",5)
. . Q
. I TYPE="N" D Q
. . S STUDYIX=$$STUDYIX^MAGUE004(MAGIEN) Q:'STUDYIX
. . S V(T)=$P($G(^MAGV(2005.62,STUDYIX,2)),"^",1)
. . Q
. Q
S:V(T) V(T)=V(T)\1+17000000
Q
;
Q0080030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study Time
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I,REQTM S I=$O(REQ(T,"")) S:I REQTM=$TR($P($G(REQ(T,I)),"-",1),"*")
. S V(T)=$S($G(REQTM)?6N:REQTM,1:$E($P($$NOW^XLFDT,".",2)_"000000",1,6))
. Q
; no
S V(T)=""
D:MAGIEN
. I (TYPE="R")!(TYPE="C") D Q
. . S V(T)=$P($G(^MAG(2005,MAGIEN,2)),"^",5)
. . Q
. I TYPE="N" D Q
. . S STUDYIX=$$STUDYIX^MAGUE004(MAGIEN) Q:'STUDYIX
. . S V(T)=$P($G(^MAGV(2005.62,STUDYIX,2)),"^",1)
. . Q
. Q
S:V(T) V(T)=$TR($J("."_$P(V(T),".",2)*1E6,6)," ",0)
Q
;
Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Accession Number
D Q0080050^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0100010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Patient's Name
; No IA needed, PIMS 5.3
S V(T)=$S('SENSEMP:$P($G(^DPT(MAGDFN,0)),"^",1),1:"IMAGPATIENT,SENSITIVE")
S V(T)=$$VA2DCM^MAGDQR01(V(T))
Q
;
Q0100020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Patient ID
N DFN,VA
S DFN=MAGDFN
D PID^VADPT6 ; ICR supported #10062
S V(T)=$TR(VA("PID"),"-")
Q
;
Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study ID
D Q0200010^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q020000D(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Study Instance UID
D Q020000D^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow
Q
;
Q020000E(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Series Instance UID
Q ; not for study level query
D Q020000E^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow
Q
;
Q0080052(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Query Level
N I
S I=$O(REQ(T,"")),V(T)=""
S:I'="" V(T)=$G(REQ(T,I))
Q
;
Q0080061(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Modalities in Study
D Q0080061^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow
Q
;
Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O SOP Classes in Study
D Q0080062^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Referring Physician's Name
D Q0080090^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Study Description
D Q0081030^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0081032(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Procedure Code Sequence
Q
;
Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Value
D Q0080100^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0080102(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Coding Scheme Designator
S V("0008,1030",1,T)="C4"
Q
;
Q0080103(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Coding Scheme Version
S V("0008,1030",1,T)=4
Q
;
Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Meaning
D Q0080104^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Name of Physician(s) Reading Study
D Q0081060^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Admitting Diagnosis Description
D Q0081080^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0100021(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Issuer of Patient ID
S V(T)="USSSA"
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Birth Date
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I,REQDT S I=$O(REQ(T,"")) S:I REQDT=$TR($P($G(REQ(T,I)),"-",1),"*")
. S V(T)=$S($G(REQDT)?8N:REQDT,1:$$DT^XLFDT+17000000)
. Q
; no
S V(T)=$P($G(^DPT(MAGDFN,0)),"^",3)\1+17000000
I $E(V(T),5,6)="00" S V(T)="" ; invalid month for DICOM
I $E(V(T),7,8)="00" S V(T)="" ; invalid year for DICOM
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100032(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Birth Time
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I,REQTM S I=$O(REQ(T,"")) S:I REQTM=$TR($P($G(REQ(T,I)),"-",1),"*")
. S V(T)=$S($G(REQTM)?6N:REQTM,1:$E($P($$NOW^XLFDT,".",2)_"000000",1,6))
. Q
; no
S V(T)=$TR($J("."_$P($P($G(^DPT(MAGDFN,0)),"^",3),".",2)*1E6,6)," ",0)
S:V(T)="000000" V(T)="" ; no time on file
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0100040(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Sex
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S V(T)=$S(I:$S($G(REQ(T,I))]"":REQ(T,I),1:"O"),1:"O")
. Q
; no
S V(T)=$P($G(^DPT(MAGDFN,0)),"^",2)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Other Patient IDs
; sensitive/employee?
I SENSEMP S V(T)="000001234" Q ; yes, scrub
; no
N DFN,I,VA,VADPT
S DFN=MAGDFN D DEM^VADPT ; Supported IA (#10061)
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"))=""
I $T(GETICN^MPIF001)'="" S X=$$GETICN^MPIF001(DFN) S:+X DFN(X)="" ; Supported IA (#2701)
S I=0,X="" F S X=$O(DFN(X)) Q:X="" S I=I+1,V(T,I)=X
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101001(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Other Patient Names
; sensitive/employee?
I SENSEMP S V(T)="IMAGPATIENT,SENSITIVE" Q ; yes, scrub
; no
N D1,I
S (I,D1)=0 F S D1=$O(^DPT(MAGDFN,0.01,D1)) Q:'D1 D
. S X=$P($G(^DPT(MAGDFN,0.01,D1,0)),"^",1)
. S:X'="" I=I+1,V(T,I)=X
. Q
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Age
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
N DOB,FROM,YEARS
S DOB=$P($G(^DPT(MAGDFN,0)),"^",3)
S FROM=$P($G(^DPT(MAGDFN,.35)),"^",1) S:'FROM FROM=DT
S YEARS=$E(FROM,1,3)-$E(DOB,1,3)
S:$E(FROM,4,7)<$E(DOB,4,7) YEARS=YEARS-1
S V(T)=($P($J(YEARS/1000,0,3),".",2))_"Y"
;;;S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Size
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
S V(T)=$P($G(^DPT(MAGDFN,57)),"^",1) ; height in cm - field not populated
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0101030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Weight
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
S V(T)=$P($G(^DPT(MAGDFN,57)),"^",2) ; weight in kg - field not populated
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0102160(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Ethnic Group
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
S V(T)=$P($G(^DPT(MAGDFN,0)),"^",6)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q0102180(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Occupation
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
S V(T)=$P($G(^DPT(MAGDFN,0)),"^",7)
S:'$$COMPARE(T,V(T)) OK=0
Q
;
Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Additional Patient History
D Q01021B0^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient Comments
D Q0104000^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
;
Q0201206(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Series
D Q0201206^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow
Q
;
Q0201208(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Instances
D Q0201208^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow
Q
;
U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Interpretation Author
D U008010C^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR03 17102 printed Jan 18, 2025@03:02:03 Page 2
MAGDQR03 ;WOIFO/EdM,MLH,JSL,SAF,BT,DAC,NST - Imaging RPCs for Query/Retrieve ; 20 Jun 2015 1:36 PM
+1 ;;3.0;IMAGING;**51,54,66,123,118,138,162**;Mar 19, 2002;Build 22;Jun 20 2015
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
+19 ; When RESULT^MAGDQR03 is called, the following input parameters
+20 ; should be properly defined:
+21 ; TYPE = R(adiology) or C(onsult)
+22 ; REQ = array of element tags being queried for
+23 ; RESULT = pointer into results global (#2006.5732)
+24 ; MAGIEN = pointer into the Image File (#2005)
+25 ; MAGDFN = pointer into the Patient File (#2)
+26 ; MAGRORD = second level pointer into the Rad/Nuc Med Patient File (#70)
+27 ; (Radiology orders only)
+28 ; MAGINTERP = third level pointer into the Rad/Nuc Med Patient File (#70)
+29 ; (Radiology orders only)
+30 ;
+31 ; This routine contains code to calculate values for DICOM Tags
+32 ; that can be derived from those two pointers.
+33 ; All other DICOM Tags are computed in MAGDQR06.
+34 ; (This routine does the things that are the same for all images.
+35 ; MAGDQR06 differentiates between Radiology, Consults, and anything else.)
+36 ;
RESULT(TYPE,REQ,RESULT,MAGIEN,MAGDUZ,MAGDFN,MAGRORD,MAGINTERP,ERROR,FATAL) ;
+1 ; validate input parameters
Begin DoDot:1
+2 IF "^R^C^N^"'[("^"_TYPE_"^")
DO ERR^MAGDQRUE("Study type (radiology/consult/new DB) not defined")
QUIT
+3 IF '$GET(RESULT)
DO ERR^MAGDQRUE("Invalid query result set "_RESULT_" specified")
QUIT
+4 IF $DATA(MAGIEN)
IF ($DATA(^MAG(2005,MAGIEN)))!($DATA(^MAGV(2005.64,MAGIEN)))
+5 IF '$TEST
DO ERR^MAGDQRUE("Invalid image ID "_MAGIEN_" specified for result")
QUIT
+6 IF $DATA(MAGDFN)
IF $DATA(^DPT(MAGDFN))
+7 IF '$TEST
DO ERR^MAGDQRUE("Invalid patient ID "_MAGDFN_" specified for result")
QUIT
+8 IF TYPE="R"
IF '$GET(MAGRORD)
Begin DoDot:2
+9 DO ERR^MAGDQRUE("Invalid Radiology order number "_MAGRORD_" specified")
+10 QUIT
End DoDot:2
QUIT
+11 IF TYPE="R"
IF '$GET(MAGINTERP)
Begin DoDot:2
+12 DO ERR^MAGDQRUE("Invalid Radiology interpretation "_MAGINTERP_" specified")
+13 QUIT
End DoDot:2
QUIT
+14 QUIT
End DoDot:1
+15 IF $DATA(^TMP("MAG",$JOB,"ERR"))
DO ERRLOG^MAGDQRUE
QUIT
+16 ;
+17 NEW E,L,OK,V,X,T
+18 ; ----- sensitive/employee flag
NEW SENSEMP
+19 ; --- accession number
NEW ACCESSION
+20 ; ---- new series index
NEW SERIESIX
+21 ; ----- new study index
NEW STUDYIX
+22 ; ------ new procedure index
NEW PROCIX
+23 ; ----- new procedure record
NEW PROCREC
+24 ; --- procedure ID type in new DB
NEW PROCIDTYP
+25 ; ----------- patient DFN
NEW Y
+26 ; --------- inpatient/outpatient indicator
NEW DG1
+27 ; ------- option Name
NEW DGOPT
+28 ; --------- DIC variable for the SETLOG entry point
NEW DIC
+29 SET SENSEMP=0
SET OK=1
+30 ;
+31 ; new specs for sens/emp patients 3/20/09 - data will be picked up, but scrubbed
+32 ; 01/2010: suspend data suppression
+33 ; 05/2011: log access using supported PIMS entry point
+34 ;
+35 ; IA #3646
SET SENSEMP=SENSEMP+($$EMPL^DGSEC4(MAGDFN)=1)
+36 ; IA #767
SET SENSEMP=SENSEMP+($PIECE($GET(^DGSL(38.1,MAGDFN,0)),"^",2)=1)
+37 SET Y=MAGDFN
SET DG1=""
SET DGOPT="MAG DICOM QUERY RETRIEVE^MAG CFIND QUERY"
SET DIC(0)=""
+38 IF SENSEMP
DO SETLOG^DGSEC
+39 ; sensitive/employee data suppression to be suspended as of Jan 2010
SET SENSEMP=0
+40 ; increment (static) dummy Study Instance UID if sensitive/employee
+41 if SENSEMP
SET ^("DUMMY SIUID")=^TMP("MAG",$JOB,"DICOMQR","DUMMY SIUID")+1
+42 ;
+43 ; calculate accession number here 2/17/10, moved from Q0080050^MAGDQR06
+44 ;
+45 if TYPE="R"
Begin DoDot:1
+46 ; IA # 1172
SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17)
+47 ; IA # 1171
SET ^TMP("MAG",$JOB,"ACCESSION")=$PIECE($GET(^RARPT(+X,0)),"^",1)
+48 QUIT
End DoDot:1
+49 if TYPE="C"
Begin DoDot:1
+50 NEW R2,TIUNUM,CONSIX
+51 SET R2=$GET(^MAG(2005,MAGIEN,2))
if R2=""
QUIT
+52 IF $PIECE(R2,"^",6)=2006.5839
Begin DoDot:2
+53 SET CONSIX=$PIECE(R2,"^",7)
+54 SET ^TMP("MAG",$JOB,"ACCESSION")=$$GMRCACN^MAGDFCNV(CONSIX)
+55 QUIT
End DoDot:2
QUIT
+56 IF $PIECE(R2,"^",6)=8925
Begin DoDot:2
+57 SET TIUNUM=$PIECE(R2,"^",7)
if 'TIUNUM
QUIT
+58 SET CONSIX=$PIECE($GET(^TIU(8925,TIUNUM,14)),"^",5)
+59 if $PIECE(CONSIX,";",2)="GMR(123,"
SET ^TMP("MAG",$JOB,"ACCESSION")=$$GMRCACN^MAGDFCNV($PIECE(CONSIX,";",1))
+60 QUIT
End DoDot:2
QUIT
+61 QUIT
End DoDot:1
+62 if TYPE="N"
Begin DoDot:1
+63 SET STUDYIX=$$STUDYIX^MAGUE004(MAGIEN)
if 'STUDYIX
QUIT
+64 SET PROCIX=$PIECE($GET(^MAGV(2005.62,STUDYIX,6)),"^",1)
if 'PROCIX
QUIT
+65 SET PROCREC=$GET(^MAGV(2005.61,PROCIX,0))
if PROCREC=""
QUIT
+66 SET PROCIDTYP=$PIECE(PROCREC,"^",3)
+67 SET ^TMP("MAG",$JOB,"ACCESSION")=""
+68 if "^RAD^CON^"[("^"_PROCIDTYP_"^")
Begin DoDot:2
+69 SET ^TMP("MAG",$JOB,"ACCESSION")=$PIECE(PROCREC,"^",1)
+70 QUIT
End DoDot:2
+71 QUIT
End DoDot:1
+72 ;
+73 ; retrieve element values, indicate unsupported elements
+74 SET T=""
FOR
SET T=$ORDER(REQ(T))
if T=""
QUIT
Begin DoDot:1
+75 SET L=$TRANSLATE(T,",")
+76 SET E=$TRANSLATE($EXTRACT(L,1),"0123456789abcdef","QRSTUVWXYZABCDEF")
+77 SET $EXTRACT(L,1)=E
if L'?8UN
SET L=""
+78 IF L'=""
IF $TEXT(@L)'=""
Begin DoDot:2
+79 SET L=L_"(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)"
+80 DO @L
SET V(T)=$GET(V(T))
+81 QUIT
End DoDot:2
QUIT
+82 ; unsupported tag <> fatal error
+83 DO ERR^MAGDQRUE("Cannot calculate value for tag: """_T_""".")
SET ERROR=1
+84 QUIT
End DoDot:1
+85 ;
+86 IF $DATA(^TMP("MAG",$JOB,"ERR"))
DO ERRSAV^MAGDQRUE
SET FATAL=1
GOTO RESULTX
+87 ;
+88 ; don't return result on key mismatch
if 'OK
GOTO RESULTX
+89 ;
+90 ; There must be a valid Study Instance UID
Begin DoDot:1
+91 ; P162 - Removed the new of the local V array to prevent undefined error in MAGDQR13
NEW T
+92 SET T="0020,000D"
DO Q020000D(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+93 SET OK=(V(T)'="")
+94 QUIT
End DoDot:1
if 'OK
GOTO RESULTX
+95 ;
+96 DO SAVRSLT^MAGDQR13(RESULT,MAGDFN,MAGIEN,.V)
+97 ;
RESULTX ; single exit point
+1 QUIT
+2 ;
COMPARE(TAG,ACTUAL) NEW LOC,TMP,WILD
+1 if '$GET(REQ(TAG))
QUIT 1
+2 SET WILD=$GET(REQ(TAG,1))
if WILD=""
QUIT 0
+3 if $GET(ACTUAL)=""
QUIT 0
+4 SET LOC(ACTUAL)=""
+5 QUIT $$MATCHD(WILD,"LOC(LOOP)","TMP(LOOP)")
+6 ;
MATCH1(X,Y) NEW I,M
+1 FOR
if X=""
QUIT
if Y=""
QUIT
Begin DoDot:1
+2 IF $EXTRACT(X,1)=$EXTRACT(Y,1)
SET X=$EXTRACT(X,2,$LENGTH(X))
SET Y=$EXTRACT(Y,2,$LENGTH(Y))
QUIT
+3 IF $EXTRACT(Y,1)="?"
SET X=$EXTRACT(X,2,$LENGTH(X))
SET Y=$EXTRACT(Y,2,$LENGTH(Y))
QUIT
+4 IF $EXTRACT(Y,1)="*"
Begin DoDot:2
+5 IF Y="*"
SET (X,Y)=""
SET M=1
QUIT
+6 SET Y=$EXTRACT(Y,2,$LENGTH(Y))
SET M=0
+7 FOR I=1:1:$LENGTH(X)
IF $$MATCH1($EXTRACT(X,I,$LENGTH(X)),Y)
SET M=1
SET X=$EXTRACT(X,I,$LENGTH(X))
QUIT
+8 QUIT
End DoDot:2
if M
QUIT
+9 SET X="!"
SET Y=""
+10 QUIT
End DoDot:1
+11 if $TRANSLATE(Y,"*")=""
SET Y=""
if X'=""
QUIT 0
if Y'=""
QUIT 0
+12 QUIT 1
+13 ;
MATCHD(WILDCARD,STRUCTUR,FOUND) NEW C,LOOP,L1,L9,SEEK,X,Y
+1 ; -- Scans a structure,
+2 ; reports entries in @STRUCTUR that match WILDCARD;
+3 ; the result is reported in local array @FOUND
+4 SET C=0
+5 SET L1=$PIECE($PIECE(WILDCARD,"?",1),"*",1)
SET L9=L1_"~"
+6 IF L1=WILDCARD
Begin DoDot:1
+7 SET LOOP=L1
+8 IF $DATA(@STRUCTUR)
SET @FOUND=""
SET C=C+1
QUIT
+9 QUIT
End DoDot:1
QUIT C
+10 SET LOOP=L1
FOR
Begin DoDot:1
+11 if LOOP=""
QUIT
if '$DATA(@STRUCTUR)
QUIT
+12 if '$$MATCH1(LOOP,WILDCARD)
QUIT
+13 SET @FOUND=""
SET C=C+1
+14 QUIT
End DoDot:1
SET LOOP=$ORDER(@STRUCTUR)
if LOOP=""
QUIT
if LOOP]]L9
QUIT
+15 QUIT C
+16 ;
Q0080018(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Image Instance UID
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 SET V(T)="1.2.840.113754.2.1.3.1.1.1.1.66."_$GET(^TMP("MAG",$JOB,"DICOMQR","DUMMY SIUID"))
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 NEW SOPUID
+7 SET V(T)=""
+8 if MAGIEN'=""
Begin DoDot:1
+9 IF (TYPE="R")!(TYPE="C")
Begin DoDot:2
+10 SET V(T)=$PIECE($GET(^MAG(2005,MAGIEN,"PACS")),"^",1)
+11 SET SOPUID=$PIECE($GET(^MAG(2005,MAGIEN,"SOP")),"^",2)
+12 if SOPUID'=""
SET V(T)=SOPUID
+13 QUIT
End DoDot:2
QUIT
+14 IF TYPE="N"
Begin DoDot:2
+15 SET V(T)=$PIECE($GET(^MAGV(2005.64,MAGIEN,0)),"^",1)
+16 QUIT
End DoDot:2
QUIT
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
Q0080020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study Date
+1 ; sensitive/employee?
+2 NEW STUDYIX
+3 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+4 NEW I,REQDT
SET I=$ORDER(REQ(T,""))
if I
SET REQDT=$TRANSLATE($PIECE($GET(REQ(T,I)),"-",1),"*")
+5 SET V(T)=$SELECT($GET(REQDT)?8N:REQDT,1:$$DT^XLFDT+17000000)
+6 QUIT
End DoDot:1
QUIT
+7 ; no
+8 SET V(T)=""
+9 if MAGIEN
Begin DoDot:1
+10 IF (TYPE="R")!(TYPE="C")
Begin DoDot:2
+11 SET V(T)=$PIECE($GET(^MAG(2005,MAGIEN,2)),"^",5)
+12 QUIT
End DoDot:2
QUIT
+13 IF TYPE="N"
Begin DoDot:2
+14 SET STUDYIX=$$STUDYIX^MAGUE004(MAGIEN)
if 'STUDYIX
QUIT
+15 SET V(T)=$PIECE($GET(^MAGV(2005.62,STUDYIX,2)),"^",1)
+16 QUIT
End DoDot:2
QUIT
+17 QUIT
End DoDot:1
+18 if V(T)
SET V(T)=V(T)\1+17000000
+19 QUIT
+20 ;
Q0080030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study Time
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I,REQTM
SET I=$ORDER(REQ(T,""))
if I
SET REQTM=$TRANSLATE($PIECE($GET(REQ(T,I)),"-",1),"*")
+4 SET V(T)=$SELECT($GET(REQTM)?6N:REQTM,1:$EXTRACT($PIECE($$NOW^XLFDT,".",2)_"000000",1,6))
+5 QUIT
End DoDot:1
QUIT
+6 ; no
+7 SET V(T)=""
+8 if MAGIEN
Begin DoDot:1
+9 IF (TYPE="R")!(TYPE="C")
Begin DoDot:2
+10 SET V(T)=$PIECE($GET(^MAG(2005,MAGIEN,2)),"^",5)
+11 QUIT
End DoDot:2
QUIT
+12 IF TYPE="N"
Begin DoDot:2
+13 SET STUDYIX=$$STUDYIX^MAGUE004(MAGIEN)
if 'STUDYIX
QUIT
+14 SET V(T)=$PIECE($GET(^MAGV(2005.62,STUDYIX,2)),"^",1)
+15 QUIT
End DoDot:2
QUIT
+16 QUIT
End DoDot:1
+17 if V(T)
SET V(T)=$TRANSLATE($JUSTIFY("."_$PIECE(V(T),".",2)*1E6,6)," ",0)
+18 QUIT
+19 ;
Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Accession Number
+1 DO Q0080050^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0100010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Patient's Name
+1 ; No IA needed, PIMS 5.3
+2 SET V(T)=$SELECT('SENSEMP:$PIECE($GET(^DPT(MAGDFN,0)),"^",1),1:"IMAGPATIENT,SENSITIVE")
+3 SET V(T)=$$VA2DCM^MAGDQR01(V(T))
+4 QUIT
+5 ;
Q0100020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Patient ID
+1 NEW DFN,VA
+2 SET DFN=MAGDFN
+3 ; ICR supported #10062
DO PID^VADPT6
+4 SET V(T)=$TRANSLATE(VA("PID"),"-")
+5 QUIT
+6 ;
Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study ID
+1 DO Q0200010^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q020000D(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Study Instance UID
+1 ; overflow
DO Q020000D^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q020000E(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Series Instance UID
+1 ; not for study level query
QUIT
+2 ; overflow
DO Q020000E^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+3 QUIT
+4 ;
Q0080052(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Query Level
+1 NEW I
+2 SET I=$ORDER(REQ(T,""))
SET V(T)=""
+3 if I'=""
SET V(T)=$GET(REQ(T,I))
+4 QUIT
+5 ;
Q0080061(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Modalities in Study
+1 ; overflow
DO Q0080061^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O SOP Classes in Study
+1 DO Q0080062^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Referring Physician's Name
+1 DO Q0080090^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Study Description
+1 DO Q0081030^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0081032(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Procedure Code Sequence
+1 QUIT
+2 ;
Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Value
+1 DO Q0080100^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0080102(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Coding Scheme Designator
+1 SET V("0008,1030",1,T)="C4"
+2 QUIT
+3 ;
Q0080103(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Coding Scheme Version
+1 SET V("0008,1030",1,T)=4
+2 QUIT
+3 ;
Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Meaning
+1 DO Q0080104^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Name of Physician(s) Reading Study
+1 DO Q0081060^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Admitting Diagnosis Description
+1 DO Q0081080^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0100021(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Issuer of Patient ID
+1 SET V(T)="USSSA"
+2 if '$$COMPARE(T,V(T))
SET OK=0
+3 QUIT
+4 ;
Q0100030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Birth Date
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I,REQDT
SET I=$ORDER(REQ(T,""))
if I
SET REQDT=$TRANSLATE($PIECE($GET(REQ(T,I)),"-",1),"*")
+4 SET V(T)=$SELECT($GET(REQDT)?8N:REQDT,1:$$DT^XLFDT+17000000)
+5 QUIT
End DoDot:1
QUIT
+6 ; no
+7 SET V(T)=$PIECE($GET(^DPT(MAGDFN,0)),"^",3)\1+17000000
+8 ; invalid month for DICOM
IF $EXTRACT(V(T),5,6)="00"
SET V(T)=""
+9 ; invalid year for DICOM
IF $EXTRACT(V(T),7,8)="00"
SET V(T)=""
+10 if '$$COMPARE(T,V(T))
SET OK=0
+11 QUIT
+12 ;
Q0100032(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Birth Time
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I,REQTM
SET I=$ORDER(REQ(T,""))
if I
SET REQTM=$TRANSLATE($PIECE($GET(REQ(T,I)),"-",1),"*")
+4 SET V(T)=$SELECT($GET(REQTM)?6N:REQTM,1:$EXTRACT($PIECE($$NOW^XLFDT,".",2)_"000000",1,6))
+5 QUIT
End DoDot:1
QUIT
+6 ; no
+7 SET V(T)=$TRANSLATE($JUSTIFY("."_$PIECE($PIECE($GET(^DPT(MAGDFN,0)),"^",3),".",2)*1E6,6)," ",0)
+8 ; no time on file
if V(T)="000000"
SET V(T)=""
+9 if '$$COMPARE(T,V(T))
SET OK=0
+10 QUIT
+11 ;
Q0100040(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Sex
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
SET V(T)=$SELECT(I:$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"O"),1:"O")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 SET V(T)=$PIECE($GET(^DPT(MAGDFN,0)),"^",2)
+7 if '$$COMPARE(T,V(T))
SET OK=0
+8 QUIT
+9 ;
Q0101000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Other Patient IDs
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
SET V(T)="000001234"
QUIT
+3 ; no
+4 NEW DFN,I,VA,VADPT
+5 ; Supported IA (#10061)
SET DFN=MAGDFN
DO DEM^VADPT
+6 SET X=$PIECE(^DPT(DFN,0),"^",9)
if X'=""
SET DFN(X)=""
+7 if $GET(VA("PID"))'=""
SET DFN(VA("PID"))=""
+8 if $GET(VA("BID"))'=""
SET DFN(VA("BID"))=""
+9 ; Supported IA (#2701)
IF $TEXT(GETICN^MPIF001)'=""
SET X=$$GETICN^MPIF001(DFN)
if +X
SET DFN(X)=""
+10 SET I=0
SET X=""
FOR
SET X=$ORDER(DFN(X))
if X=""
QUIT
SET I=I+1
SET V(T,I)=X
+11 ;;;S:'$$COMPARE(T,V(T)) OK=0
+12 QUIT
+13 ;
Q0101001(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Other Patient Names
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
SET V(T)="IMAGPATIENT,SENSITIVE"
QUIT
+3 ; no
+4 NEW D1,I
+5 SET (I,D1)=0
FOR
SET D1=$ORDER(^DPT(MAGDFN,0.01,D1))
if 'D1
QUIT
Begin DoDot:1
+6 SET X=$PIECE($GET(^DPT(MAGDFN,0.01,D1,0)),"^",1)
+7 if X'=""
SET I=I+1
SET V(T,I)=X
+8 QUIT
End DoDot:1
+9 ;;;S:'$$COMPARE(T,V(T)) OK=0
+10 QUIT
+11 ;
Q0101010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Age
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 NEW DOB,FROM,YEARS
+7 SET DOB=$PIECE($GET(^DPT(MAGDFN,0)),"^",3)
+8 SET FROM=$PIECE($GET(^DPT(MAGDFN,.35)),"^",1)
if 'FROM
SET FROM=DT
+9 SET YEARS=$EXTRACT(FROM,1,3)-$EXTRACT(DOB,1,3)
+10 if $EXTRACT(FROM,4,7)<$EXTRACT(DOB,4,7)
SET YEARS=YEARS-1
+11 SET V(T)=($PIECE($JUSTIFY(YEARS/1000,0,3),".",2))_"Y"
+12 ;;;S:'$$COMPARE(T,V(T)) OK=0
+13 QUIT
+14 ;
Q0101020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Size
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 ; height in cm - field not populated
SET V(T)=$PIECE($GET(^DPT(MAGDFN,57)),"^",1)
+7 if '$$COMPARE(T,V(T))
SET OK=0
+8 QUIT
+9 ;
Q0101030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Weight
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 ; weight in kg - field not populated
SET V(T)=$PIECE($GET(^DPT(MAGDFN,57)),"^",2)
+7 if '$$COMPARE(T,V(T))
SET OK=0
+8 QUIT
+9 ;
Q0102160(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Ethnic Group
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 SET V(T)=$PIECE($GET(^DPT(MAGDFN,0)),"^",6)
+7 if '$$COMPARE(T,V(T))
SET OK=0
+8 QUIT
+9 ;
Q0102180(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Occupation
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 SET V(T)=$PIECE($GET(^DPT(MAGDFN,0)),"^",7)
+7 if '$$COMPARE(T,V(T))
SET OK=0
+8 QUIT
+9 ;
Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Additional Patient History
+1 DO Q01021B0^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient Comments
+1 DO Q0104000^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0201206(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Series
+1 ; overflow
DO Q0201206^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
Q0201208(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Instances
+1 ; overflow
DO Q0201208^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
+3 ;
U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Interpretation Author
+1 DO U008010C^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)
+2 QUIT
