MAGDSTQ ;WOIFO/PMK - Study Tracker - Query/Retrieve user ; Oct 27, 2020@15:45:29
;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Feb 27, 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. |
;; +---------------------------------------------------------------+
;;
;
; Notice: This routine is on both VistA and the DICOM Gateway
;
;
;
ENTRYQ ; query only
N OPTION S OPTION="Q"
; setup error trap on VistA. DICOM Gateway already has it.
I $$VISTA N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
D ENTRY
Q
;
ENTRYQR ; query and retrieve
N OPTION S OPTION="QR"
; setup error trap on VistA. DICOM Gateway already has it.
I $$VISTA N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
D ENTRY
Q
;
ENTRY ; entry point to generate a Query/Retrieve C-FIND-RQ
N ATTRIB,CHANNEL,DEBUG,DEFAULT,DONE,DONEFLAG,FBSWITCH,FILEMODE,HELP,HOSTNAME,I,INCOMING
N LOGDIR,KEYCOUNT,KEYLIST,MAGXTMP,MESSAGE,MSGDATE,MSGTIME,MSGHANDL,MULTIMSG
N ODEVNAME,ODEVTYPE,OUTGOING,PATLKUPMODE,PDUIN,PDUOUT,PORT,PRIORITY,QUEUEIN,QUEUEOUT
N QUERYLEVEL,QRROOT,QRSCP,QRSTACK,RETRIEVELEVEL,RETURN,ROLE,RUNNING,SAVENODE,SEQNUMB,SEQUENCE
N SHOWRRSL,SRRDEFAULT,STATNUMB,UID,UIDTYPE,Y,Y1,Y2
;
K ^TMP("MAG",$J,"Q/R QUERY") ; remove all previous query results
S QRSTACK=1 ; initialize push down stack pointer
;
W !!,$S(OPTION="Q":"Q/R Query",1:"Q/R Query and Retrieve"),!
;
; get HOSTNAME
I $$VISTA D
. S HOSTNAME=$$HOSTNAME^MAGDFCNV
. Q
E D
. S HOSTNAME=$$HOSTNAME^MAGOSMSC
. Q
;
S DEFAULT=$G(^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION"))
I $L(DEFAULT) D
. W !,"The PACS Query/Retrieve Provider is """,DEFAULT,"""."
. I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QRSCP="" Q
. I X="YES" D
. . W !!,"Please select the PACS Query/Retrieve Provider"
. . S QRSCP=$$QRSCP(DEFAULT)
. . Q
. E S QRSCP=DEFAULT
. Q
E D ; no default
. W !,"Please select the PACS Query/Retrieve Provider"
. S QRSCP=$$QRSCP()
. Q
I QRSCP="" Q
;
S MAGXTMP=$$INITXTMP^MAGDSTQ0
;
S ^TMP("MAG",$J,"Q/R PARAM","QUERY USER APPLICATION")=QRSCP
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=QRSCP
;
; get Q/R root and set default level
I '$D(^TMP("MAG",$J,"Q/R PARAM","ROOT")) S ^("ROOT")="PATIENT"
; ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")is needed as a Q/R key
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")=^TMP("MAG",$J,"Q/R PARAM","ROOT")
S ATTRIB="ROOT" D QRROOT^MAGDSTQ1
S (QRROOT,^("QUERY LEVEL"))=^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")
S ^TMP("MAG",$J,"Q/R PARAM","ROOT")=QRROOT
;
;
S DONE=0
F D Q:DONE
. S KEYCOUNT=$$KEYLIST^MAGDSTQ0(.KEYLIST) ; initialize KEYLIST
. S RETURN=$$GETKEYS
. I RETURN<0 S DONE=1 Q
. ;
. I RETURN=1 D ; query
. . D PUSH^MAGDSTQ0(.QRSTACK) ; add the q/r key entry to the stack
. . I $$VISTA D ; code for VistA
. . . D ENTRY^MAGDSTV1("Q")
. . . Q
. . E D ; code for DICOM Gateway
. . . W !,"Performing Query..."
. . . D ^MAGDSTQ2 ; do the query
. . . D ENTRY^MAGDSTQ3("GATEWAY") ; process the results
. . . Q
. . Q
. ;
. I RETURN=2 D ; retrieve
. . K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"Q/R RETRIEVE STATUS")
. . S SRRDEFAULT=$G(SRRDEFAULT,"n")
. . W !!,"Show Retrieve Results? ",SRRDEFAULT,"// "
. . R X:DTIME E S X="^"
. . I X="" S X=SRRDEFAULT W X
. . I "^"[X Q
. . S SHOWRRSL=$S("Yy"[X:1,1:0)
. . S SRRDEFAULT=$S(SHOWRRSL:"y",1:"n")
. . I $$VISTA D ; code for VistA
. . . D ENTRY^MAGDSTV1("R",.SHOWRRSL)
. . . Q
. . E D ; code for DICOM Gateway
. . . S RUNNING=$$ENTRY^MAGDSTR1(SHOWRRSL,"GATEWAY",MAGXTMP,$$HOSTNAME^MAGOSMSC,$J,QRSTACK)
. . . I 'RUNNING D
. . . . W !!,"*** Please start ""2-14-2 Execute C-MOVE Request to Retrieve Images"" ***"
. . . . D CONTINUE
. . . . S SHOWRRSL=0
. . . . Q
. . . Q
. . I SHOWRRSL D
. . . D RETRIEVE^MAGDSTQ8
. . . Q
. . Q
. ;
. I RETURN=3 D ; back
. . D DISPLAY^MAGDSTQ5
. . Q
. Q
Q
;
QRSCP(DEFAULT) ; get the PACS Q/R Provider
S DEFAULT=$G(DEFAULT)
I $$VISTA D
. S QRSCP=$$PICKSCP^MAGDSTQ9(DEFAULT,"Q/R")
. Q
E D ; ^MAGDACU routine on DICOM Gateway only
. S QRSCP=$$PICKSCP^MAGDACU(DEFAULT,"Q/R")
. Q
Q QRSCP
;
GETKEYS() ; get the keys for Q/R query
N DONE,I,N,T
S DONE=0 F D Q:DONE
. D DISPLAY
. W !!!,"Enter 1-",KEYCOUNT," " I OPTION="QR" D
. . W "for key, ""B"" for back, ""Q"" to query, ""R"" to retrieve, ""^"" to exit: "
. . Q
. E D
. . W "to change a key, ""B"" for back, ""Q"" to query, ""^"" to exit: "
. . Q
. R N:DTIME E S N="^"
. I N?1N.N,N>0,N<(KEYCOUNT+1) D
. . S ATTRIB=$P(KEYLIST(N),"|",1)
. . S DEFAULT=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,ATTRIB))
. . D @$P(KEYLIST(N),"|",2)
. . Q
. I N="^" D Q
. . K ^TMP("MAG",$J,"Q/R QUERY")
. . K ^XTMP(MAGXTMP,HOSTNAME,$J)
. . S DONE=-1
. . Q
. I (N="B")!(N="b") D
. . K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"MESSAGE") ; remove any previous query error message
. . S DONE=3
. . Q
. ;
. I QRROOT="" D Q
. . W !!,"Query/Retrieve Root must be defined"
. . Q
. ;
. I (N="Q")!(N="q") D
. . S QUERYLEVEL=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL"))
. . I $$CHECKQRY^MAGDSTQ S DONE=1
. . Q
. I (N="R")!(N="r") D
. . I OPTION'="QR" W !,"Retrieve requires query/retrieve menu option" R X:DTIME Q
. . S RETRIEVELEVEL=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL"))
. . I $$CHECKRTV^MAGDSTQ S DONE=2
. . Q
. Q
Q DONE
;
DISPLAY ;
N ATTRIB,I,TAB,X
S X="SELECT QUERY"
I OPTION="QR" S X=X_"/RETRIEVE"
S X=X_" KEYS"
; S X=X_" STACK: "_QRSTACK ; SHOW QRSTACK
S TAB=27-($L(X)/2)
W @IOF,?TAB,X,?66," Root: ",QRROOT
W !?TAB F I=1:1:$L(X) W "-"
W ?66,"Level: ",QUERYLEVEL
F I=1:1:KEYCOUNT D
. S ATTRIB=$P(KEYLIST(I),"|",1)
. W !,$J($P(ATTRIB,"(",1),25) W:I<10 " " W " (",I,") : "
. W $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,ATTRIB))
. Q
Q
;
; Check query keys for minimum required values
;
CHECKQRY() ; check query keys to prevent broad queries
N OK S OK=0
I QUERYLEVEL="" D
. W !!,"QUERY LEVEL must be defined"
. Q
E I QUERYLEVEL="PATIENT" D
. I $$CHECKPTQ S OK=1
. E W !!,"Patient Root Patient Level queries requires either the patient name, ID, or DOB."
. Q
E I QUERYLEVEL="STUDY" D
. I $$CHECKSTQ S OK=1
. E D
. . I QRROOT="PATIENT" D
. . . W !!,"Study queries require the Patient ID and accession number, study date, or UID."
. . . Q
. . E D ; QRROOT="STUDY"
. . . W !!,"Study queries require patient info, accession number, study date or Study UID."
. . . Q
. . Q
. Q
E I QUERYLEVEL="SERIES" D
. I $$CHECKSEQ S OK=1
. E D
. . I QRROOT="PATIENT" D
. . . W !!,"Series queries require the Patient ID and the Study Instance UID."
. . . Q
. . E D ; QRROOT="STUDY"
. . . W !!,"Series queries require the Study Instance UID."
. . . Q
. . Q
. Q
E I QUERYLEVEL="IMAGE" D
. I $$CHECKIMQ S OK=1
. E D
. . I QRROOT="PATIENT" D
. . . W !!,"Image queries require the Patient ID and the Study and Series Instance UIDs."
. . . Q
. . E D ; QRROOT="STUDY"
. . . W !!,"Image queries require the Study and Series Instance UIDs."
. . . Q
. . Q
. Q
I 'OK D CONTINUE^MAGDSTQ
Q OK
;
CHECKPTQ() ; check attributes for a patient level query
N OK S OK=0
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT NAME"))'="" S OK=1
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE"))'="" S OK=1
Q OK
;
CHECKSTQ() ; check attributes for a study level query
N OK S OK=0
I $$CHECKPTQ() S OK=1
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER"))'="" S OK=1
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY DATE"))'="" S OK=1
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=1
Q OK
;
CHECKSEQ() ; check attributes for a series level query
N OK S OK=0
I QRROOT="STUDY" S OK=1 ; study root doesn't need patient id
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=OK+1
Q OK=2
;
CHECKIMQ() ; check attributes for an image level query
N OK S OK=0
I QRROOT="STUDY" S OK=1 ; study root doesn't need patient id
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=OK+1
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)"))'="" S OK=OK+1
Q OK=3
;
;
; Check retrieve keys for minimum required values
;
CHECKRTV() ; check retrieve keys to prevent broad retrieves
N OK,X S OK=0
I RETRIEVELEVEL="" D
. W !!,"RETRIEVE LEVEL must be defined"
. Q
E I RETRIEVELEVEL="PATIENT" D
. I $$CHECKPTR D
. . W !!,"This will retrieve all of the images for all the studies for this patient."
. . I $$YESNO("Are you sure that you want to do this?","NO!",.X)<0 Q
. . I X="YES" S OK=1
. . Q
. E W !!,"Patient Root Patient Level retrieves require the PATIENT ID."
. Q
E I RETRIEVELEVEL="STUDY" D
. I $$CHECKPTR,$$CHECKSTR S OK=1
. E D
. . I QRROOT="PATIENT" D
. . . W !!,"Study Level retrieves require the Patient ID and STUDY INSTANCE UID."
. . . Q
. . E D ; QRROOT="STUDY"
. . . W !!,"Study Level retrieves require the STUDY INSTANCE UID."
. . . Q
. . Q
. Q
E I RETRIEVELEVEL="SERIES" D
. I $$CHECKPTR,$$CHECKSTR,$$CHECKSER S OK=1
. E D
. . I QRROOT="PATIENT" D
. . . W !!,"Series retrieves require the Patient ID and STUDY and Series INSTANCE UIDs."
. . . Q
. . E D ; QRROOT="STUDY"
. . . W !!,"Series retrieves requires the STUDY and SERIES INSTANCE UIDs."
. . . Q
. . Q
. Q
E I RETRIEVELEVEL="IMAGE" D
. I $$CHECKPTR,$$CHECKSTR,$$CHECKSER,$$CHECKIMR S OK=1
. E D
. . I QRROOT="PATIENT" D
. . . W !!,"Image retrieves require the Patient ID and STUDY, Series, and SOP INSTANCE UIDs."
. . . Q
. . E D ; QRROOT="STUDY"
. . . W !!,"Image retrieve requires the STUDY, SERIES, and SOP INSTANCE UIDs."
. . . Q
. . Q
. Q
I 'OK D CONTINUE^MAGDSTQ
Q OK
;
CHECKPTR() ; check attributes for a patient level retrieve
N OK S OK=0
I QRROOT="STUDY" S OK=1 ; study root doesn't need patient id
E I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID"))'="" S OK=1
Q OK
;
CHECKSTR() ; check attributes for a study level retrieve
N OK S OK=0
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'="" S OK=1
Q OK
;
CHECKSER() ; check attributes for a series level retrieve
N OK S OK=0
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)"))'="" S OK=1
Q OK
;
CHECKIMR() ; check attributes for an image level retrieve
N OK S OK=0
I $G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID(0001)"))'="" S OK=1
Q OK
;
;
;
YESNO(PROMPT,DEFAULT,CHOICE,HELP) ; generic YES/NO question driver
N I,OK,X
S OK=0 F D Q:OK
. W !!,PROMPT," " I $L($G(DEFAULT)) W DEFAULT,"// "
. R X:DTIME E S X="^"
. I X="",$L($G(DEFAULT)) S X=DEFAULT W X
. I X="",'$L($G(DEFAULT)) S X="*" ; fails Y/N tests
. I X["^" S CHOICE="^",OK=-1 Q
. I "Yy"[$E(X) S CHOICE="YES",OK=1 Q
. I "Nn"[$E(X) S CHOICE="NO",OK=1 Q
. I X["?",$D(HELP) D
. . W !
. . F I=1:1 Q:'$D(HELP(I)) W !,HELP(I)
. . Q
. E W " ??? - Please enter ""Yes"" or ""No"""
. Q
Q OK
;
CONTINUE(ERASE) ; used by several routines on VistA and DICOM Gateway
N X
I $E(IOST,1,2)'="C-" Q ; only ask for terminal I/O jobs
S ERASE=$G(ERASE,0) I 'ERASE W !!
W "Press <Enter> to continue..."
R X:$G(DTIME,300)
I ERASE D
. F Q:$X=0 W @IOBS," ",@IOBS ; erase the line
. Q
Q
;
VISTA() ;
; return 1 for running in VistA namespace, 0 otherwise
Q $D(^MAG(2005,0)) ; this should exist only on VistA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQ 12700 printed Oct 16, 2024@18:02:40 Page 2
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
+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 ;
ENTRYQ ; query only
+1 NEW OPTION
SET OPTION="Q"
+2 ; setup error trap on VistA. DICOM Gateway already has it.
+3 IF $$VISTA
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+4 DO ENTRY
+5 QUIT
+6 ;
ENTRYQR ; query and retrieve
+1 NEW OPTION
SET OPTION="QR"
+2 ; setup error trap on VistA. DICOM Gateway already has it.
+3 IF $$VISTA
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERROR^MAGDSTA"
+4 DO ENTRY
+5 QUIT
+6 ;
ENTRY ; entry point to generate a Query/Retrieve C-FIND-RQ
+1 NEW ATTRIB,CHANNEL,DEBUG,DEFAULT,DONE,DONEFLAG,FBSWITCH,FILEMODE,HELP,HOSTNAME,I,INCOMING
+2 NEW LOGDIR,KEYCOUNT,KEYLIST,MAGXTMP,MESSAGE,MSGDATE,MSGTIME,MSGHANDL,MULTIMSG
+3 NEW ODEVNAME,ODEVTYPE,OUTGOING,PATLKUPMODE,PDUIN,PDUOUT,PORT,PRIORITY,QUEUEIN,QUEUEOUT
+4 NEW QUERYLEVEL,QRROOT,QRSCP,QRSTACK,RETRIEVELEVEL,RETURN,ROLE,RUNNING,SAVENODE,SEQNUMB,SEQUENCE
+5 NEW SHOWRRSL,SRRDEFAULT,STATNUMB,UID,UIDTYPE,Y,Y1,Y2
+6 ;
+7 ; remove all previous query results
KILL ^TMP("MAG",$JOB,"Q/R QUERY")
+8 ; initialize push down stack pointer
SET QRSTACK=1
+9 ;
+10 WRITE !!,$SELECT(OPTION="Q":"Q/R Query",1:"Q/R Query and Retrieve"),!
+11 ;
+12 ; get HOSTNAME
+13 IF $$VISTA
Begin DoDot:1
+14 SET HOSTNAME=$$HOSTNAME^MAGDFCNV
+15 QUIT
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET HOSTNAME=$$HOSTNAME^MAGOSMSC
+18 QUIT
End DoDot:1
+19 ;
+20 SET DEFAULT=$GET(^TMP("MAG",$JOB,"Q/R PARAM","QUERY USER APPLICATION"))
+21 IF $LENGTH(DEFAULT)
Begin DoDot:1
+22 WRITE !,"The PACS Query/Retrieve Provider is """,DEFAULT,"""."
+23 IF $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0
SET QRSCP=""
QUIT
+24 IF X="YES"
Begin DoDot:2
+25 WRITE !!,"Please select the PACS Query/Retrieve Provider"
+26 SET QRSCP=$$QRSCP(DEFAULT)
+27 QUIT
End DoDot:2
+28 IF '$TEST
SET QRSCP=DEFAULT
+29 QUIT
End DoDot:1
+30 ; no default
IF '$TEST
Begin DoDot:1
+31 WRITE !,"Please select the PACS Query/Retrieve Provider"
+32 SET QRSCP=$$QRSCP()
+33 QUIT
End DoDot:1
+34 IF QRSCP=""
QUIT
+35 ;
+36 SET MAGXTMP=$$INITXTMP^MAGDSTQ0
+37 ;
+38 SET ^TMP("MAG",$JOB,"Q/R PARAM","QUERY USER APPLICATION")=QRSCP
+39 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=QRSCP
+40 ;
+41 ; get Q/R root and set default level
+42 IF '$DATA(^TMP("MAG",$JOB,"Q/R PARAM","ROOT"))
SET ^("ROOT")="PATIENT"
+43 ; ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")is needed as a Q/R key
+44 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")=^TMP("MAG",$JOB,"Q/R PARAM","ROOT")
+45 SET ATTRIB="ROOT"
DO QRROOT^MAGDSTQ1
+46 SET (QRROOT,^("QUERY LEVEL"))=^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")
+47 SET ^TMP("MAG",$JOB,"Q/R PARAM","ROOT")=QRROOT
+48 ;
+49 ;
+50 SET DONE=0
+51 FOR
Begin DoDot:1
+52 ; initialize KEYLIST
SET KEYCOUNT=$$KEYLIST^MAGDSTQ0(.KEYLIST)
+53 SET RETURN=$$GETKEYS
+54 IF RETURN<0
SET DONE=1
QUIT
+55 ;
+56 ; query
IF RETURN=1
Begin DoDot:2
+57 ; add the q/r key entry to the stack
DO PUSH^MAGDSTQ0(.QRSTACK)
+58 ; code for VistA
IF $$VISTA
Begin DoDot:3
+59 DO ENTRY^MAGDSTV1("Q")
+60 QUIT
End DoDot:3
+61 ; code for DICOM Gateway
IF '$TEST
Begin DoDot:3
+62 WRITE !,"Performing Query..."
+63 ; do the query
DO ^MAGDSTQ2
+64 ; process the results
DO ENTRY^MAGDSTQ3("GATEWAY")
+65 QUIT
End DoDot:3
+66 QUIT
End DoDot:2
+67 ;
+68 ; retrieve
IF RETURN=2
Begin DoDot:2
+69 KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"Q/R RETRIEVE STATUS")
+70 SET SRRDEFAULT=$GET(SRRDEFAULT,"n")
+71 WRITE !!,"Show Retrieve Results? ",SRRDEFAULT,"// "
+72 READ X:DTIME
IF '$TEST
SET X="^"
+73 IF X=""
SET X=SRRDEFAULT
WRITE X
+74 IF "^"[X
QUIT
+75 SET SHOWRRSL=$SELECT("Yy"[X:1,1:0)
+76 SET SRRDEFAULT=$SELECT(SHOWRRSL:"y",1:"n")
+77 ; code for VistA
IF $$VISTA
Begin DoDot:3
+78 DO ENTRY^MAGDSTV1("R",.SHOWRRSL)
+79 QUIT
End DoDot:3
+80 ; code for DICOM Gateway
IF '$TEST
Begin DoDot:3
+81 SET RUNNING=$$ENTRY^MAGDSTR1(SHOWRRSL,"GATEWAY",MAGXTMP,$$HOSTNAME^MAGOSMSC,$JOB,QRSTACK)
+82 IF 'RUNNING
Begin DoDot:4
+83 WRITE !!,"*** Please start ""2-14-2 Execute C-MOVE Request to Retrieve Images"" ***"
+84 DO CONTINUE
+85 SET SHOWRRSL=0
+86 QUIT
End DoDot:4
+87 QUIT
End DoDot:3
+88 IF SHOWRRSL
Begin DoDot:3
+89 DO RETRIEVE^MAGDSTQ8
+90 QUIT
End DoDot:3
+91 QUIT
End DoDot:2
+92 ;
+93 ; back
IF RETURN=3
Begin DoDot:2
+94 DO DISPLAY^MAGDSTQ5
+95 QUIT
End DoDot:2
+96 QUIT
End DoDot:1
if DONE
QUIT
+97 QUIT
+98 ;
QRSCP(DEFAULT) ; get the PACS Q/R Provider
+1 SET DEFAULT=$GET(DEFAULT)
+2 IF $$VISTA
Begin DoDot:1
+3 SET QRSCP=$$PICKSCP^MAGDSTQ9(DEFAULT,"Q/R")
+4 QUIT
End DoDot:1
+5 ; ^MAGDACU routine on DICOM Gateway only
IF '$TEST
Begin DoDot:1
+6 SET QRSCP=$$PICKSCP^MAGDACU(DEFAULT,"Q/R")
+7 QUIT
End DoDot:1
+8 QUIT QRSCP
+9 ;
GETKEYS() ; get the keys for Q/R query
+1 NEW DONE,I,N,T
+2 SET DONE=0
FOR
Begin DoDot:1
+3 DO DISPLAY
+4 WRITE !!!,"Enter 1-",KEYCOUNT," "
IF OPTION="QR"
Begin DoDot:2
+5 WRITE "for key, ""B"" for back, ""Q"" to query, ""R"" to retrieve, ""^"" to exit: "
+6 QUIT
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 WRITE "to change a key, ""B"" for back, ""Q"" to query, ""^"" to exit: "
+9 QUIT
End DoDot:2
+10 READ N:DTIME
IF '$TEST
SET N="^"
+11 IF N?1N.N
IF N>0
IF N<(KEYCOUNT+1)
Begin DoDot:2
+12 SET ATTRIB=$PIECE(KEYLIST(N),"|",1)
+13 SET DEFAULT=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,ATTRIB))
+14 DO @$PIECE(KEYLIST(N),"|",2)
+15 QUIT
End DoDot:2
+16 IF N="^"
Begin DoDot:2
+17 KILL ^TMP("MAG",$JOB,"Q/R QUERY")
+18 KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB)
+19 SET DONE=-1
+20 QUIT
End DoDot:2
QUIT
+21 IF (N="B")!(N="b")
Begin DoDot:2
+22 ; remove any previous query error message
KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"MESSAGE")
+23 SET DONE=3
+24 QUIT
End DoDot:2
+25 ;
+26 IF QRROOT=""
Begin DoDot:2
+27 WRITE !!,"Query/Retrieve Root must be defined"
+28 QUIT
End DoDot:2
QUIT
+29 ;
+30 IF (N="Q")!(N="q")
Begin DoDot:2
+31 SET QUERYLEVEL=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL"))
+32 IF $$CHECKQRY^MAGDSTQ
SET DONE=1
+33 QUIT
End DoDot:2
+34 IF (N="R")!(N="r")
Begin DoDot:2
+35 IF OPTION'="QR"
WRITE !,"Retrieve requires query/retrieve menu option"
READ X:DTIME
QUIT
+36 SET RETRIEVELEVEL=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL"))
+37 IF $$CHECKRTV^MAGDSTQ
SET DONE=2
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
if DONE
QUIT
+40 QUIT DONE
+41 ;
DISPLAY ;
+1 NEW ATTRIB,I,TAB,X
+2 SET X="SELECT QUERY"
+3 IF OPTION="QR"
SET X=X_"/RETRIEVE"
+4 SET X=X_" KEYS"
+5 ; S X=X_" STACK: "_QRSTACK ; SHOW QRSTACK
+6 SET TAB=27-($LENGTH(X)/2)
+7 WRITE @IOF,?TAB,X,?66," Root: ",QRROOT
+8 WRITE !?TAB
FOR I=1:1:$LENGTH(X)
WRITE "-"
+9 WRITE ?66,"Level: ",QUERYLEVEL
+10 FOR I=1:1:KEYCOUNT
Begin DoDot:1
+11 SET ATTRIB=$PIECE(KEYLIST(I),"|",1)
+12 WRITE !,$JUSTIFY($PIECE(ATTRIB,"(",1),25)
if I<10
WRITE " "
WRITE " (",I,") : "
+13 WRITE $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,ATTRIB))
+14 QUIT
End DoDot:1
+15 QUIT
+16 ;
+17 ; Check query keys for minimum required values
+18 ;
CHECKQRY() ; check query keys to prevent broad queries
+1 NEW OK
SET OK=0
+2 IF QUERYLEVEL=""
Begin DoDot:1
+3 WRITE !!,"QUERY LEVEL must be defined"
+4 QUIT
End DoDot:1
+5 IF '$TEST
IF QUERYLEVEL="PATIENT"
Begin DoDot:1
+6 IF $$CHECKPTQ
SET OK=1
+7 IF '$TEST
WRITE !!,"Patient Root Patient Level queries requires either the patient name, ID, or DOB."
+8 QUIT
End DoDot:1
+9 IF '$TEST
IF QUERYLEVEL="STUDY"
Begin DoDot:1
+10 IF $$CHECKSTQ
SET OK=1
+11 IF '$TEST
Begin DoDot:2
+12 IF QRROOT="PATIENT"
Begin DoDot:3
+13 WRITE !!,"Study queries require the Patient ID and accession number, study date, or UID."
+14 QUIT
End DoDot:3
+15 ; QRROOT="STUDY"
IF '$TEST
Begin DoDot:3
+16 WRITE !!,"Study queries require patient info, accession number, study date or Study UID."
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 IF '$TEST
IF QUERYLEVEL="SERIES"
Begin DoDot:1
+21 IF $$CHECKSEQ
SET OK=1
+22 IF '$TEST
Begin DoDot:2
+23 IF QRROOT="PATIENT"
Begin DoDot:3
+24 WRITE !!,"Series queries require the Patient ID and the Study Instance UID."
+25 QUIT
End DoDot:3
+26 ; QRROOT="STUDY"
IF '$TEST
Begin DoDot:3
+27 WRITE !!,"Series queries require the Study Instance UID."
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 IF '$TEST
IF QUERYLEVEL="IMAGE"
Begin DoDot:1
+32 IF $$CHECKIMQ
SET OK=1
+33 IF '$TEST
Begin DoDot:2
+34 IF QRROOT="PATIENT"
Begin DoDot:3
+35 WRITE !!,"Image queries require the Patient ID and the Study and Series Instance UIDs."
+36 QUIT
End DoDot:3
+37 ; QRROOT="STUDY"
IF '$TEST
Begin DoDot:3
+38 WRITE !!,"Image queries require the Study and Series Instance UIDs."
+39 QUIT
End DoDot:3
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 IF 'OK
DO CONTINUE^MAGDSTQ
+43 QUIT OK
+44 ;
CHECKPTQ() ; check attributes for a patient level query
+1 NEW OK
SET OK=0
+2 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT NAME"))'=""
SET OK=1
+3 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID"))'=""
SET OK=1
+4 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE"))'=""
SET OK=1
+5 QUIT OK
+6 ;
CHECKSTQ() ; check attributes for a study level query
+1 NEW OK
SET OK=0
+2 IF $$CHECKPTQ()
SET OK=1
+3 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER"))'=""
SET OK=1
+4 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY DATE"))'=""
SET OK=1
+5 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'=""
SET OK=1
+6 QUIT OK
+7 ;
CHECKSEQ() ; check attributes for a series level query
+1 NEW OK
SET OK=0
+2 ; study root doesn't need patient id
IF QRROOT="STUDY"
SET OK=1
+3 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID"))'=""
SET OK=1
+4 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'=""
SET OK=OK+1
+5 QUIT OK=2
+6 ;
CHECKIMQ() ; check attributes for an image level query
+1 NEW OK
SET OK=0
+2 ; study root doesn't need patient id
IF QRROOT="STUDY"
SET OK=1
+3 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID"))'=""
SET OK=1
+4 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'=""
SET OK=OK+1
+5 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)"))'=""
SET OK=OK+1
+6 QUIT OK=3
+7 ;
+8 ;
+9 ; Check retrieve keys for minimum required values
+10 ;
CHECKRTV() ; check retrieve keys to prevent broad retrieves
+1 NEW OK,X
SET OK=0
+2 IF RETRIEVELEVEL=""
Begin DoDot:1
+3 WRITE !!,"RETRIEVE LEVEL must be defined"
+4 QUIT
End DoDot:1
+5 IF '$TEST
IF RETRIEVELEVEL="PATIENT"
Begin DoDot:1
+6 IF $$CHECKPTR
Begin DoDot:2
+7 WRITE !!,"This will retrieve all of the images for all the studies for this patient."
+8 IF $$YESNO("Are you sure that you want to do this?","NO!",.X)<0
QUIT
+9 IF X="YES"
SET OK=1
+10 QUIT
End DoDot:2
+11 IF '$TEST
WRITE !!,"Patient Root Patient Level retrieves require the PATIENT ID."
+12 QUIT
End DoDot:1
+13 IF '$TEST
IF RETRIEVELEVEL="STUDY"
Begin DoDot:1
+14 IF $$CHECKPTR
IF $$CHECKSTR
SET OK=1
+15 IF '$TEST
Begin DoDot:2
+16 IF QRROOT="PATIENT"
Begin DoDot:3
+17 WRITE !!,"Study Level retrieves require the Patient ID and STUDY INSTANCE UID."
+18 QUIT
End DoDot:3
+19 ; QRROOT="STUDY"
IF '$TEST
Begin DoDot:3
+20 WRITE !!,"Study Level retrieves require the STUDY INSTANCE UID."
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF '$TEST
IF RETRIEVELEVEL="SERIES"
Begin DoDot:1
+25 IF $$CHECKPTR
IF $$CHECKSTR
IF $$CHECKSER
SET OK=1
+26 IF '$TEST
Begin DoDot:2
+27 IF QRROOT="PATIENT"
Begin DoDot:3
+28 WRITE !!,"Series retrieves require the Patient ID and STUDY and Series INSTANCE UIDs."
+29 QUIT
End DoDot:3
+30 ; QRROOT="STUDY"
IF '$TEST
Begin DoDot:3
+31 WRITE !!,"Series retrieves requires the STUDY and SERIES INSTANCE UIDs."
+32 QUIT
End DoDot:3
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 IF '$TEST
IF RETRIEVELEVEL="IMAGE"
Begin DoDot:1
+36 IF $$CHECKPTR
IF $$CHECKSTR
IF $$CHECKSER
IF $$CHECKIMR
SET OK=1
+37 IF '$TEST
Begin DoDot:2
+38 IF QRROOT="PATIENT"
Begin DoDot:3
+39 WRITE !!,"Image retrieves require the Patient ID and STUDY, Series, and SOP INSTANCE UIDs."
+40 QUIT
End DoDot:3
+41 ; QRROOT="STUDY"
IF '$TEST
Begin DoDot:3
+42 WRITE !!,"Image retrieve requires the STUDY, SERIES, and SOP INSTANCE UIDs."
+43 QUIT
End DoDot:3
+44 QUIT
End DoDot:2
+45 QUIT
End DoDot:1
+46 IF 'OK
DO CONTINUE^MAGDSTQ
+47 QUIT OK
+48 ;
CHECKPTR() ; check attributes for a patient level retrieve
+1 NEW OK
SET OK=0
+2 ; study root doesn't need patient id
IF QRROOT="STUDY"
SET OK=1
+3 IF '$TEST
IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID"))'=""
SET OK=1
+4 QUIT OK
+5 ;
CHECKSTR() ; check attributes for a study level retrieve
+1 NEW OK
SET OK=0
+2 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)"))'=""
SET OK=1
+3 QUIT OK
+4 ;
CHECKSER() ; check attributes for a series level retrieve
+1 NEW OK
SET OK=0
+2 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)"))'=""
SET OK=1
+3 QUIT OK
+4 ;
CHECKIMR() ; check attributes for an image level retrieve
+1 NEW OK
SET OK=0
+2 IF $GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID(0001)"))'=""
SET OK=1
+3 QUIT OK
+4 ;
+5 ;
+6 ;
YESNO(PROMPT,DEFAULT,CHOICE,HELP) ; generic YES/NO question driver
+1 NEW I,OK,X
+2 SET OK=0
FOR
Begin DoDot:1
+3 WRITE !!,PROMPT," "
IF $LENGTH($GET(DEFAULT))
WRITE DEFAULT,"// "
+4 READ X:DTIME
IF '$TEST
SET X="^"
+5 IF X=""
IF $LENGTH($GET(DEFAULT))
SET X=DEFAULT
WRITE X
+6 ; fails Y/N tests
IF X=""
IF '$LENGTH($GET(DEFAULT))
SET X="*"
+7 IF X["^"
SET CHOICE="^"
SET OK=-1
QUIT
+8 IF "Yy"[$EXTRACT(X)
SET CHOICE="YES"
SET OK=1
QUIT
+9 IF "Nn"[$EXTRACT(X)
SET CHOICE="NO"
SET OK=1
QUIT
+10 IF X["?"
IF $DATA(HELP)
Begin DoDot:2
+11 WRITE !
+12 FOR I=1:1
if '$DATA(HELP(I))
QUIT
WRITE !,HELP(I)
+13 QUIT
End DoDot:2
+14 IF '$TEST
WRITE " ??? - Please enter ""Yes"" or ""No"""
+15 QUIT
End DoDot:1
if OK
QUIT
+16 QUIT OK
+17 ;
CONTINUE(ERASE) ; used by several routines on VistA and DICOM Gateway
+1 NEW X
+2 ; only ask for terminal I/O jobs
IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+3 SET ERASE=$GET(ERASE,0)
IF 'ERASE
WRITE !!
+4 WRITE "Press <Enter> to continue..."
+5 READ X:$GET(DTIME,300)
+6 IF ERASE
Begin DoDot:1
+7 ; erase the line
FOR
if $X=0
QUIT
WRITE @IOBS," ",@IOBS
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
VISTA() ;
+1 ; return 1 for running in VistA namespace, 0 otherwise
+2 ; this should exist only on VistA
QUIT $DATA(^MAG(2005,0))
