MAGDSTAG ;WOIFO/PMK - Study Tracker - Automatic Retrieve Monitor; Aug 04, 2025@12:34:57
;;3.0;IMAGING;**333**;Mar 19, 2002;Build 2
;; Per VA Directive 6402, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | |
;; | 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 $$HTE^XLFDT function call
;
; Display Automatic Retrieve Status - similar to MAGDSTQ8
;
Q
;
ENTRY ; Display Automatic Retrieve Status
N A,ACNUMB,BADTAGS,BADUIDS,COMMENT,COMPLETED,COUNT,DONE
N ERRORID,FAILED,HOSTNAME,I,IDLE,J,K,MAGXTMP,MEANING,QRSCP
N REDISPLAY,REMAINING,STATE,STATUS,STATUSCODE,TIMESTAMP,WARNING,X
;
L +^MAGDRMON:0 E D Q ; signal that the monitor is running
. W !!,"The Automatic Retrieval Monitor is already running"
. D CONTINUE^MAGDSTQ
. Q
;
S HOSTNAME=$$HOSTNAME^MAGDFCNV
S MAGXTMP=$$INITXTMP^MAGDSTQ0
I $D(^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS")) D
. I $$YESNO^MAGDSTQ("Initialize the log?","No",.X)<0 Q
. I X="YES" K ^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS")
. Q
;
W @IOF R !!,"Use caret (""^"") to exit. Press <Enter> to begin...",X:DTIME
W @IOF D HEADING
S (DONE,IDLE)=0
S I=0 F D Q:DONE
. S J=$O(^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",I))
. I J="" D Q
. . D IDLE(.IDLE,.DONE) ; P333 PMK 08/04/2025
. . Q
. S I=J
. S X=^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",I)
. S ACNUMB=$P(X,"|",1)
. S X=$P(X,"|",2,999) ; align remaining pieces with ^MAGDSTQ8
. S STATUSCODE=$$PARSE^MAGDSTQ8(X)
. ;
. I STATUSCODE="" D Q ; informational message
. . I STATE?1"Building".E D Q
. . . I $Y>(IOSL-4) D
. . . . S $Y=0 W !!
. . . . D HEADING
. . . . Q
. . . Q
. . I STATE?1"Sending".E D
. . . S QRSCP=$P(STATE,"""",2)
. . . W !!,$$DAYTIME(TIMESTAMP)," ",ACNUMB,?34,"Sent from ",QRSCP,!
. . . Q
. . Q
. ;
. F Q:$X=0 W @IOBS," ",@IOBS ; erase the line
. S STATUS=$$STATUS^MAGDSTQ8(STATUSCODE,.MEANING)
. I STATUS="Success" D
. . I COMPLETED=0 W "No DICOM objects were retrieved"
. . E W "DICOM objects retrieved: ",COMPLETED
. . Q
. E D
. . D STATUSTEXT^MAGDSTQ8(.A)
. . F K=1:1:A(0) W:K>1 ! W A(K)
. . W:K>1 ! ; so that the last line isn't erased
. . Q
. ;
. I STATUS'="Pending" D ; update counts when completed
. . I FAILED S COUNT("FAILED")=$G(COUNT("FAILED"),0)+FAILED
. . I WARNING S COUNT("WARNING")=$G(COUNT("WARNING"),0)+WARNING
. . Q
. ;
. I STATUS="Pending" Q
. S COUNT("RETRIEVED")=$G(COUNT("RETRIEVED"),0)+COMPLETED
. ;
. D STATS
. Q
L -^MAGDRMON ; signal that the monitor is no longer running
D CONTINUE^MAGDSTQ
Q
;
HEADING ; display heading
N C,I,L,TAB
S X="Real-Time Automatic Retrieve Monitor"
S L=$L(X),TAB=(IOM-L)/2
W ?TAB,X,!?TAB F I=1:1:L W "-"
Q
;
STATS ;
W ?34
W "Total Retrieved: ",$G(COUNT("RETRIEVED"),0)
W " Fail:",$G(COUNT("FAILED"),0)
W " Warn:",$G(COUNT("WARNING"),0)
Q
;
DAYTIME(NOW) ;
N DAY,DH,TIME,X
I NOW="" Q ""
S DH=$$FMTH^XLFDT(NOW)
S TIME=$P(NOW,".",2)_"000000"
S TIME=$E(TIME,1,2)_":"_$E(TIME,3,4)_":"_$E(TIME,5,6)
S DAY=$P("Thu^Fri^Sat^Sun^Mon^Tue^Wed","^",DH#7+1)
Q DAY_" "_TIME
;
IDLE(I,DONE) ; output idle ; P333 PMK 08/04/2025
N X
S I=I+1 S:I<1 I=1 S:I>4 I=1 W ?78,$E("-\|/",I),$C(8)
R X:1
I X="^" S DONE=1
Q
;
ENABLED() ; check if monitor is active - P333 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[HMAGDSTAG 4110 printed Mar 25, 2026@15:26:28 Page 2
MAGDSTAG ;WOIFO/PMK - Study Tracker - Automatic Retrieve Monitor; Aug 04, 2025@12:34:57
+1 ;;3.0;IMAGING;**333**;Mar 19, 2002;Build 2
+2 ;; Per VA Directive 6402, 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 ;; | |
+7 ;; | The Food and Drug Administration classifies this software as |
+8 ;; | a medical device. As such, it may not be changed in any way. |
+9 ;; | Modifications to this software may result in an adulterated |
+10 ;; | medical device under 21CFR820, the use of which is considered |
+11 ;; | to be a violation of US Federal Statutes. |
+12 ;; +---------------------------------------------------------------+
+13 ;;
+14 ;
+15 ;
+16 ; Supported IA #10103 reference $$HTE^XLFDT function call
+17 ;
+18 ; Display Automatic Retrieve Status - similar to MAGDSTQ8
+19 ;
+20 QUIT
+21 ;
ENTRY ; Display Automatic Retrieve Status
+1 NEW A,ACNUMB,BADTAGS,BADUIDS,COMMENT,COMPLETED,COUNT,DONE
+2 NEW ERRORID,FAILED,HOSTNAME,I,IDLE,J,K,MAGXTMP,MEANING,QRSCP
+3 NEW REDISPLAY,REMAINING,STATE,STATUS,STATUSCODE,TIMESTAMP,WARNING,X
+4 ;
+5 ; signal that the monitor is running
LOCK +^MAGDRMON:0
IF '$TEST
Begin DoDot:1
+6 WRITE !!,"The Automatic Retrieval Monitor is already running"
+7 DO CONTINUE^MAGDSTQ
+8 QUIT
End DoDot:1
QUIT
+9 ;
+10 SET HOSTNAME=$$HOSTNAME^MAGDFCNV
+11 SET MAGXTMP=$$INITXTMP^MAGDSTQ0
+12 IF $DATA(^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS"))
Begin DoDot:1
+13 IF $$YESNO^MAGDSTQ("Initialize the log?","No",.X)<0
QUIT
+14 IF X="YES"
KILL ^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS")
+15 QUIT
End DoDot:1
+16 ;
+17 WRITE @IOF
READ !!,"Use caret (""^"") to exit. Press <Enter> to begin...",X:DTIME
+18 WRITE @IOF
DO HEADING
+19 SET (DONE,IDLE)=0
+20 SET I=0
FOR
Begin DoDot:1
+21 SET J=$ORDER(^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",I))
+22 IF J=""
Begin DoDot:2
+23 ; P333 PMK 08/04/2025
DO IDLE(.IDLE,.DONE)
+24 QUIT
End DoDot:2
QUIT
+25 SET I=J
+26 SET X=^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",I)
+27 SET ACNUMB=$PIECE(X,"|",1)
+28 ; align remaining pieces with ^MAGDSTQ8
SET X=$PIECE(X,"|",2,999)
+29 SET STATUSCODE=$$PARSE^MAGDSTQ8(X)
+30 ;
+31 ; informational message
IF STATUSCODE=""
Begin DoDot:2
+32 IF STATE?1"Building".E
Begin DoDot:3
+33 IF $Y>(IOSL-4)
Begin DoDot:4
+34 SET $Y=0
WRITE !!
+35 DO HEADING
+36 QUIT
End DoDot:4
+37 QUIT
End DoDot:3
QUIT
+38 IF STATE?1"Sending".E
Begin DoDot:3
+39 SET QRSCP=$PIECE(STATE,"""",2)
+40 WRITE !!,$$DAYTIME(TIMESTAMP)," ",ACNUMB,?34,"Sent from ",QRSCP,!
+41 QUIT
End DoDot:3
+42 QUIT
End DoDot:2
QUIT
+43 ;
+44 ; erase the line
FOR
if $X=0
QUIT
WRITE @IOBS," ",@IOBS
+45 SET STATUS=$$STATUS^MAGDSTQ8(STATUSCODE,.MEANING)
+46 IF STATUS="Success"
Begin DoDot:2
+47 IF COMPLETED=0
WRITE "No DICOM objects were retrieved"
+48 IF '$TEST
WRITE "DICOM objects retrieved: ",COMPLETED
+49 QUIT
End DoDot:2
+50 IF '$TEST
Begin DoDot:2
+51 DO STATUSTEXT^MAGDSTQ8(.A)
+52 FOR K=1:1:A(0)
if K>1
WRITE !
WRITE A(K)
+53 ; so that the last line isn't erased
if K>1
WRITE !
+54 QUIT
End DoDot:2
+55 ;
+56 ; update counts when completed
IF STATUS'="Pending"
Begin DoDot:2
+57 IF FAILED
SET COUNT("FAILED")=$GET(COUNT("FAILED"),0)+FAILED
+58 IF WARNING
SET COUNT("WARNING")=$GET(COUNT("WARNING"),0)+WARNING
+59 QUIT
End DoDot:2
+60 ;
+61 IF STATUS="Pending"
QUIT
+62 SET COUNT("RETRIEVED")=$GET(COUNT("RETRIEVED"),0)+COMPLETED
+63 ;
+64 DO STATS
+65 QUIT
End DoDot:1
if DONE
QUIT
+66 ; signal that the monitor is no longer running
LOCK -^MAGDRMON
+67 DO CONTINUE^MAGDSTQ
+68 QUIT
+69 ;
HEADING ; display heading
+1 NEW C,I,L,TAB
+2 SET X="Real-Time Automatic Retrieve Monitor"
+3 SET L=$LENGTH(X)
SET TAB=(IOM-L)/2
+4 WRITE ?TAB,X,!?TAB
FOR I=1:1:L
WRITE "-"
+5 QUIT
+6 ;
STATS ;
+1 WRITE ?34
+2 WRITE "Total Retrieved: ",$GET(COUNT("RETRIEVED"),0)
+3 WRITE " Fail:",$GET(COUNT("FAILED"),0)
+4 WRITE " Warn:",$GET(COUNT("WARNING"),0)
+5 QUIT
+6 ;
DAYTIME(NOW) ;
+1 NEW DAY,DH,TIME,X
+2 IF NOW=""
QUIT ""
+3 SET DH=$$FMTH^XLFDT(NOW)
+4 SET TIME=$PIECE(NOW,".",2)_"000000"
+5 SET TIME=$EXTRACT(TIME,1,2)_":"_$EXTRACT(TIME,3,4)_":"_$EXTRACT(TIME,5,6)
+6 SET DAY=$PIECE("Thu^Fri^Sat^Sun^Mon^Tue^Wed","^",DH#7+1)
+7 QUIT DAY_" "_TIME
+8 ;
IDLE(I,DONE) ; output idle ; P333 PMK 08/04/2025
+1 NEW X
+2 SET I=I+1
if I<1
SET I=1
if I>4
SET I=1
WRITE ?78,$EXTRACT("-\|/",I),$CHAR(8)
+3 READ X:1
+4 IF X="^"
SET DONE=1
+5 QUIT
+6 ;
ENABLED() ; check if monitor is active - P333 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
