Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDSTQ6

MAGDSTQ6.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ; 
  1.  ; Notice: This routine is on both VistA and the DICOM Gateway
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. PATIENT() ;
  1.  N VAR S VAR=""
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  W "Name: ",$$NAME^MAGDSTQ6(PNAME)
  1.  W ?47,"DOB: ",$$DATE^MAGDSTQ6(DOB,"SHORT")
  1.  W ?65,"Sex: ",SEX
  1.  W !?2,"ID: ",PID
  1.  W ?47,"Ethnicity: ",ETHNICITY
  1.  W !,"Other PID: ",PIDOTHER
  1.  W !
  1.  ;
  1.  ; quit at this point if there are studies for the patient
  1.  I $G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT)) Q 0
  1.  ;
  1.  D NUMBERS
  1.  ;
  1.  I $$YESNO^MAGDSTQ("Is this the correct Patient?","n",.X)<0 Q CARET
  1.  I "Yy"'[$E(X) Q INCORRECT
  1.  ;
  1.  D SETKEYS(LEVEL)
  1.  Q JPATIENT
  1.  ;
  1. STUDY() ; display a study and select it
  1.  N PROMPT
  1.  S RETURN=$$PATIENT() ; ignore RETURN
  1.  ;
  1.  N VAR S VAR=""
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  W !,"Accession No: ",ACNUMB
  1.  W ?55,"Study Date: ",$$DATE^MAGDSTQ6(STUDYDATE,"SHORT")
  1.  W !,"Description: ",DESCRIPTION
  1.  W ?55,"Study Time: ",$$TIME^MAGDSTQ6(STUDYTIME)
  1.  W !,"Study ID: ",STUDYID
  1.  I CPTCODE W ?55,"CPT Code: ",CPTCODE,?72,CPTNAME
  1.  ;
  1.  W !!,"Requesting Physician: ",$$NAME^MAGDSTQ6(REQDOC)
  1.  W !,"Referring  Physician: ",$$NAME^MAGDSTQ6(REFDOC)
  1.  W !,"Institution: ",INSTNAME
  1.  W !
  1.  I REASON'="" W !,"Reason for Study:",REASON,!
  1.  ;
  1.  ; quit at this point if there are series for the patient and study
  1.  I $G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY)) Q 0
  1.  ;
  1.  D NUMBERS
  1.  W !
  1.  I MODALITIES'="" D  ; Modalities in Study (0008,0061)
  1.  . W !,$S(MODALITIES[",":"Modalities",1:"Modality")
  1.  . W ": ",MODALITIES,!
  1.  . Q
  1.  ;
  1.  D UID
  1.  ;
  1.  I $$YESNO^MAGDSTQ("Is this the correct Patient and Study?","n",.X)<0 Q CARET
  1.  I "Yy"'[$E(X) Q INCORRECT
  1.  ; 
  1.  D SETKEYS(LEVEL)
  1.  Q JSTUDY
  1.  ;
  1. SERIES() ;
  1.  N PROMPT
  1.  S RETURN=$$STUDY()   ; ignore RETURN
  1.  ;
  1.  N VAR S VAR=""
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  ;
  1.  ; quit at this point if there are images for the patient, study, and series
  1.  I $G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES)) D  Q 0
  1.  . S MODALITY=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"MODALITY"))
  1.  . W !,"Modality: ",MODALITY,"        Series Number: ",SERIESNO
  1.  . Q
  1.  D NUMBERS
  1.  W !!,"Modality: ",MODALITY,"        Series Number: ",SERIESNO,!
  1.  D UID
  1.  ;
  1.  I $$YESNO^MAGDSTQ("Is this the correct Patient, Study, and Series?","n",.X)<0 Q CARET
  1.  I "Yy"'[$E(X) Q INCORRECT
  1.  ;
  1.  D SETKEYS(LEVEL)
  1.  Q JSERIES
  1.  ;
  1. IMAGE() ;
  1.  S RETURN=$$SERIES()  ; ignore RETURN
  1.  ;
  1.  W !!,"Image attributes:"
  1.  N VAR S VAR=""
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES,JIMAGE,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  W !,"Image Number: ",IMAGENO
  1.  D UID
  1.  ;
  1.  I $$YESNO^MAGDSTQ("Is this the correct Patient, Study, Series, and Image?","n",.X)<0 Q CARET
  1.  I "Yy"'[$E(X) Q INCORRECT
  1.  ;
  1.  D SETKEYS(LEVEL)
  1.  Q JIMAGE
  1.  ;
  1. SETKEYS(LEVEL) ; set query/retrieve keys
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")=LEVEL ; retrieve at same level
  1.  ; save patient q/r keys
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT NAME")=PNAME
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID")=PID
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE")=DOB
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT'S SEX")=SEX
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"OTHER PATIENT IDS")=PIDOTHER
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ETHNICITY")=ETHNICITY
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NPATIENTRST")=NPATIENTRST
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NPATIENTRSE")=NPATIENTRSE
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NPATIENTRI")=NPATIENTRI
  1.  I LEVEL="PATIENT" S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="STUDY" Q
  1.  ;
  1.  ; save study q/r keys
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"DESCRIPTION")=DESCRIPTION
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"INSTITUTION NAME")=INSTNAME
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY ID")=STUDYID
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=STUDYUID
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY DATE")=STUDYDATE
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY TIME")=STUDYTIME
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"REFERRING PHYSICIAN")=REFDOC
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NSTUDYRS")=NSTUDYRS
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NSTUDYRI")=NSTUDYRI
  1.  I LEVEL="STUDY" S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="SERIES" Q
  1.  ; 
  1.  ; save series q/r keys
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"MODALITY")=MODALITY ; (0008,0060) Modality
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES NUMBER")=SERIESNO
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=SERIESUID
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"NSERIESRI")=NSERIESRI
  1.  I LEVEL="SERIES" S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE" Q
  1.  ; 
  1.  ; save image q/r keys
  1.  F  S VAR=$O(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",JPATIENT,JSTUDY,JSERIES,JIMAGE,VAR)) Q:VAR=""  N @VAR S @VAR=^(VAR)
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID(0001)")=SOPUID
  1.  S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE"
  1.  Q 
  1.  ;
  1. NUMBERS ; output patient, study, and series related counts
  1.  N NPATIENTRST,NPATIENTRSE,NPATIENTRI,NSTUDYRS,NSTUDYRI,NSERIESRI
  1.  I $G(JPATIENT) D
  1.  . I LEVEL="PATIENT" D
  1.  . . S NPATIENTRST=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRST"))
  1.  . . S NPATIENTRSE=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRSE"))
  1.  . . S NPATIENTRI=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"PATIENT",JPATIENT,"NPATIENTRI"))
  1.  . . W !,"Number of Patient Related Studies: ",NPATIENTRST
  1.  . . W ",  Series: ",NPATIENTRSE
  1.  . . W ",  Images: ",NPATIENTRI
  1.  . . Q
  1.  . I $G(JSTUDY) D
  1.  . . I LEVEL="STUDY" D
  1.  . . . S NSTUDYRS=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,"NSTUDYRS"))
  1.  . . . S NSTUDYRI=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"STUDY",JPATIENT,JSTUDY,"NSTUDYRI"))
  1.  . . . W !,"Number of Study Related Series: ",NSTUDYRS
  1.  . . . W ",  Images: ",NSTUDYRI
  1.  . . . Q
  1.  . . I $G(JSERIES) D
  1.  . . . I LEVEL="SERIES" D
  1.  . . . . S NSERIESRI=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"SERIES",JPATIENT,JSTUDY,JSERIES,"NSERIESRI"))
  1.  . . . . W !,"Number of Series Related Images: ",NSERIESRI
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. UID ;
  1.  I $G(STUDYUID)'="" D
  1.  . W !,"Study UID: ",STUDYUID
  1.  . Q
  1.  I $G(SERIESUID)'="" D
  1.  . W !,"Series UID:",SERIESUID
  1.  . Q
  1.  I $G(SOPUID)'="" D
  1.  . W !,"SOP UID: ",SOPUID
  1.  . I SOPCLASS'="" D
  1.  . . W !,"SOP Class: "
  1.  . . I $$VISTA^MAGDSTQ D  ; code for VistA
  1.  . . . N IPTR
  1.  . . . S IPTR=$O(^MAGDICOM(2006.539,"B",SOPCLASS,""))
  1.  . . . I IPTR="" W "*** Unknown UID: <<",SOPCLASS,">> ***"
  1.  . . . E  W $P(^MAGDICOM(2006.539,IPTR,0),"^",2)
  1.  . . . Q
  1.  . . E  I '$$VISTA^MAGDSTQ D  ; code for DICOM Gateway
  1.  . . . W $$GETNAME^MAGDUID2(SOPCLASS)
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  W !
  1.  Q
  1.  ;
  1. NAME(DCMNAME) ; convert a DICOM person name to a readable format
  1.  N FIRST,LAST,MIDDLE,NAME,PREFIX,SUFFIX
  1.  I DCMNAME="" Q ""  ; no name
  1.  I DCMNAME="<unknown>" Q DCMNAME
  1.  S LAST=$P(DCMNAME,"^",1),FIRST=$P(DCMNAME,"^",2)
  1.  S MIDDLE=$P(DCMNAME,"^",3)
  1.  S PREFIX=$P(DCMNAME,"^",4),SUFFIX=$P(DCMNAME,"^",5)
  1.  S NAME=LAST I (FIRST'="")!(MIDDLE'="") S NAME=NAME_","
  1.  I FIRST'="" S NAME=NAME_FIRST
  1.  E  S NAME=NAME_" <no first name>"
  1.  I MIDDLE'="" S NAME=NAME_" "_MIDDLE
  1.  I PREFIX'="" S NAME="("_PREFIX_") "_NAME
  1.  I SUFFIX'="" S NAME=NAME_" ("_SUFFIX_")"
  1.  Q NAME
  1.  ;
  1. DATE(DCMDATE,FORMAT) ; convert a DICOM date to a readable date
  1.  N DATE,DAY,MONTH,YEAR
  1.  I DCMDATE="<unknown>" Q "???"
  1.  S FORMAT=$G(FORMAT,"LONG")
  1.  S YEAR=$E(DCMDATE,1,4),MONTH=+$E(DCMDATE,5,6),DAY=+$E(DCMDATE,7,8)
  1.  I FORMAT="SHORT" D
  1.  . S:MONTH<10 MONTH="0"_MONTH S:DAY<10 DAY="0"_DAY
  1.  . S DATE=MONTH_"/"_DAY_"/"_YEAR
  1.  . Q
  1.  E  D
  1.  . S MONTH=$P("January,February,March,April,May,June,July,August,September,October,November,December",",",MONTH)
  1.  . S DATE=DAY_" "_MONTH_" "_YEAR
  1.  . Q
  1.  Q DATE
  1.  ;
  1. TIME(DCMTIME) ; convert a DICOM time to a readable time
  1.  N HOUR,MINUTE,SECOND,TIME
  1.  S HOUR=$E(DCMTIME,1,2),MINUTE=$E(DCMTIME,3,4),SECOND=$E(DCMTIME,5,6)
  1.  S TIME=HOUR_":"_MINUTE_":"_SECOND
  1.  Q TIME