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