- 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 Jan 18, 2025@03:03:09 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))