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

MAGDSTQ.m

Go to the documentation of this file.
  1. MAGDSTQ ;WOIFO/PMK - Study Tracker - Query/Retrieve user ; Oct 27, 2020@15:45:29
  1. ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Feb 27, 2015
  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. ;
  1. ENTRYQ ; query only
  1. N OPTION S OPTION="Q"
  1. ; setup error trap on VistA. DICOM Gateway already has it.
  1. I $$VISTA N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
  1. D ENTRY
  1. Q
  1. ;
  1. ENTRYQR ; query and retrieve
  1. N OPTION S OPTION="QR"
  1. ; setup error trap on VistA. DICOM Gateway already has it.
  1. I $$VISTA N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
  1. D ENTRY
  1. Q
  1. ;
  1. ENTRY ; entry point to generate a Query/Retrieve C-FIND-RQ
  1. N ATTRIB,CHANNEL,DEBUG,DEFAULT,DONE,DONEFLAG,FBSWITCH,FILEMODE,HELP,HOSTNAME,I,INCOMING
  1. N LOGDIR,KEYCOUNT,KEYLIST,MAGXTMP,MESSAGE,MSGDATE,MSGTIME,MSGHANDL,MULTIMSG
  1. N ODEVNAME,ODEVTYPE,OUTGOING,PATLKUPMODE,PDUIN,PDUOUT,PORT,PRIORITY,QUEUEIN,QUEUEOUT
  1. N QUERYLEVEL,QRROOT,QRSCP,QRSTACK,RETRIEVELEVEL,RETURN,ROLE,RUNNING,SAVENODE,SEQNUMB,SEQUENCE
  1. N SHOWRRSL,SRRDEFAULT,STATNUMB,UID,UIDTYPE,Y,Y1,Y2
  1. ;
  1. K ^TMP("MAG",$J,"Q/R QUERY") ; remove all previous query results
  1. S QRSTACK=1 ; initialize push down stack pointer
  1. ;
  1. W !!,$S(OPTION="Q":"Q/R Query",1:"Q/R Query and Retrieve"),!
  1. ;
  1. ; get HOSTNAME
  1. I $$VISTA D
  1. . S HOSTNAME=$$HOSTNAME^MAGDFCNV
  1. . Q
  1. E D
  1. . S HOSTNAME=$$HOSTNAME^MAGOSMSC
  1. . Q
  1. ;
  1. S DEFAULT=$G(^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION"))
  1. I $L(DEFAULT) D
  1. . W !,"The PACS Query/Retrieve Provider is """,DEFAULT,"""."
  1. . I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QRSCP="" Q
  1. . I X="YES" D
  1. . . W !!,"Please select the PACS Query/Retrieve Provider"
  1. . . S QRSCP=$$QRSCP(DEFAULT)
  1. . . Q
  1. . E S QRSCP=DEFAULT
  1. . Q
  1. E D ; no default
  1. . W !,"Please select the PACS Query/Retrieve Provider"
  1. . S QRSCP=$$QRSCP()
  1. . Q
  1. I QRSCP="" Q
  1. ;
  1. S MAGXTMP=$$INITXTMP^MAGDSTQ0
  1. ;
  1. S ^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION")=QRSCP
  1. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=QRSCP
  1. ;
  1. ; get Q/R root and set default level
  1. I '$D(^TMP("MAG",$J,"Q/R PARAM","ROOT")) S ^("ROOT")="PATIENT"
  1. ; ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")is needed as a Q/R key
  1. S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")=^TMP("MAG",$J,"Q/R PARAM","ROOT")
  1. S ATTRIB="ROOT" D QRROOT^MAGDSTQ1
  1. S (QRROOT,^("QUERY LEVEL"))=^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")
  1. S ^TMP("MAG",$J,"Q/R PARAM","ROOT")=QRROOT
  1. ;
  1. ;
  1. S DONE=0
  1. F D Q:DONE
  1. . S KEYCOUNT=$$KEYLIST^MAGDSTQ0(.KEYLIST) ; initialize KEYLIST
  1. . S RETURN=$$GETKEYS
  1. . I RETURN<0 S DONE=1 Q
  1. . ;
  1. . I RETURN=1 D ; query
  1. . . D PUSH^MAGDSTQ0(.QRSTACK) ; add the q/r key entry to the stack
  1. . . I $$VISTA D ; code for VistA
  1. . . . D ENTRY^MAGDSTV1("Q")
  1. . . . Q
  1. . . E D ; code for DICOM Gateway
  1. . . . W !,"Performing Query..."
  1. . . . D ^MAGDSTQ2 ; do the query
  1. . . . D ENTRY^MAGDSTQ3("GATEWAY") ; process the results
  1. . . . Q
  1. . . Q
  1. . ;
  1. . I RETURN=2 D ; retrieve
  1. . . K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"Q/R RETRIEVE STATUS")
  1. . . S SRRDEFAULT=$G(SRRDEFAULT,"n")
  1. . . W !!,"Show Retrieve Results? ",SRRDEFAULT,"// "
  1. . . R X:DTIME E S X="^"
  1. . . I X="" S X=SRRDEFAULT W X
  1. . . I "^"[X Q
  1. . . S SHOWRRSL=$S("Yy"[X:1,1:0)
  1. . . S SRRDEFAULT=$S(SHOWRRSL:"y",1:"n")
  1. . . I $$VISTA D ; code for VistA
  1. . . . D ENTRY^MAGDSTV1("R",.SHOWRRSL)
  1. . . . Q
  1. . . E D ; code for DICOM Gateway
  1. . . . S RUNNING=$$ENTRY^MAGDSTR1(SHOWRRSL,"GATEWAY",MAGXTMP,$$HOSTNAME^MAGOSMSC,$J,QRSTACK)
  1. . . . I 'RUNNING D
  1. . . . . W !!,"*** Please start ""2-14-2 Execute C-MOVE Request to Retrieve Images"" ***"
  1. . . . . D CONTINUE
  1. . . . . S SHOWRRSL=0
  1. . . . . Q
  1. . . . Q
  1. . . I SHOWRRSL D
  1. . . . D RETRIEVE^MAGDSTQ8
  1. . . . Q
  1. . . Q
  1. . ;
  1. . I RETURN=3 D ; back
  1. . . D DISPLAY^MAGDSTQ5
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. QRSCP(DEFAULT) ; get the PACS Q/R Provider
  1. S DEFAULT=$G(DEFAULT)
  1. I $$VISTA D
  1. . S QRSCP=$$PICKSCP^MAGDSTQ9(DEFAULT,"Q/R")
  1. . Q
  1. E D ; ^MAGDACU routine on DICOM Gateway only
  1. . S QRSCP=$$PICKSCP^MAGDACU(DEFAULT,"Q/R")
  1. . Q
  1. Q QRSCP
  1. ;
  1. GETKEYS() ; get the keys for Q/R query
  1. N DONE,I,N,T
  1. S DONE=0 F D Q:DONE
  1. . D DISPLAY
  1. . W !!!,"Enter 1-",KEYCOUNT," " I OPTION="QR" D
  1. . . W "for key, ""B"" for back, ""Q"" to query, ""R"" to retrieve, ""^"" to exit: "
  1. . . Q
  1. . E D
  1. . . W "to change a key, ""B"" for back, ""Q"" to query, ""^"" to exit: "
  1. . . Q
  1. . R N:DTIME E S N="^"
  1. . I N?1N.N,N>0,N<(KEYCOUNT+1) D
  1. . . S ATTRIB=$P(KEYLIST(N),"|",1)
  1. . . S DEFAULT=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,ATTRIB))
  1. . . D @$P(KEYLIST(N),"|",2)
  1. . . Q
  1. . I N="^" D Q
  1. . . K ^TMP("MAG",$J,"Q/R QUERY")
  1. . . K ^XTMP(MAGXTMP,HOSTNAME,$J)
  1. . . S DONE=-1
  1. . . Q
  1. . I (N="B")!(N="b") D
  1. . . K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"MESSAGE") ; remove any previous query error message
  1. . . S DONE=3
  1. . . Q
  1. . ;
  1. . I QRROOT="" D Q
  1. . . W !!,"Query/Retrieve Root must be defined"
  1. . . Q
  1. . ;
  1. . I (N="Q")!(N="q") D
  1. . . S QUERYLEVEL=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL"))
  1. . . I $$CHECKQRY^MAGDSTQ S DONE=1
  1. . . Q
  1. . I (N="R")!(N="r") D
  1. . . I OPTION'="QR" W !,"Retrieve requires query/retrieve menu option" R X:DTIME Q
  1. . . S RETRIEVELEVEL=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL"))
  1. . . I $$CHECKRTV^MAGDSTQ S DONE=2
  1. . . Q
  1. . Q
  1. Q DONE
  1. ;
  1. DISPLAY ;
  1. N ATTRIB,I,TAB,X
  1. S X="SELECT QUERY"
  1. I OPTION="QR" S X=X_"/RETRIEVE"
  1. S X=X_" KEYS"
  1. ; S X=X_" STACK: "_QRSTACK ; SHOW QRSTACK
  1. S TAB=27-($L(X)/2)
  1. W @IOF,?TAB,X,?66," Root: ",QRROOT
  1. W !?TAB F I=1:1:$L(X) W "-"
  1. W ?66,"Level: ",QUERYLEVEL
  1. F I=1:1:KEYCOUNT D
  1. . S ATTRIB=$P(KEYLIST(I),"|",1)
  1. . W !,$J($P(ATTRIB,"(",1),25) W:I<10 " " W " (",I,") : "
  1. . W $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,ATTRIB))
  1. . Q
  1. Q
  1. ;
  1. ; Check query keys for minimum required values
  1. ;
  1. CHECKQRY() ; check query keys to prevent broad queries
  1. N OK S OK=0
  1. I QUERYLEVEL="" D
  1. . W !!,"QUERY LEVEL must be defined"
  1. . Q
  1. E I QUERYLEVEL="PATIENT" D
  1. . I $$CHECKPTQ S OK=1
  1. . E W !!,"Patient Root Patient Level queries requires either the patient name, ID, or DOB."
  1. . Q
  1. E I QUERYLEVEL="STUDY" D
  1. . I $$CHECKSTQ S OK=1
  1. . E D
  1. . . I QRROOT="PATIENT" D
  1. . . . W !!,"Study queries require the Patient ID and accession number, study date, or UID."
  1. . . . Q
  1. . . E D ; QRROOT="STUDY"
  1. . . . W !!,"Study queries require patient info, accession number, study date or Study UID."
  1. . . . Q
  1. . . Q
  1. . Q
  1. E I QUERYLEVEL="SERIES" D
  1. . I $$CHECKSEQ S OK=1
  1. . E D
  1. . . I QRROOT="PATIENT" D
  1. . . . W !!,"Series queries require the Patient ID and the Study Instance UID."
  1. . . . Q
  1. . . E D ; QRROOT="STUDY"
  1. . . . W !!,"Series queries require the Study Instance UID."
  1. . . . Q
  1. . . Q
  1. . Q
  1. E I QUERYLEVEL="IMAGE" D
  1. . I $$CHECKIMQ S OK=1
  1. . E D
  1. . . I QRROOT="PATIENT" D
  1. . . . W !!,"Image queries require the Patient ID and the Study and Series Instance UIDs."
  1. . . . Q
  1. . . E D ; QRROOT="STUDY"
  1. . . . W !!,"Image queries require the Study and Series Instance UIDs."
  1. . . . Q
  1. . . Q
  1. . Q
  1. I 'OK D CONTINUE^MAGDSTQ
  1. Q OK
  1. ;
  1. CHECKPTQ() ; check attributes for a patient level query
  1. N OK S OK=0
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT NAME"))'="" S OK=1
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE"))'="" S OK=1
  1. Q OK
  1. ;
  1. CHECKSTQ() ; check attributes for a study level query
  1. N OK S OK=0
  1. I $$CHECKPTQ() S OK=1
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER"))'="" S OK=1
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY DATE"))'="" S OK=1
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=1
  1. Q OK
  1. ;
  1. CHECKSEQ() ; check attributes for a series level query
  1. N OK S OK=0
  1. I QRROOT="STUDY" S OK=1 ; study root doesn't need patient id
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=OK+1
  1. Q OK=2
  1. ;
  1. CHECKIMQ() ; check attributes for an image level query
  1. N OK S OK=0
  1. I QRROOT="STUDY" S OK=1 ; study root doesn't need patient id
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=OK+1
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)"))'="" S OK=OK+1
  1. Q OK=3
  1. ;
  1. ;
  1. ; Check retrieve keys for minimum required values
  1. ;
  1. CHECKRTV() ; check retrieve keys to prevent broad retrieves
  1. N OK,X S OK=0
  1. I RETRIEVELEVEL="" D
  1. . W !!,"RETRIEVE LEVEL must be defined"
  1. . Q
  1. E I RETRIEVELEVEL="PATIENT" D
  1. . I $$CHECKPTR D
  1. . . W !!,"This will retrieve all of the images for all the studies for this patient."
  1. . . I $$YESNO("Are you sure that you want to do this?","NO!",.X)<0 Q
  1. . . I X="YES" S OK=1
  1. . . Q
  1. . E W !!,"Patient Root Patient Level retrieves require the PATIENT ID."
  1. . Q
  1. E I RETRIEVELEVEL="STUDY" D
  1. . I $$CHECKPTR,$$CHECKSTR S OK=1
  1. . E D
  1. . . I QRROOT="PATIENT" D
  1. . . . W !!,"Study Level retrieves require the Patient ID and STUDY INSTANCE UID."
  1. . . . Q
  1. . . E D ; QRROOT="STUDY"
  1. . . . W !!,"Study Level retrieves require the STUDY INSTANCE UID."
  1. . . . Q
  1. . . Q
  1. . Q
  1. E I RETRIEVELEVEL="SERIES" D
  1. . I $$CHECKPTR,$$CHECKSTR,$$CHECKSER S OK=1
  1. . E D
  1. . . I QRROOT="PATIENT" D
  1. . . . W !!,"Series retrieves require the Patient ID and STUDY and Series INSTANCE UIDs."
  1. . . . Q
  1. . . E D ; QRROOT="STUDY"
  1. . . . W !!,"Series retrieves requires the STUDY and SERIES INSTANCE UIDs."
  1. . . . Q
  1. . . Q
  1. . Q
  1. E I RETRIEVELEVEL="IMAGE" D
  1. . I $$CHECKPTR,$$CHECKSTR,$$CHECKSER,$$CHECKIMR S OK=1
  1. . E D
  1. . . I QRROOT="PATIENT" D
  1. . . . W !!,"Image retrieves require the Patient ID and STUDY, Series, and SOP INSTANCE UIDs."
  1. . . . Q
  1. . . E D ; QRROOT="STUDY"
  1. . . . W !!,"Image retrieve requires the STUDY, SERIES, and SOP INSTANCE UIDs."
  1. . . . Q
  1. . . Q
  1. . Q
  1. I 'OK D CONTINUE^MAGDSTQ
  1. Q OK
  1. ;
  1. CHECKPTR() ; check attributes for a patient level retrieve
  1. N OK S OK=0
  1. I QRROOT="STUDY" S OK=1 ; study root doesn't need patient id
  1. E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
  1. Q OK
  1. ;
  1. CHECKSTR() ; check attributes for a study level retrieve
  1. N OK S OK=0
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=1
  1. Q OK
  1. ;
  1. CHECKSER() ; check attributes for a series level retrieve
  1. N OK S OK=0
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)"))'="" S OK=1
  1. Q OK
  1. ;
  1. CHECKIMR() ; check attributes for an image level retrieve
  1. N OK S OK=0
  1. I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID(0001)"))'="" S OK=1
  1. Q OK
  1. ;
  1. ;
  1. ;
  1. YESNO(PROMPT,DEFAULT,CHOICE,HELP) ; generic YES/NO question driver
  1. N I,OK,X
  1. S OK=0 F D Q:OK
  1. . W !!,PROMPT," " I $L($G(DEFAULT)) W DEFAULT,"// "
  1. . R X:DTIME E S X="^"
  1. . I X="",$L($G(DEFAULT)) S X=DEFAULT W X
  1. . I X="",'$L($G(DEFAULT)) S X="*" ; fails Y/N tests
  1. . I X["^" S CHOICE="^",OK=-1 Q
  1. . I "Yy"[$E(X) S CHOICE="YES",OK=1 Q
  1. . I "Nn"[$E(X) S CHOICE="NO",OK=1 Q
  1. . I X["?",$D(HELP) D
  1. . . W !
  1. . . F I=1:1 Q:'$D(HELP(I)) W !,HELP(I)
  1. . . Q
  1. . E W " ??? - Please enter ""Yes"" or ""No"""
  1. . Q
  1. Q OK
  1. ;
  1. CONTINUE(ERASE) ; used by several routines on VistA and DICOM Gateway
  1. N X
  1. I $E(IOST,1,2)'="C-" Q ; only ask for terminal I/O jobs
  1. S ERASE=$G(ERASE,0) I 'ERASE W !!
  1. W "Press <Enter> to continue..."
  1. R X:$G(DTIME,300)
  1. I ERASE D
  1. . F Q:$X=0 W @IOBS," ",@IOBS ; erase the line
  1. . Q
  1. Q
  1. ;
  1. VISTA() ;
  1. ; return 1 for running in VistA namespace, 0 otherwise
  1. Q $D(^MAG(2005,0)) ; this should exist only on VistA