MAGDRPCF ;WOIFO/PMK - Imaging RPCs ; Feb 15, 2022@10:34:46
;;3.0;IMAGING;**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 #2056 reference $$GET1^DIQ function call
;; Supported IA #10090 to read with Fileman the INSTITUTION file (#4)
;;
Q
;
STATE(OUT) ; RPC = MAG DICOM EXPORT QUEUE STATE
; get STATE of non-transmitted entries
N ACNUMB,FROMLOC,I,J,NOUT,STATIONNUMBER,STATE,STATEARRAY,X
K OUT
S NOUT=1
S I=0 F S I=$O(^MAGDOUTP(2006.574,I)) Q:'I D
. S J=0 F S J=$O(^MAGDOUTP(2006.574,I,1,J)) Q:'J D
. . S STATE=$P($G(^MAGDOUTP(2006.574,I,1,J,0)),"^",2)
. . I "^SUCCESS^IGNORE^NOT ON FILE^"[("^"_STATE_"^") Q ; exclude processed images
. . ; allow STATE="WAITING", "XMIT", "HOLD", and "FAIL"
. . S STATEARRAY(I,STATE)=$G(STATEARRAY(I,STATE))+1
. . Q
. Q
S I=0 F S I=$O(STATEARRAY(I)) Q:I="" D
. S X=$G(^MAGDOUTP(2006.574,I,0))
. ; update FROM location with STATION NUMBER
. S FROMLOC=$P(X,"^",4)
. S STATIONNUMBER=$$GET1^DIQ(4,FROMLOC,99,"E")
. S $P(X,"^",4)=STATIONNUMBER
. ;
. S NOUT=NOUT+1
. S OUT(NOUT)=$G(^MAGDOUTP(2006.574,I,0))_"^"_I ; index is last piece
. S STATE="" F S STATE=$O(STATEARRAY(I,STATE)) Q:STATE="" D
. . S NOUT=NOUT+1
. . S OUT(NOUT)="^"_STATE_"^"_STATEARRAY(I,STATE)
. . Q
. Q
S OUT(1)=NOUT-1
Q
;
HOLDREL(OUT,STUDYIEN,NEWSTATE) ; RPC = MAG DICOM EXPORT QUEUE HOLD
N COUNT,IMAGEIELOCATION,IMAGEIEN,PRIORITY,OLDSTATE,X
K OUT
I $G(STUDYIEN)="" D Q
. S OUT(1)="-1,^MAGDOUTP(2006.574,...) STUDYIEN must be the first input parameter"
. Q
I '$D(^MAGDOUTP(2006.574,STUDYIEN)) D Q
. S OUT(1)="-2,^MAGDOUTP(2006.574,...) STUDYIEN """_STUDYIEN_""" is not in the export queue"
. Q
I $G(NEWSTATE)="" D Q
. S OUT(1)="-3,NEWSTATE must be the second input parameter"
. Q
I NEWSTATE'="HOLD",NEWSTATE'="RELEASE",NEWSTATE'="RETRY" D Q
. S OUT(1)="-4,NEWSTATE must be either HOLD, RELEASE, or RETRY"
.
S X=^MAGDOUTP(2006.574,STUDYIEN,0)
S LOCATION=$P(X,"^",4),PRIORITY=$P(X,"^",5)
;
S NEWSTATE=$S(NEWSTATE="HOLD":"HOLD",1:"WAITING")
;
S NOUT=1,COUNT=0
L +^MAGDOUTP(2006.574):1E9
S IMAGEIEN=0 F S IMAGEIEN=$O(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN)) Q:'IMAGEIEN D
. S OLDSTATE=($P(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",2))
. I OLDSTATE="SUCCESS" Q
. S $P(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",2)=NEWSTATE
. S $P(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",3)=$H
. K ^MAGDOUTP(2006.574,"STATE",LOCATION,PRIORITY,OLDSTATE,STUDYIEN,IMAGEIEN)
. S ^MAGDOUTP(2006.574,"STATE",LOCATION,PRIORITY,NEWSTATE,STUDYIEN,IMAGEIEN)=""
. S COUNT=COUNT+1
. Q
L -^MAGDOUTP(2006.574)
;
S NOUT=NOUT+1,OUT(NOUT)="Number of updated DICOM object entries: "_COUNT
S OUT(1)=NOUT-1
Q
;
RETRY ; Entry point from option driver
N FAILTIME,MAGERR,MAGFDA,SITE,XMITTIME
;
W !!!,?7,"--- UPDATE THE RETRY TIMES FOR EXPORTING DICOM IMAGES ---"
;
S SITE=$O(^MAG(2006.1,"B",DUZ(2),""))
S XMITTIME=$$GET1^DIQ(2006.1,SITE,208)
S FAILTIME=$$GET1^DIQ(2006.1,SITE,209)
;
S XMITTIME=$$RETRY1("XMIT",XMITTIME,0) ; XMIT is disabled by default
S FAILTIME=$$RETRY1("FAIL",FAILTIME,300) ; default for FAIL is 5 minutes
;
S SITE=SITE_","
S MAGFDA(2006.1,SITE,208)=XMITTIME
S MAGFDA(2006.1,SITE,209)=FAILTIME
D UPDATE^DIE("","MAGFDA",,"MAGERR")
Q
;
RETRY1(STATE,ORIGINALVALUE,DEFAULTVALUE) ; function for Retry option
N DEFAULT,DONE
S DEFAULT=ORIGINALVALUE I DEFAULT="" S DEFAULT=DEFAULTVALUE
S DONE=0
F D Q:DONE
. W !!,"Enter time to retry exporting an image in the ",STATE," STATE: //",DEFAULT
. R " ",X:DTIME E S X="^"
. I X="" S X=DEFAULT W X
. I X["^" S DONE=-1 Q
. I X["?" D
. . W !!,"Enter the number of seconds to retry transmitting an image with the ",STATE," state."
. . W !,"Entering zero (0) will cause the retry process to be disabled."
. . W !,"The default value is ",DEFAULT," seconds. The minimum time is 60 seconds."
. . Q
. I X="@" W !,"-- Removing ",STATE," DICOM export site parameter --" S DONE=1 Q
. I X'?1N.N W " ???" Q
. I 'X W !,"-- Disabling retrying export of an image in the ",STATE," state --"
. E I X<60 W " ???",!," -- Minimum time is 60 seconds --" Q
. S DONE=1
. Q
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRPCF 5207 printed Dec 13, 2024@02:01:34 Page 2
MAGDRPCF ;WOIFO/PMK - Imaging RPCs ; Feb 15, 2022@10:34:46
+1 ;;3.0;IMAGING;**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 ;; Supported IA #2056 reference $$GET1^DIQ function call
+18 ;; Supported IA #10090 to read with Fileman the INSTITUTION file (#4)
+19 ;;
+20 QUIT
+21 ;
STATE(OUT) ; RPC = MAG DICOM EXPORT QUEUE STATE
+1 ; get STATE of non-transmitted entries
+2 NEW ACNUMB,FROMLOC,I,J,NOUT,STATIONNUMBER,STATE,STATEARRAY,X
+3 KILL OUT
+4 SET NOUT=1
+5 SET I=0
FOR
SET I=$ORDER(^MAGDOUTP(2006.574,I))
if 'I
QUIT
Begin DoDot:1
+6 SET J=0
FOR
SET J=$ORDER(^MAGDOUTP(2006.574,I,1,J))
if 'J
QUIT
Begin DoDot:2
+7 SET STATE=$PIECE($GET(^MAGDOUTP(2006.574,I,1,J,0)),"^",2)
+8 ; exclude processed images
IF "^SUCCESS^IGNORE^NOT ON FILE^"[("^"_STATE_"^")
QUIT
+9 ; allow STATE="WAITING", "XMIT", "HOLD", and "FAIL"
+10 SET STATEARRAY(I,STATE)=$GET(STATEARRAY(I,STATE))+1
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 SET I=0
FOR
SET I=$ORDER(STATEARRAY(I))
if I=""
QUIT
Begin DoDot:1
+14 SET X=$GET(^MAGDOUTP(2006.574,I,0))
+15 ; update FROM location with STATION NUMBER
+16 SET FROMLOC=$PIECE(X,"^",4)
+17 SET STATIONNUMBER=$$GET1^DIQ(4,FROMLOC,99,"E")
+18 SET $PIECE(X,"^",4)=STATIONNUMBER
+19 ;
+20 SET NOUT=NOUT+1
+21 ; index is last piece
SET OUT(NOUT)=$GET(^MAGDOUTP(2006.574,I,0))_"^"_I
+22 SET STATE=""
FOR
SET STATE=$ORDER(STATEARRAY(I,STATE))
if STATE=""
QUIT
Begin DoDot:2
+23 SET NOUT=NOUT+1
+24 SET OUT(NOUT)="^"_STATE_"^"_STATEARRAY(I,STATE)
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 SET OUT(1)=NOUT-1
+28 QUIT
+29 ;
HOLDREL(OUT,STUDYIEN,NEWSTATE) ; RPC = MAG DICOM EXPORT QUEUE HOLD
+1 NEW COUNT,IMAGEIELOCATION,IMAGEIEN,PRIORITY,OLDSTATE,X
+2 KILL OUT
+3 IF $GET(STUDYIEN)=""
Begin DoDot:1
+4 SET OUT(1)="-1,^MAGDOUTP(2006.574,...) STUDYIEN must be the first input parameter"
+5 QUIT
End DoDot:1
QUIT
+6 IF '$DATA(^MAGDOUTP(2006.574,STUDYIEN))
Begin DoDot:1
+7 SET OUT(1)="-2,^MAGDOUTP(2006.574,...) STUDYIEN """_STUDYIEN_""" is not in the export queue"
+8 QUIT
End DoDot:1
QUIT
+9 IF $GET(NEWSTATE)=""
Begin DoDot:1
+10 SET OUT(1)="-3,NEWSTATE must be the second input parameter"
+11 QUIT
End DoDot:1
QUIT
+12 IF NEWSTATE'="HOLD"
IF NEWSTATE'="RELEASE"
IF NEWSTATE'="RETRY"
Begin DoDot:1
+13 SET OUT(1)="-4,NEWSTATE must be either HOLD, RELEASE, or RETRY"
+14 End DoDot:1
QUIT
+15 SET X=^MAGDOUTP(2006.574,STUDYIEN,0)
+16 SET LOCATION=$PIECE(X,"^",4)
SET PRIORITY=$PIECE(X,"^",5)
+17 ;
+18 SET NEWSTATE=$SELECT(NEWSTATE="HOLD":"HOLD",1:"WAITING")
+19 ;
+20 SET NOUT=1
SET COUNT=0
+21 LOCK +^MAGDOUTP(2006.574):1E9
+22 SET IMAGEIEN=0
FOR
SET IMAGEIEN=$ORDER(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN))
if 'IMAGEIEN
QUIT
Begin DoDot:1
+23 SET OLDSTATE=($PIECE(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",2))
+24 IF OLDSTATE="SUCCESS"
QUIT
+25 SET $PIECE(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",2)=NEWSTATE
+26 SET $PIECE(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",3)=$HOROLOG
+27 KILL ^MAGDOUTP(2006.574,"STATE",LOCATION,PRIORITY,OLDSTATE,STUDYIEN,IMAGEIEN)
+28 SET ^MAGDOUTP(2006.574,"STATE",LOCATION,PRIORITY,NEWSTATE,STUDYIEN,IMAGEIEN)=""
+29 SET COUNT=COUNT+1
+30 QUIT
End DoDot:1
+31 LOCK -^MAGDOUTP(2006.574)
+32 ;
+33 SET NOUT=NOUT+1
SET OUT(NOUT)="Number of updated DICOM object entries: "_COUNT
+34 SET OUT(1)=NOUT-1
+35 QUIT
+36 ;
RETRY ; Entry point from option driver
+1 NEW FAILTIME,MAGERR,MAGFDA,SITE,XMITTIME
+2 ;
+3 WRITE !!!,?7,"--- UPDATE THE RETRY TIMES FOR EXPORTING DICOM IMAGES ---"
+4 ;
+5 SET SITE=$ORDER(^MAG(2006.1,"B",DUZ(2),""))
+6 SET XMITTIME=$$GET1^DIQ(2006.1,SITE,208)
+7 SET FAILTIME=$$GET1^DIQ(2006.1,SITE,209)
+8 ;
+9 ; XMIT is disabled by default
SET XMITTIME=$$RETRY1("XMIT",XMITTIME,0)
+10 ; default for FAIL is 5 minutes
SET FAILTIME=$$RETRY1("FAIL",FAILTIME,300)
+11 ;
+12 SET SITE=SITE_","
+13 SET MAGFDA(2006.1,SITE,208)=XMITTIME
+14 SET MAGFDA(2006.1,SITE,209)=FAILTIME
+15 DO UPDATE^DIE("","MAGFDA",,"MAGERR")
+16 QUIT
+17 ;
RETRY1(STATE,ORIGINALVALUE,DEFAULTVALUE) ; function for Retry option
+1 NEW DEFAULT,DONE
+2 SET DEFAULT=ORIGINALVALUE
IF DEFAULT=""
SET DEFAULT=DEFAULTVALUE
+3 SET DONE=0
+4 FOR
Begin DoDot:1
+5 WRITE !!,"Enter time to retry exporting an image in the ",STATE," STATE: //",DEFAULT
+6 READ " ",X:DTIME
IF '$TEST
SET X="^"
+7 IF X=""
SET X=DEFAULT
WRITE X
+8 IF X["^"
SET DONE=-1
QUIT
+9 IF X["?"
Begin DoDot:2
+10 WRITE !!,"Enter the number of seconds to retry transmitting an image with the ",STATE," state."
+11 WRITE !,"Entering zero (0) will cause the retry process to be disabled."
+12 WRITE !,"The default value is ",DEFAULT," seconds. The minimum time is 60 seconds."
+13 QUIT
End DoDot:2
+14 IF X="@"
WRITE !,"-- Removing ",STATE," DICOM export site parameter --"
SET DONE=1
QUIT
+15 IF X'?1N.N
WRITE " ???"
QUIT
+16 IF 'X
WRITE !,"-- Disabling retrying export of an image in the ",STATE," state --"
+17 IF '$TEST
IF X<60
WRITE " ???",!," -- Minimum time is 60 seconds --"
QUIT
+18 SET DONE=1
+19 QUIT
End DoDot:1
if DONE
QUIT
+20 QUIT X
