- 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 Jan 18, 2025@03:03:14 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 "???"