- 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 Feb 18, 2025@23:28:32 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