MAGDSTQ8 ;WOIFO/PMK - Study Tracker - Patient Level Query/Retrieve Display; Apr 06, 2020@13:36:50
;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Aug 30, 2013
;; 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
;
; Supported IA #10103 reference $$HTE^XLFDT function call
;
; Display Retrieve Status
;
Q
;
RETRIEVE ;
N ACNUMB,BADTAGS,BADUIDS,COMMENT,COMPLETED,DONE,ERRORID,FAILED,I,MEANING,NORESULTS
N REDISPLAY,REMAINING,STATUS,STATUSCODE,TIME,TIMEOUT,TIMESTAMP,X,WARNING
;
S TIMEOUT=1
;
S ACNUMB=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER"))
I ACNUMB="",^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")="PATIENT" D
. S ACNUMB=^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID")
. Q
;
K ^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB)
;
D DISPLAY(.REDISPLAY)
;
S (DONE,NORESULTS)=0
F D Q:DONE
. I REDISPLAY D DISPLAY(.REDIPLAY)
. F Q:$X=0 W @IOBS," ",@IOBS ; erase the line
. S X=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB))
. I X="" D
. . W "No retrieve results yet"
. . S NORESULTS=NORESULTS+1
. . F I=1:1:NORESULTS W "."
. . I NORESULTS>45 S DONE=-1
. . Q
. E D
. . S STATE=$P(X,"|",1)
. . S TIMESTAMP=$P(X,"|",2)
. . S STATUSCODE=$P(X,"|",3)
. . I STATUSCODE="" W STATE Q ; informational message
. . S REMAINING=+$P(X,"|",4) ; coerce null to 0
. . S COMPLETED=+$P(X,"|",5) ; coerce null to 0
. . S FAILED=$P(X,"|",6)
. . S WARNING=$P(X,"|",7)
. . S BADTAGS=$P(X,"|",8)
. . S BADUIDS=$P(X,"|",9)
. . S ERRORID=$P(X,"|",10)
. . S COMMENT=$P(X,"|",11,999) ; may contain "|"
. . S TIME=$P($$HTE^XLFDT(TIMESTAMP),"@",2)
. . S STATUS=$$STATUS(STATUSCODE,.MEANING)
. . I STATUS="Pending" D
. . . I COMPLETED=0 W "No DICOM object retrieved yet"
. . . E I COMPLETED=1 W "One DICOM object retrieved"
. . . E W COMPLETED," DICOM objects retrieved"
. . . W " -- "
. . . I REMAINING=1 W "one DICOM object remaining"
. . . E W REMAINING," DICOM objects remaining"
. . . Q
. . E I STATUS="Success" D
. . . I COMPLETED=0 W "No DICOM objects were retrieved"
. . . E I COMPLETED=1 W "One DICOM object retrieved from """,QRSCP,""""
. . . E W "A total of ",COMPLETED," DICOM objects retrieved from """,QRSCP,""""
. . . S DONE=1
. . . Q
. . E I STATUS="Cancel" D
. . . W "Retrieve operation canceled"
. . . S DONE=1
. . . Q
. . E I STATUS="Failure" D
. . . W "Retrieve operation failed: ",MEANING
. . . S DONE=1
. . . Q
. . I FAILED D
. . . W !,"Number of failed operations: ",FAILED
. . . S REDISPLAY=1
. . . Q
. . I WARNING D
. . . W !,"Number of operations with warnings: ",WARNING
. . . S REDISPLAY=1
. . . Q
. . I ERRORID'="" D
. . . W !,"Error ID: ",ERRORID
. . . S REDISPLAY=1
. . . Q
. . I COMMENT'="" D
. . . W !,"Error Comment: ",COMMENT
. . . S REDISPLAY=1
. . . Q
. . I BADTAGS'="" D
. . . W !,"Offending Elements: ",BADTAGS
. . . S REDISPLAY=1
. . . Q
. . I BADUIDS'="" D
. . . W !,"Failed SOP Instance UIDs: ",BADUIDS
. . . S REDISPLAY=1
. . . Q
. . Q
. Q:DONE
. W ?68,"More?"
. R " y// ",X:TIMEOUT
. I X="" S X="y" W X
. I "Yy"'[$E(X) S DONE=1
. Q
I DONE<1 W !,"*** Possible problem with DICOM Gateway C-Move Request process ***"
D CONTINUE^MAGDSTQ
Q
;
DISPLAY(REDISPLAY) ; refresh the top of the screen
D DISPLAY^MAGDSTQ
W !!!
S REDISPLAY=0
Q
;
STATUS(CODE,MEANING) ; return status codes
; from Table C.4-2 C-MOVE Response Status Values PS3.4 2108b
I CODE="FF00" D Q "Pending"
. S MEANING="Sub-operations are continuing"
. Q
I CODE="FF01" D Q "Pending"
. S MEANING="Sub-operations are continuing but one or more Optional Keys were not supported"
. Q
I (CODE="0000")!(CODE=0) D Q "Success"
. S MEANING="Sub-operations Complete - No Failures"
. Q
I CODE="A700" D Q "Failure"
. S MEANING="Refused: Out of Resources"
. Q
I CODE="A701" D Q "Failure"
. S MEANING="Refused: Out of Resources - Unable to calculate number of matches"
. Q
I CODE="A702" D Q "Failure"
. S MEANING="Refused: Out of Resources - Unable to perform sub-operations"
. Q
I CODE="A801" D Q "Failure"
. S MEANING="Refused: Move Destination unknown"
. Q
I CODE="A900" D Q "Failure"
. S MEANING="Error: Data Set does not match SOP Class"
. Q
I CODE?1"C"3E D Q "Failure"
. S MEANING="Failed: Unable to Process"
. Q
I CODE="FE00" D Q "Cancel"
. S MEANING="Sub-operations terminated due to Cancel Indication"
. Q
I CODE="B000" D Q "Warning"
. S MEANING="Sub-operations Complete - One or more Failures"
. Q
S MEANING="Unknown Status Code: """_CODE_""""
Q "???"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQ8 5701 printed Sep 23, 2025@19:38:13 Page 2
MAGDSTQ8 ;WOIFO/PMK - Study Tracker - Patient Level Query/Retrieve Display; Apr 06, 2020@13:36:50
+1 ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Aug 30, 2013
+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 ; Supported IA #10103 reference $$HTE^XLFDT function call
+21 ;
+22 ; Display Retrieve Status
+23 ;
+24 QUIT
+25 ;
RETRIEVE ;
+1 NEW ACNUMB,BADTAGS,BADUIDS,COMMENT,COMPLETED,DONE,ERRORID,FAILED,I,MEANING,NORESULTS
+2 NEW REDISPLAY,REMAINING,STATUS,STATUSCODE,TIME,TIMEOUT,TIMESTAMP,X,WARNING
+3 ;
+4 SET TIMEOUT=1
+5 ;
+6 SET ACNUMB=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ACCESSION NUMBER"))
+7 IF ACNUMB=""
IF ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")="PATIENT"
Begin DoDot:1
+8 SET ACNUMB=^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID")
+9 QUIT
End DoDot:1
+10 ;
+11 KILL ^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB)
+12 ;
+13 DO DISPLAY(.REDISPLAY)
+14 ;
+15 SET (DONE,NORESULTS)=0
+16 FOR
Begin DoDot:1
+17 IF REDISPLAY
DO DISPLAY(.REDIPLAY)
+18 ; erase the line
FOR
if $X=0
QUIT
WRITE @IOBS," ",@IOBS
+19 SET X=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB))
+20 IF X=""
Begin DoDot:2
+21 WRITE "No retrieve results yet"
+22 SET NORESULTS=NORESULTS+1
+23 FOR I=1:1:NORESULTS
WRITE "."
+24 IF NORESULTS>45
SET DONE=-1
+25 QUIT
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 SET STATE=$PIECE(X,"|",1)
+28 SET TIMESTAMP=$PIECE(X,"|",2)
+29 SET STATUSCODE=$PIECE(X,"|",3)
+30 ; informational message
IF STATUSCODE=""
WRITE STATE
QUIT
+31 ; coerce null to 0
SET REMAINING=+$PIECE(X,"|",4)
+32 ; coerce null to 0
SET COMPLETED=+$PIECE(X,"|",5)
+33 SET FAILED=$PIECE(X,"|",6)
+34 SET WARNING=$PIECE(X,"|",7)
+35 SET BADTAGS=$PIECE(X,"|",8)
+36 SET BADUIDS=$PIECE(X,"|",9)
+37 SET ERRORID=$PIECE(X,"|",10)
+38 ; may contain "|"
SET COMMENT=$PIECE(X,"|",11,999)
+39 SET TIME=$PIECE($$HTE^XLFDT(TIMESTAMP),"@",2)
+40 SET STATUS=$$STATUS(STATUSCODE,.MEANING)
+41 IF STATUS="Pending"
Begin DoDot:3
+42 IF COMPLETED=0
WRITE "No DICOM object retrieved yet"
+43 IF '$TEST
IF COMPLETED=1
WRITE "One DICOM object retrieved"
+44 IF '$TEST
WRITE COMPLETED," DICOM objects retrieved"
+45 WRITE " -- "
+46 IF REMAINING=1
WRITE "one DICOM object remaining"
+47 IF '$TEST
WRITE REMAINING," DICOM objects remaining"
+48 QUIT
End DoDot:3
+49 IF '$TEST
IF STATUS="Success"
Begin DoDot:3
+50 IF COMPLETED=0
WRITE "No DICOM objects were retrieved"
+51 IF '$TEST
IF COMPLETED=1
WRITE "One DICOM object retrieved from """,QRSCP,""""
+52 IF '$TEST
WRITE "A total of ",COMPLETED," DICOM objects retrieved from """,QRSCP,""""
+53 SET DONE=1
+54 QUIT
End DoDot:3
+55 IF '$TEST
IF STATUS="Cancel"
Begin DoDot:3
+56 WRITE "Retrieve operation canceled"
+57 SET DONE=1
+58 QUIT
End DoDot:3
+59 IF '$TEST
IF STATUS="Failure"
Begin DoDot:3
+60 WRITE "Retrieve operation failed: ",MEANING
+61 SET DONE=1
+62 QUIT
End DoDot:3
+63 IF FAILED
Begin DoDot:3
+64 WRITE !,"Number of failed operations: ",FAILED
+65 SET REDISPLAY=1
+66 QUIT
End DoDot:3
+67 IF WARNING
Begin DoDot:3
+68 WRITE !,"Number of operations with warnings: ",WARNING
+69 SET REDISPLAY=1
+70 QUIT
End DoDot:3
+71 IF ERRORID'=""
Begin DoDot:3
+72 WRITE !,"Error ID: ",ERRORID
+73 SET REDISPLAY=1
+74 QUIT
End DoDot:3
+75 IF COMMENT'=""
Begin DoDot:3
+76 WRITE !,"Error Comment: ",COMMENT
+77 SET REDISPLAY=1
+78 QUIT
End DoDot:3
+79 IF BADTAGS'=""
Begin DoDot:3
+80 WRITE !,"Offending Elements: ",BADTAGS
+81 SET REDISPLAY=1
+82 QUIT
End DoDot:3
+83 IF BADUIDS'=""
Begin DoDot:3
+84 WRITE !,"Failed SOP Instance UIDs: ",BADUIDS
+85 SET REDISPLAY=1
+86 QUIT
End DoDot:3
+87 QUIT
End DoDot:2
+88 if DONE
QUIT
+89 WRITE ?68,"More?"
+90 READ " y// ",X:TIMEOUT
+91 IF X=""
SET X="y"
WRITE X
+92 IF "Yy"'[$EXTRACT(X)
SET DONE=1
+93 QUIT
End DoDot:1
if DONE
QUIT
+94 IF DONE<1
WRITE !,"*** Possible problem with DICOM Gateway C-Move Request process ***"
+95 DO CONTINUE^MAGDSTQ
+96 QUIT
+97 ;
DISPLAY(REDISPLAY) ; refresh the top of the screen
+1 DO DISPLAY^MAGDSTQ
+2 WRITE !!!
+3 SET REDISPLAY=0
+4 QUIT
+5 ;
STATUS(CODE,MEANING) ; return status codes
+1 ; from Table C.4-2 C-MOVE Response Status Values PS3.4 2108b
+2 IF CODE="FF00"
Begin DoDot:1
+3 SET MEANING="Sub-operations are continuing"
+4 QUIT
End DoDot:1
QUIT "Pending"
+5 IF CODE="FF01"
Begin DoDot:1
+6 SET MEANING="Sub-operations are continuing but one or more Optional Keys were not supported"
+7 QUIT
End DoDot:1
QUIT "Pending"
+8 IF (CODE="0000")!(CODE=0)
Begin DoDot:1
+9 SET MEANING="Sub-operations Complete - No Failures"
+10 QUIT
End DoDot:1
QUIT "Success"
+11 IF CODE="A700"
Begin DoDot:1
+12 SET MEANING="Refused: Out of Resources"
+13 QUIT
End DoDot:1
QUIT "Failure"
+14 IF CODE="A701"
Begin DoDot:1
+15 SET MEANING="Refused: Out of Resources - Unable to calculate number of matches"
+16 QUIT
End DoDot:1
QUIT "Failure"
+17 IF CODE="A702"
Begin DoDot:1
+18 SET MEANING="Refused: Out of Resources - Unable to perform sub-operations"
+19 QUIT
End DoDot:1
QUIT "Failure"
+20 IF CODE="A801"
Begin DoDot:1
+21 SET MEANING="Refused: Move Destination unknown"
+22 QUIT
End DoDot:1
QUIT "Failure"
+23 IF CODE="A900"
Begin DoDot:1
+24 SET MEANING="Error: Data Set does not match SOP Class"
+25 QUIT
End DoDot:1
QUIT "Failure"
+26 IF CODE?1"C"3E
Begin DoDot:1
+27 SET MEANING="Failed: Unable to Process"
+28 QUIT
End DoDot:1
QUIT "Failure"
+29 IF CODE="FE00"
Begin DoDot:1
+30 SET MEANING="Sub-operations terminated due to Cancel Indication"
+31 QUIT
End DoDot:1
QUIT "Cancel"
+32 IF CODE="B000"
Begin DoDot:1
+33 SET MEANING="Sub-operations Complete - One or more Failures"
+34 QUIT
End DoDot:1
QUIT "Warning"
+35 SET MEANING="Unknown Status Code: """_CODE_""""
+36 QUIT "???"
