MAGDSTQ6 ;WOIFO/PMK - Study Tracker - Patient Level Query/Retrieve Display; Sep 02, 2020@11:29:05
;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Aug 30, 2013
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Notice: This routine is on both VistA and the DICOM Gateway
;
;
Q
;
PATIENT() ;
N VAR S VAR=""
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
W "Name: ",$$NAME^MAGDSTQ6(PNAME)
W ?47,"DOB: ",$$DATE^MAGDSTQ6(DOB,"SHORT")
W ?65,"Sex: ",SEX
W !?2,"ID: ",PID
W ?47,"Ethnicity: ",ETHNICITY
W !,"Other PID: ",PIDOTHER
W !
;
; quit at this point if there are studies for the patient
I $G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT)) Q 0
;
D NUMBERS
;
I $$YESNO^MAGDSTQ("Is this the correct Patient?","n",.X)<0 Q CARET
I "Yy"'[$E(X) Q INCORRECT
;
D SETKEYS(LEVEL)
Q JPATIENT
;
STUDY() ; display a study and select it
N PROMPT
S RETURN=$$PATIENT() ; ignore RETURN
;
N VAR S VAR=""
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
W !,"Accession No: ",ACNUMB
W ?55,"Study Date: ",$$DATE^MAGDSTQ6(STUDYDATE,"SHORT")
W !,"Description: ",DESCRIPTION
W ?55,"Study Time: ",$$TIME^MAGDSTQ6(STUDYTIME)
W !,"Study ID: ",STUDYID
I CPTCODE W ?55,"CPT Code: ",CPTCODE,?72,CPTNAME
;
W !!,"Requesting Physician: ",$$NAME^MAGDSTQ6(REQDOC)
W !,"Referring Physician: ",$$NAME^MAGDSTQ6(REFDOC)
W !,"Institution: ",INSTNAME
W !
I REASON'="" W !,"Reason for Study:",REASON,!
;
; quit at this point if there are series for the patient and study
I $G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY)) Q 0
;
D NUMBERS
W !
I MODALITIES'="" D ; Modalities in Study (0008,0061)
. W !,$S(MODALITIES[",":"Modalities",1:"Modality")
. W ": ",MODALITIES,!
. Q
;
D UID
;
I $$YESNO^MAGDSTQ("Is this the correct Patient and Study?","n",.X)<0 Q CARET
I "Yy"'[$E(X) Q INCORRECT
;
D SETKEYS(LEVEL)
Q JSTUDY
;
SERIES() ;
N PROMPT
S RETURN=$$STUDY() ; ignore RETURN
;
N VAR S VAR=""
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
;
; quit at this point if there are images for the patient, study, and series
I $G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES)) D Q 0
. S MODALITY=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"MODALITY"))
. W !,"Modality: ",MODALITY," Series Number: ",SERIESNO
. Q
D NUMBERS
W !!,"Modality: ",MODALITY," Series Number: ",SERIESNO,!
D UID
;
I $$YESNO^MAGDSTQ("Is this the correct Patient, Study, and Series?","n",.X)<0 Q CARET
I "Yy"'[$E(X) Q INCORRECT
;
D SETKEYS(LEVEL)
Q JSERIES
;
IMAGE() ;
S RETURN=$$SERIES() ; ignore RETURN
;
W !!,"Image attributes:"
N VAR S VAR=""
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES,JIMAGE,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
W !,"Image Number: ",IMAGENO
D UID
;
I $$YESNO^MAGDSTQ("Is this the correct Patient, Study, Series, and Image?","n",.X)<0 Q CARET
I "Yy"'[$E(X) Q INCORRECT
;
D SETKEYS(LEVEL)
Q JIMAGE
;
SETKEYS(LEVEL) ; set query/retrieve keys
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")=LEVEL ; retrieve at same level
; save patient q/r keys
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT NAME")=PNAME
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID")=PID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE")=DOB
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT'S SEX")=SEX
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"OTHER PATIENT IDS")=PIDOTHER
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ETHNICITY")=ETHNICITY
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NPATIENTRST")=NPATIENTRST
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NPATIENTRSE")=NPATIENTRSE
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NPATIENTRI")=NPATIENTRI
I LEVEL="PATIENT" S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="STUDY" Q
;
; save study q/r keys
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"DESCRIPTION")=DESCRIPTION
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"INSTITUTION NAME")=INSTNAME
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY ID")=STUDYID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=STUDYUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY DATE")=STUDYDATE
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY TIME")=STUDYTIME
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"REFERRING PHYSICIAN")=REFDOC
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NSTUDYRS")=NSTUDYRS
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NSTUDYRI")=NSTUDYRI
I LEVEL="STUDY" S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="SERIES" Q
;
; save series q/r keys
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"MODALITY")=MODALITY ; (0008,0060) Modality
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES NUMBER")=SERIESNO
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=SERIESUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NSERIESRI")=NSERIESRI
I LEVEL="SERIES" S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE" Q
;
; save image q/r keys
F S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES,JIMAGE,VAR)) Q:VAR="" N @VAR S @VAR=^(VAR)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID(0001)")=SOPUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE"
Q
;
NUMBERS ; output patient, study, and series related counts
N NPATIENTRST,NPATIENTRSE,NPATIENTRI,NSTUDYRS,NSTUDYRI,NSERIESRI
I $G(JPATIENT) D
. I LEVEL="PATIENT" D
. . S NPATIENTRST=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRST"))
. . S NPATIENTRSE=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRSE"))
. . S NPATIENTRI=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRI"))
. . W !,"Number of Patient Related Studies: ",NPATIENTRST
. . W ", Series: ",NPATIENTRSE
. . W ", Images: ",NPATIENTRI
. . Q
. I $G(JSTUDY) D
. . I LEVEL="STUDY" D
. . . S NSTUDYRS=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,"NSTUDYRS"))
. . . S NSTUDYRI=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,"NSTUDYRI"))
. . . W !,"Number of Study Related Series: ",NSTUDYRS
. . . W ", Images: ",NSTUDYRI
. . . Q
. . I $G(JSERIES) D
. . . I LEVEL="SERIES" D
. . . . S NSERIESRI=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,"NSERIESRI"))
. . . . W !,"Number of Series Related Images: ",NSERIESRI
. . . . Q
. . . Q
. . Q
. Q
Q
;
UID ;
I $G(STUDYUID)'="" D
. W !,"Study UID: ",STUDYUID
. Q
I $G(SERIESUID)'="" D
. W !,"Series UID:",SERIESUID
. Q
I $G(SOPUID)'="" D
. W !,"SOP UID: ",SOPUID
. I SOPCLASS'="" D
. . W !,"SOP Class: "
. . I $$VISTA^MAGDSTQ D ; code for VistA
. . . N IPTR
. . . S IPTR=$O(^MAGDICOM(2006.539,"B",SOPCLASS,""))
. . . I IPTR="" W "*** Unknown UID: <<",SOPCLASS,">> ***"
. . . E W $P(^MAGDICOM(2006.539,IPTR,0),"^",2)
. . . Q
. . E I '$$VISTA^MAGDSTQ D ; code for DICOM Gateway
. . . W $$GETNAME^MAGDUID2(SOPCLASS)
. . . Q
. . Q
. Q
W !
Q
;
NAME(DCMNAME) ; convert a DICOM person name to a readable format
N FIRST,LAST,MIDDLE,NAME,PREFIX,SUFFIX
I DCMNAME="" Q "" ; no name
I DCMNAME="<unknown>" Q DCMNAME
S LAST=$P(DCMNAME,"^",1),FIRST=$P(DCMNAME,"^",2)
S MIDDLE=$P(DCMNAME,"^",3)
S PREFIX=$P(DCMNAME,"^",4),SUFFIX=$P(DCMNAME,"^",5)
S NAME=LAST I (FIRST'="")!(MIDDLE'="") S NAME=NAME_","
I FIRST'="" S NAME=NAME_FIRST
E S NAME=NAME_" <no first name>"
I MIDDLE'="" S NAME=NAME_" "_MIDDLE
I PREFIX'="" S NAME="("_PREFIX_") "_NAME
I SUFFIX'="" S NAME=NAME_" ("_SUFFIX_")"
Q NAME
;
DATE(DCMDATE,FORMAT) ; convert a DICOM date to a readable date
N DATE,DAY,MONTH,YEAR
I DCMDATE="<unknown>" Q "???"
S FORMAT=$G(FORMAT,"LONG")
S YEAR=$E(DCMDATE,1,4),MONTH=+$E(DCMDATE,5,6),DAY=+$E(DCMDATE,7,8)
I FORMAT="SHORT" D
. S:MONTH<10 MONTH="0"_MONTH S:DAY<10 DAY="0"_DAY
. S DATE=MONTH_"/"_DAY_"/"_YEAR
. Q
E D
. S MONTH=$P("January,February,March,April,May,June,July,August,September,October,November,December",",",MONTH)
. S DATE=DAY_" "_MONTH_" "_YEAR
. Q
Q DATE
;
TIME(DCMTIME) ; convert a DICOM time to a readable time
N HOUR,MINUTE,SECOND,TIME
S HOUR=$E(DCMTIME,1,2),MINUTE=$E(DCMTIME,3,4),SECOND=$E(DCMTIME,5,6)
S TIME=HOUR_":"_MINUTE_":"_SECOND
Q TIME
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQ6 9750 printed Dec 13, 2024@02:02 Page 2
MAGDSTQ6 ;WOIFO/PMK - Study Tracker - Patient Level Query/Retrieve Display; Sep 02, 2020@11:29:05
+1 ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Aug 30, 2013
+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 ;
+18 ; Notice: This routine is on both VistA and the DICOM Gateway
+19 ;
+20 ;
+21 QUIT
+22 ;
PATIENT() ;
+1 NEW VAR
SET VAR=""
+2 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"PATIENT",JPATIENT,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+3 WRITE "Name: ",$$NAME^MAGDSTQ6(PNAME)
+4 WRITE ?47,"DOB: ",$$DATE^MAGDSTQ6(DOB,"SHORT")
+5 WRITE ?65,"Sex: ",SEX
+6 WRITE !?2,"ID: ",PID
+7 WRITE ?47,"Ethnicity: ",ETHNICITY
+8 WRITE !,"Other PID: ",PIDOTHER
+9 WRITE !
+10 ;
+11 ; quit at this point if there are studies for the patient
+12 IF $GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",JPATIENT))
QUIT 0
+13 ;
+14 DO NUMBERS
+15 ;
+16 IF $$YESNO^MAGDSTQ("Is this the correct Patient?","n",.X)<0
QUIT CARET
+17 IF "Yy"'[$EXTRACT(X)
QUIT INCORRECT
+18 ;
+19 DO SETKEYS(LEVEL)
+20 QUIT JPATIENT
+21 ;
STUDY() ; display a study and select it
+1 NEW PROMPT
+2 ; ignore RETURN
SET RETURN=$$PATIENT()
+3 ;
+4 NEW VAR
SET VAR=""
+5 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",JPATIENT,JSTUDY,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+6 WRITE !,"Accession No: ",ACNUMB
+7 WRITE ?55,"Study Date: ",$$DATE^MAGDSTQ6(STUDYDATE,"SHORT")
+8 WRITE !,"Description: ",DESCRIPTION
+9 WRITE ?55,"Study Time: ",$$TIME^MAGDSTQ6(STUDYTIME)
+10 WRITE !,"Study ID: ",STUDYID
+11 IF CPTCODE
WRITE ?55,"CPT Code: ",CPTCODE,?72,CPTNAME
+12 ;
+13 WRITE !!,"Requesting Physician: ",$$NAME^MAGDSTQ6(REQDOC)
+14 WRITE !,"Referring Physician: ",$$NAME^MAGDSTQ6(REFDOC)
+15 WRITE !,"Institution: ",INSTNAME
+16 WRITE !
+17 IF REASON'=""
WRITE !,"Reason for Study:",REASON,!
+18 ;
+19 ; quit at this point if there are series for the patient and study
+20 IF $GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"SERIES",JPATIENT,JSTUDY))
QUIT 0
+21 ;
+22 DO NUMBERS
+23 WRITE !
+24 ; Modalities in Study (0008,0061)
IF MODALITIES'=""
Begin DoDot:1
+25 WRITE !,$SELECT(MODALITIES[",":"Modalities",1:"Modality")
+26 WRITE ": ",MODALITIES,!
+27 QUIT
End DoDot:1
+28 ;
+29 DO UID
+30 ;
+31 IF $$YESNO^MAGDSTQ("Is this the correct Patient and Study?","n",.X)<0
QUIT CARET
+32 IF "Yy"'[$EXTRACT(X)
QUIT INCORRECT
+33 ;
+34 DO SETKEYS(LEVEL)
+35 QUIT JSTUDY
+36 ;
SERIES() ;
+1 NEW PROMPT
+2 ; ignore RETURN
SET RETURN=$$STUDY()
+3 ;
+4 NEW VAR
SET VAR=""
+5 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+6 ;
+7 ; quit at this point if there are images for the patient, study, and series
+8 IF $GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES))
Begin DoDot:1
+9 SET MODALITY=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"MODALITY"))
+10 WRITE !,"Modality: ",MODALITY," Series Number: ",SERIESNO
+11 QUIT
End DoDot:1
QUIT 0
+12 DO NUMBERS
+13 WRITE !!,"Modality: ",MODALITY," Series Number: ",SERIESNO,!
+14 DO UID
+15 ;
+16 IF $$YESNO^MAGDSTQ("Is this the correct Patient, Study, and Series?","n",.X)<0
QUIT CARET
+17 IF "Yy"'[$EXTRACT(X)
QUIT INCORRECT
+18 ;
+19 DO SETKEYS(LEVEL)
+20 QUIT JSERIES
+21 ;
IMAGE() ;
+1 ; ignore RETURN
SET RETURN=$$SERIES()
+2 ;
+3 WRITE !!,"Image attributes:"
+4 NEW VAR
SET VAR=""
+5 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES,JIMAGE,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+6 WRITE !,"Image Number: ",IMAGENO
+7 DO UID
+8 ;
+9 IF $$YESNO^MAGDSTQ("Is this the correct Patient, Study, Series, and Image?","n",.X)<0
QUIT CARET
+10 IF "Yy"'[$EXTRACT(X)
QUIT INCORRECT
+11 ;
+12 DO SETKEYS(LEVEL)
+13 QUIT JIMAGE
+14 ;
SETKEYS(LEVEL) ; set query/retrieve keys
+1 ; retrieve at same level
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")=LEVEL
+2 ; save patient q/r keys
+3 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"PATIENT",JPATIENT,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+4 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT NAME")=PNAME
+5 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID")=PID
+6 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE")=DOB
+7 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT'S SEX")=SEX
+8 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"OTHER PATIENT IDS")=PIDOTHER
+9 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ETHNICITY")=ETHNICITY
+10 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"NPATIENTRST")=NPATIENTRST
+11 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"NPATIENTRSE")=NPATIENTRSE
+12 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"NPATIENTRI")=NPATIENTRI
+13 IF LEVEL="PATIENT"
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="STUDY"
QUIT
+14 ;
+15 ; save study q/r keys
+16 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",JPATIENT,JSTUDY,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+17 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
+18 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"DESCRIPTION")=DESCRIPTION
+19 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"INSTITUTION NAME")=INSTNAME
+20 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY ID")=STUDYID
+21 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=STUDYUID
+22 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY DATE")=STUDYDATE
+23 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY TIME")=STUDYTIME
+24 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"REFERRING PHYSICIAN")=REFDOC
+25 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"NSTUDYRS")=NSTUDYRS
+26 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"NSTUDYRI")=NSTUDYRI
+27 IF LEVEL="STUDY"
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="SERIES"
QUIT
+28 ;
+29 ; save series q/r keys
+30 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+31 ; (0008,0060) Modality
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"MODALITY")=MODALITY
+32 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SERIES NUMBER")=SERIESNO
+33 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=SERIESUID
+34 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"NSERIESRI")=NSERIESRI
+35 IF LEVEL="SERIES"
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE"
QUIT
+36 ;
+37 ; save image q/r keys
+38 FOR
SET VAR=$ORDER(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES,JIMAGE,VAR))
if VAR=""
QUIT
NEW @VAR
SET @VAR=^(VAR)
+39 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID(0001)")=SOPUID
+40 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE"
+41 QUIT
+42 ;
NUMBERS ; output patient, study, and series related counts
+1 NEW NPATIENTRST,NPATIENTRSE,NPATIENTRI,NSTUDYRS,NSTUDYRI,NSERIESRI
+2 IF $GET(JPATIENT)
Begin DoDot:1
+3 IF LEVEL="PATIENT"
Begin DoDot:2
+4 SET NPATIENTRST=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRST"))
+5 SET NPATIENTRSE=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRSE"))
+6 SET NPATIENTRI=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRI"))
+7 WRITE !,"Number of Patient Related Studies: ",NPATIENTRST
+8 WRITE ", Series: ",NPATIENTRSE
+9 WRITE ", Images: ",NPATIENTRI
+10 QUIT
End DoDot:2
+11 IF $GET(JSTUDY)
Begin DoDot:2
+12 IF LEVEL="STUDY"
Begin DoDot:3
+13 SET NSTUDYRS=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",JPATIENT,JSTUDY,"NSTUDYRS"))
+14 SET NSTUDYRI=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"STUDY",JPATIENT,JSTUDY,"NSTUDYRI"))
+15 WRITE !,"Number of Study Related Series: ",NSTUDYRS
+16 WRITE ", Images: ",NSTUDYRI
+17 QUIT
End DoDot:3
+18 IF $GET(JSERIES)
Begin DoDot:3
+19 IF LEVEL="SERIES"
Begin DoDot:4
+20 SET NSERIESRI=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,"NSERIESRI"))
+21 WRITE !,"Number of Series Related Images: ",NSERIESRI
+22 QUIT
End DoDot:4
+23 QUIT
End DoDot:3
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 QUIT
+27 ;
UID ;
+1 IF $GET(STUDYUID)'=""
Begin DoDot:1
+2 WRITE !,"Study UID: ",STUDYUID
+3 QUIT
End DoDot:1
+4 IF $GET(SERIESUID)'=""
Begin DoDot:1
+5 WRITE !,"Series UID:",SERIESUID
+6 QUIT
End DoDot:1
+7 IF $GET(SOPUID)'=""
Begin DoDot:1
+8 WRITE !,"SOP UID: ",SOPUID
+9 IF SOPCLASS'=""
Begin DoDot:2
+10 WRITE !,"SOP Class: "
+11 ; code for VistA
IF $$VISTA^MAGDSTQ
Begin DoDot:3
+12 NEW IPTR
+13 SET IPTR=$ORDER(^MAGDICOM(2006.539,"B",SOPCLASS,""))
+14 IF IPTR=""
WRITE "*** Unknown UID: <<",SOPCLASS,">> ***"
+15 IF '$TEST
WRITE $PIECE(^MAGDICOM(2006.539,IPTR,0),"^",2)
+16 QUIT
End DoDot:3
+17 ; code for DICOM Gateway
IF '$TEST
IF '$$VISTA^MAGDSTQ
Begin DoDot:3
+18 WRITE $$GETNAME^MAGDUID2(SOPCLASS)
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 WRITE !
+23 QUIT
+24 ;
NAME(DCMNAME) ; convert a DICOM person name to a readable format
+1 NEW FIRST,LAST,MIDDLE,NAME,PREFIX,SUFFIX
+2 ; no name
IF DCMNAME=""
QUIT ""
+3 IF DCMNAME="<unknown>"
QUIT DCMNAME
+4 SET LAST=$PIECE(DCMNAME,"^",1)
SET FIRST=$PIECE(DCMNAME,"^",2)
+5 SET MIDDLE=$PIECE(DCMNAME,"^",3)
+6 SET PREFIX=$PIECE(DCMNAME,"^",4)
SET SUFFIX=$PIECE(DCMNAME,"^",5)
+7 SET NAME=LAST
IF (FIRST'="")!(MIDDLE'="")
SET NAME=NAME_","
+8 IF FIRST'=""
SET NAME=NAME_FIRST
+9 IF '$TEST
SET NAME=NAME_" <no first name>"
+10 IF MIDDLE'=""
SET NAME=NAME_" "_MIDDLE
+11 IF PREFIX'=""
SET NAME="("_PREFIX_") "_NAME
+12 IF SUFFIX'=""
SET NAME=NAME_" ("_SUFFIX_")"
+13 QUIT NAME
+14 ;
DATE(DCMDATE,FORMAT) ; convert a DICOM date to a readable date
+1 NEW DATE,DAY,MONTH,YEAR
+2 IF DCMDATE="<unknown>"
QUIT "???"
+3 SET FORMAT=$GET(FORMAT,"LONG")
+4 SET YEAR=$EXTRACT(DCMDATE,1,4)
SET MONTH=+$EXTRACT(DCMDATE,5,6)
SET DAY=+$EXTRACT(DCMDATE,7,8)
+5 IF FORMAT="SHORT"
Begin DoDot:1
+6 if MONTH<10
SET MONTH="0"_MONTH
if DAY<10
SET DAY="0"_DAY
+7 SET DATE=MONTH_"/"_DAY_"/"_YEAR
+8 QUIT
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET MONTH=$PIECE("January,February,March,April,May,June,July,August,September,October,November,December",",",MONTH)
+11 SET DATE=DAY_" "_MONTH_" "_YEAR
+12 QUIT
End DoDot:1
+13 QUIT DATE
+14 ;
TIME(DCMTIME) ; convert a DICOM time to a readable time
+1 NEW HOUR,MINUTE,SECOND,TIME
+2 SET HOUR=$EXTRACT(DCMTIME,1,2)
SET MINUTE=$EXTRACT(DCMTIME,3,4)
SET SECOND=$EXTRACT(DCMTIME,5,6)
+3 SET TIME=HOUR_":"_MINUTE_":"_SECOND
+4 QUIT TIME
