MAGDSTV1 ;WOIFO/PMK - Study Tracker - VistA Query/Retrieve user ; Apr 25, 2022@09:21:50
;;3.0;IMAGING;**231,305**;Mar 19, 2002;Build 3
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #10103 reference $$NOW^XLFDT function call
; Supported IA #10103 reference $$FMTE^XLFDT function call
;
SOPUIDQ ; Called from batch compare/retrieve for a SOP Instance Query
; suppress text output when doing a batch query
N BATCHQR
S BATCHQR=1
K ^XTMP(MAGXTMP,HOSTNAME,$J,"AUTOMATIC")
D ENTRY("Q")
Q
;
SOPUIDR ; Called from batch retrieve for a SOP Instance Retrieval
; suppress text output when doing a batch retrieve
N BATCHQR
S BATCHQR=1
K ^XTMP(MAGXTMP,HOSTNAME,$J,"AUTOMATIC")
;
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
;
; indicate if the retrieve monitor is running - P305 PMK 03/15/2022
I $$ENABLED^MAGDSTV1 S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE MONITOR")="YES"
E S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE MONITOR")="NO"
;
D ENTRY("R") ; don't show retrieve results
Q
;
;
ENTRY(MODE,SHOWRRSL) ; called from ^MAGDSTQ for a VistA Q/R client
N CMOVEAET,GATEWAYHOSTNAME,I,IEN2006541,KEY,REQUESTDATETIME,VALUE,X,ZERONODE
S MODE=$G(MODE)
I MODE'="Q",MODE'="R" D Q
. W !,"Illegal mode in ENTRY^"_$T(+0),": ",MODE
. D CONTINUE^MAGDSTQ
. Q
K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"MESSAGE") ; remove any previous query error message
S SHOWRRSL=$G(SHOWRRSL) ; 1 = show retrieval results
;
; store the request on the queue
L +^MAGDSTT(2006.541):10 ; foreground process
S ZERONODE=$G(^MAGDSTT(2006.541,0))
S $P(ZERONODE,"^",1,2)="DICOM VISTA Q/R REQUEST QUEUE^2006.541"
S IEN2006541=$O(^MAGDSTT(2006.541," "),-1)+1 ; Next number
S $P(ZERONODE,"^",3)=IEN2006541
S $P(ZERONODE,"^",4)=$P(ZERONODE,"^",4)+1 ; Total count
S ^MAGDSTT(2006.541,0)=ZERONODE
S REQUESTDATETIME=$$NOW^XLFDT
S ^MAGDSTT(2006.541,IEN2006541,0)=REQUESTDATETIME_"^"_MODE_"^"_MAGXTMP_"^"_HOSTNAME_"^"_$J_"^"_QRSTACK_"^"_DUZ
S KEY="" F I=1:1 S KEY=$O(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,KEY)) Q:KEY="" D
. S VALUE=^TMP("MAG",$J,"Q/R QUERY",QRSTACK,KEY)
. S VALUE=$TR(VALUE,"^","~") ; change ^'s in names to ~'s
. S ^MAGDSTT(2006.541,IEN2006541,1,I,0)=KEY_"^"_VALUE
. S ^MAGDSTT(2006.541,IEN2006541,1,"B",KEY,I)=""
. Q
S ^MAGDSTT(2006.541,"B",REQUESTDATETIME,IEN2006541)="" ; create B-xref
S I=I-1
S ^MAGDSTT(2006.541,IEN2006541,1,0)="^2006.5411A^"_I_"^"_I
S ^MAGDSTT(2006.541,0)=ZERONODE
L -^MAGDSTT(2006.541)
;
I MODE="Q" D
. I '$G(BATCHQR) W !,"Performing query on DICOM Gateway"
. ; "DONE" uses the request IEN for proper synchronization
. I '$$WAIT(.CMOVEAET) Q
. I '$G(BATCHQR) D DISPLAY^MAGDSTQ5
. Q
E I MODE="R" D
. I '$$WAIT(.CMOVEAET) Q
. ; save Move Application Entity Title
. I $D(RUNNUMBER) S $P(^MAGDSTT(2006.543,RUNNUMBER,0),"^",8)=CMOVEAET
. I $G(BATCHQR) Q ; suppress text output
. I 'SHOWRRSL D
. . F Q:$X=0 W @IOBS," ",@IOBS ; erase the line
. . W "Performing retrieve from """,QRSCP,""" from DICOM Gateway"
. . W " (",GATEWAYHOSTNAME,")"
. . R X:3
. Q
Q
;
WAIT(CMOVEAET) ; wait up to ten minutes for response from DICOM Gateway
N I,J,SUCCESS,TIMESTAMP,X
S CMOVEAET="",SUCCESS=0
S TIMESTAMP=$$NOW^XLFDT ; time at the beginning of the wait
;
; check that the gateway surrogated picked up the Q/R request
F I=1:1:10 D Q:SUCCESS
. S X=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"WORKING...",IEN2006541))
. I $L(X) D Q
. . S GATEWAYHOSTNAME=$P(X,"^",3)
. . S SUCCESS=1
. . Q
. H 1
. Q
I 'SUCCESS D Q SUCCESS
. W !
. W ! F J=1:1:80 W "*"
. W !,"*** No DICOM Gateway Surrogate process is available for VistA Q/R Client"
. W ?77,"***"
. W ! F J=1:1:80 W "*"
. W !
. I $G(BATCHQR) Q ; suppress CONTINUE prompt
. D CONTINUE^MAGDSTQ
. Q
;
I MODE="Q",'$G(BATCHQR) W " (",GATEWAYHOSTNAME,")"
;
; check that the Q/R request was processed
F I=1:1:600 Q:$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"DONE",IEN2006541)) D
. H 1
. I $G(BATCHQR) Q ; suppress text output
. W "."
. Q
S X=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"DONE",IEN2006541))
S SUCCESS=0
I $L(X) D
. S SUCCESS=1
. S CMOVEAET=$P(X,"^",3)
. Q
E D
. W !
. W ! F J=1:1:80 W "*"
. W !,"*** The "
. W $S(MODE="Q":"query",MODE="R":"retrieve")
. W " was not completed by DICOM Gateway"
. I $D(GATEWAYHOSTNAME) W " (",GATEWAYHOSTNAME,")"
. W " ",$$FMTE^XLFDT(TIMESTAMP),?77,"***"
. W ! F J=1:1:80 W "*"
. W !
. I $G(BATCHQR) Q ; suppress CONTINUE prompt
. D CONTINUE^MAGDSTQ
. Q
;
; check for message
S X=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"MESSAGE","MSG",0))
I X,'$G(BATCHQR) D
. W !!,"Error Message: "
. F I=1:1:X W !,$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"MESSAGE","MSG",I))
. D CONTINUE^MAGDSTQ
. S SUCCESS=0,SHOWRRSL=0
. Q
;
Q SUCCESS
;
KILL ; truncate the DICOM VISTA Q/R REQUEST QUEUE file (#2006.541)
N PROMPT,X
S X=$P($G(^MAGDSTT(2006.541,0)),"^",3)
I X="" D Q
. W !!,"The DICOM VISTA Q/R REQUEST QUEUE entries have already been deleted."
. Q
I X=1 D
. W !!,"There is one entry in the DICOM VISTA Q/R REQUEST QUEUE."
. S PROMPT="Do you want to remove it?"
. Q
E D
. W !!,"There are "_X_" entries in the DICOM VISTA Q/R REQUEST QUEUE."
. S PROMPT="Do you want to remove them?"
. Q
I $$YESNO^MAGDSTQ(PROMPT,"n",.X)>0,X="YES" D
. K ^MAGDSTT(2006.541)
. S ^MAGDSTT(2006.541,0)="DICOM VISTA Q/R REQUEST QUEUE"_"^"_2006.541_"^^"
. W !!,"The DICOM VISTA Q/R REQUEST QUEUE file has been truncated."
. Q
E W !!,"The DICOM VISTA Q/R REQUEST QUEUE file has not been truncated."
Q
;
ENABLED() ; check if monitor is active - P305 PMK 03/15/2022
L +^MAGDRMON:0 ; automatic retrieve monitor is active
L -^MAGDRMON ; automatic retrieve monitor is not active
Q '$T
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTV1 6799 printed Sep 23, 2025@19:38:16 Page 2
MAGDSTV1 ;WOIFO/PMK - Study Tracker - VistA Query/Retrieve user ; Apr 25, 2022@09:21:50
+1 ;;3.0;IMAGING;**231,305**;Mar 19, 2002;Build 3
+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 ; Supported IA #10103 reference $$NOW^XLFDT function call
+19 ; Supported IA #10103 reference $$FMTE^XLFDT function call
+20 ;
SOPUIDQ ; Called from batch compare/retrieve for a SOP Instance Query
+1 ; suppress text output when doing a batch query
+2 NEW BATCHQR
+3 SET BATCHQR=1
+4 KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,"AUTOMATIC")
+5 DO ENTRY("Q")
+6 QUIT
+7 ;
SOPUIDR ; Called from batch retrieve for a SOP Instance Retrieval
+1 ; suppress text output when doing a batch retrieve
+2 NEW BATCHQR
+3 SET BATCHQR=1
+4 KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,"AUTOMATIC")
+5 ;
+6 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER")=ACNUMB
+7 ;
+8 ; indicate if the retrieve monitor is running - P305 PMK 03/15/2022
+9 IF $$ENABLED^MAGDSTV1
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE MONITOR")="YES"
+10 IF '$TEST
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE MONITOR")="NO"
+11 ;
+12 ; don't show retrieve results
DO ENTRY("R")
+13 QUIT
+14 ;
+15 ;
ENTRY(MODE,SHOWRRSL) ; called from ^MAGDSTQ for a VistA Q/R client
+1 NEW CMOVEAET,GATEWAYHOSTNAME,I,IEN2006541,KEY,REQUESTDATETIME,VALUE,X,ZERONODE
+2 SET MODE=$GET(MODE)
+3 IF MODE'="Q"
IF MODE'="R"
Begin DoDot:1
+4 WRITE !,"Illegal mode in ENTRY^"_$TEXT(+0),": ",MODE
+5 DO CONTINUE^MAGDSTQ
+6 QUIT
End DoDot:1
QUIT
+7 ; remove any previous query error message
KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"MESSAGE")
+8 ; 1 = show retrieval results
SET SHOWRRSL=$GET(SHOWRRSL)
+9 ;
+10 ; store the request on the queue
+11 ; foreground process
LOCK +^MAGDSTT(2006.541):10
+12 SET ZERONODE=$GET(^MAGDSTT(2006.541,0))
+13 SET $PIECE(ZERONODE,"^",1,2)="DICOM VISTA Q/R REQUEST QUEUE^2006.541"
+14 ; Next number
SET IEN2006541=$ORDER(^MAGDSTT(2006.541," "),-1)+1
+15 SET $PIECE(ZERONODE,"^",3)=IEN2006541
+16 ; Total count
SET $PIECE(ZERONODE,"^",4)=$PIECE(ZERONODE,"^",4)+1
+17 SET ^MAGDSTT(2006.541,0)=ZERONODE
+18 SET REQUESTDATETIME=$$NOW^XLFDT
+19 SET ^MAGDSTT(2006.541,IEN2006541,0)=REQUESTDATETIME_"^"_MODE_"^"_MAGXTMP_"^"_HOSTNAME_"^"_$JOB_"^"_QRSTACK_"^"_DUZ
+20 SET KEY=""
FOR I=1:1
SET KEY=$ORDER(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,KEY))
if KEY=""
QUIT
Begin DoDot:1
+21 SET VALUE=^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,KEY)
+22 ; change ^'s in names to ~'s
SET VALUE=$TRANSLATE(VALUE,"^","~")
+23 SET ^MAGDSTT(2006.541,IEN2006541,1,I,0)=KEY_"^"_VALUE
+24 SET ^MAGDSTT(2006.541,IEN2006541,1,"B",KEY,I)=""
+25 QUIT
End DoDot:1
+26 ; create B-xref
SET ^MAGDSTT(2006.541,"B",REQUESTDATETIME,IEN2006541)=""
+27 SET I=I-1
+28 SET ^MAGDSTT(2006.541,IEN2006541,1,0)="^2006.5411A^"_I_"^"_I
+29 SET ^MAGDSTT(2006.541,0)=ZERONODE
+30 LOCK -^MAGDSTT(2006.541)
+31 ;
+32 IF MODE="Q"
Begin DoDot:1
+33 IF '$GET(BATCHQR)
WRITE !,"Performing query on DICOM Gateway"
+34 ; "DONE" uses the request IEN for proper synchronization
+35 IF '$$WAIT(.CMOVEAET)
QUIT
+36 IF '$GET(BATCHQR)
DO DISPLAY^MAGDSTQ5
+37 QUIT
End DoDot:1
+38 IF '$TEST
IF MODE="R"
Begin DoDot:1
+39 IF '$$WAIT(.CMOVEAET)
QUIT
+40 ; save Move Application Entity Title
+41 IF $DATA(RUNNUMBER)
SET $PIECE(^MAGDSTT(2006.543,RUNNUMBER,0),"^",8)=CMOVEAET
+42 ; suppress text output
IF $GET(BATCHQR)
QUIT
+43 IF 'SHOWRRSL
Begin DoDot:2
+44 ; erase the line
FOR
if $X=0
QUIT
WRITE @IOBS," ",@IOBS
+45 WRITE "Performing retrieve from """,QRSCP,""" from DICOM Gateway"
+46 WRITE " (",GATEWAYHOSTNAME,")"
+47 READ X:3
End DoDot:2
+48 QUIT
End DoDot:1
+49 QUIT
+50 ;
WAIT(CMOVEAET) ; wait up to ten minutes for response from DICOM Gateway
+1 NEW I,J,SUCCESS,TIMESTAMP,X
+2 SET CMOVEAET=""
SET SUCCESS=0
+3 ; time at the beginning of the wait
SET TIMESTAMP=$$NOW^XLFDT
+4 ;
+5 ; check that the gateway surrogated picked up the Q/R request
+6 FOR I=1:1:10
Begin DoDot:1
+7 SET X=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"WORKING...",IEN2006541))
+8 IF $LENGTH(X)
Begin DoDot:2
+9 SET GATEWAYHOSTNAME=$PIECE(X,"^",3)
+10 SET SUCCESS=1
+11 QUIT
End DoDot:2
QUIT
+12 HANG 1
+13 QUIT
End DoDot:1
if SUCCESS
QUIT
+14 IF 'SUCCESS
Begin DoDot:1
+15 WRITE !
+16 WRITE !
FOR J=1:1:80
WRITE "*"
+17 WRITE !,"*** No DICOM Gateway Surrogate process is available for VistA Q/R Client"
+18 WRITE ?77,"***"
+19 WRITE !
FOR J=1:1:80
WRITE "*"
+20 WRITE !
+21 ; suppress CONTINUE prompt
IF $GET(BATCHQR)
QUIT
+22 DO CONTINUE^MAGDSTQ
+23 QUIT
End DoDot:1
QUIT SUCCESS
+24 ;
+25 IF MODE="Q"
IF '$GET(BATCHQR)
WRITE " (",GATEWAYHOSTNAME,")"
+26 ;
+27 ; check that the Q/R request was processed
+28 FOR I=1:1:600
if $GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"DONE",IEN2006541))
QUIT
Begin DoDot:1
+29 HANG 1
+30 ; suppress text output
IF $GET(BATCHQR)
QUIT
+31 WRITE "."
+32 QUIT
End DoDot:1
+33 SET X=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"DONE",IEN2006541))
+34 SET SUCCESS=0
+35 IF $LENGTH(X)
Begin DoDot:1
+36 SET SUCCESS=1
+37 SET CMOVEAET=$PIECE(X,"^",3)
+38 QUIT
End DoDot:1
+39 IF '$TEST
Begin DoDot:1
+40 WRITE !
+41 WRITE !
FOR J=1:1:80
WRITE "*"
+42 WRITE !,"*** The "
+43 WRITE $SELECT(MODE="Q":"query",MODE="R":"retrieve")
+44 WRITE " was not completed by DICOM Gateway"
+45 IF $DATA(GATEWAYHOSTNAME)
WRITE " (",GATEWAYHOSTNAME,")"
+46 WRITE " ",$$FMTE^XLFDT(TIMESTAMP),?77,"***"
+47 WRITE !
FOR J=1:1:80
WRITE "*"
+48 WRITE !
+49 ; suppress CONTINUE prompt
IF $GET(BATCHQR)
QUIT
+50 DO CONTINUE^MAGDSTQ
+51 QUIT
End DoDot:1
+52 ;
+53 ; check for message
+54 SET X=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"MESSAGE","MSG",0))
+55 IF X
IF '$GET(BATCHQR)
Begin DoDot:1
+56 WRITE !!,"Error Message: "
+57 FOR I=1:1:X
WRITE !,$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"MESSAGE","MSG",I))
+58 DO CONTINUE^MAGDSTQ
+59 SET SUCCESS=0
SET SHOWRRSL=0
+60 QUIT
End DoDot:1
+61 ;
+62 QUIT SUCCESS
+63 ;
KILL ; truncate the DICOM VISTA Q/R REQUEST QUEUE file (#2006.541)
+1 NEW PROMPT,X
+2 SET X=$PIECE($GET(^MAGDSTT(2006.541,0)),"^",3)
+3 IF X=""
Begin DoDot:1
+4 WRITE !!,"The DICOM VISTA Q/R REQUEST QUEUE entries have already been deleted."
+5 QUIT
End DoDot:1
QUIT
+6 IF X=1
Begin DoDot:1
+7 WRITE !!,"There is one entry in the DICOM VISTA Q/R REQUEST QUEUE."
+8 SET PROMPT="Do you want to remove it?"
+9 QUIT
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !!,"There are "_X_" entries in the DICOM VISTA Q/R REQUEST QUEUE."
+12 SET PROMPT="Do you want to remove them?"
+13 QUIT
End DoDot:1
+14 IF $$YESNO^MAGDSTQ(PROMPT,"n",.X)>0
IF X="YES"
Begin DoDot:1
+15 KILL ^MAGDSTT(2006.541)
+16 SET ^MAGDSTT(2006.541,0)="DICOM VISTA Q/R REQUEST QUEUE"_"^"_2006.541_"^^"
+17 WRITE !!,"The DICOM VISTA Q/R REQUEST QUEUE file has been truncated."
+18 QUIT
End DoDot:1
+19 IF '$TEST
WRITE !!,"The DICOM VISTA Q/R REQUEST QUEUE file has not been truncated."
+20 QUIT
+21 ;
ENABLED() ; check if monitor is active - P305 PMK 03/15/2022
+1 ; automatic retrieve monitor is active
LOCK +^MAGDRMON:0
+2 ; automatic retrieve monitor is not active
LOCK -^MAGDRMON
+3 QUIT '$TEST
