Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDRPCF

MAGDRPCF.m

Go to the documentation of this file.
  1. MAGDRPCF ;WOIFO/PMK - Imaging RPCs ; Feb 15, 2022@10:34:46
  1. ;;3.0;IMAGING;**305**;Mar 19, 2002;Build 3
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ;; Supported IA #2056 reference $$GET1^DIQ function call
  1. ;; Supported IA #10090 to read with Fileman the INSTITUTION file (#4)
  1. ;;
  1. Q
  1. ;
  1. STATE(OUT) ; RPC = MAG DICOM EXPORT QUEUE STATE
  1. ; get STATE of non-transmitted entries
  1. N ACNUMB,FROMLOC,I,J,NOUT,STATIONNUMBER,STATE,STATEARRAY,X
  1. K OUT
  1. S NOUT=1
  1. S I=0 F S I=$O(^MAGDOUTP(2006.574,I)) Q:'I D
  1. . S J=0 F S J=$O(^MAGDOUTP(2006.574,I,1,J)) Q:'J D
  1. . . S STATE=$P($G(^MAGDOUTP(2006.574,I,1,J,0)),"^",2)
  1. . . I "^SUCCESS^IGNORE^NOT ON FILE^"[("^"_STATE_"^") Q ; exclude processed images
  1. . . ; allow STATE="WAITING", "XMIT", "HOLD", and "FAIL"
  1. . . S STATEARRAY(I,STATE)=$G(STATEARRAY(I,STATE))+1
  1. . . Q
  1. . Q
  1. S I=0 F S I=$O(STATEARRAY(I)) Q:I="" D
  1. . S X=$G(^MAGDOUTP(2006.574,I,0))
  1. . ; update FROM location with STATION NUMBER
  1. . S FROMLOC=$P(X,"^",4)
  1. . S STATIONNUMBER=$$GET1^DIQ(4,FROMLOC,99,"E")
  1. . S $P(X,"^",4)=STATIONNUMBER
  1. . ;
  1. . S NOUT=NOUT+1
  1. . S OUT(NOUT)=$G(^MAGDOUTP(2006.574,I,0))_"^"_I ; index is last piece
  1. . S STATE="" F S STATE=$O(STATEARRAY(I,STATE)) Q:STATE="" D
  1. . . S NOUT=NOUT+1
  1. . . S OUT(NOUT)="^"_STATE_"^"_STATEARRAY(I,STATE)
  1. . . Q
  1. . Q
  1. S OUT(1)=NOUT-1
  1. Q
  1. ;
  1. HOLDREL(OUT,STUDYIEN,NEWSTATE) ; RPC = MAG DICOM EXPORT QUEUE HOLD
  1. N COUNT,IMAGEIELOCATION,IMAGEIEN,PRIORITY,OLDSTATE,X
  1. K OUT
  1. I $G(STUDYIEN)="" D Q
  1. . S OUT(1)="-1,^MAGDOUTP(2006.574,...) STUDYIEN must be the first input parameter"
  1. . Q
  1. I '$D(^MAGDOUTP(2006.574,STUDYIEN)) D Q
  1. . S OUT(1)="-2,^MAGDOUTP(2006.574,...) STUDYIEN """_STUDYIEN_""" is not in the export queue"
  1. . Q
  1. I $G(NEWSTATE)="" D Q
  1. . S OUT(1)="-3,NEWSTATE must be the second input parameter"
  1. . Q
  1. I NEWSTATE'="HOLD",NEWSTATE'="RELEASE",NEWSTATE'="RETRY" D Q
  1. . S OUT(1)="-4,NEWSTATE must be either HOLD, RELEASE, or RETRY"
  1. .
  1. S X=^MAGDOUTP(2006.574,STUDYIEN,0)
  1. S LOCATION=$P(X,"^",4),PRIORITY=$P(X,"^",5)
  1. ;
  1. S NEWSTATE=$S(NEWSTATE="HOLD":"HOLD",1:"WAITING")
  1. ;
  1. S NOUT=1,COUNT=0
  1. L +^MAGDOUTP(2006.574):1E9
  1. S IMAGEIEN=0 F S IMAGEIEN=$O(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN)) Q:'IMAGEIEN D
  1. . S OLDSTATE=($P(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",2))
  1. . I OLDSTATE="SUCCESS" Q
  1. . S $P(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",2)=NEWSTATE
  1. . S $P(^MAGDOUTP(2006.574,STUDYIEN,1,IMAGEIEN,0),"^",3)=$H
  1. . K ^MAGDOUTP(2006.574,"STATE",LOCATION,PRIORITY,OLDSTATE,STUDYIEN,IMAGEIEN)
  1. . S ^MAGDOUTP(2006.574,"STATE",LOCATION,PRIORITY,NEWSTATE,STUDYIEN,IMAGEIEN)=""
  1. . S COUNT=COUNT+1
  1. . Q
  1. L -^MAGDOUTP(2006.574)
  1. ;
  1. S NOUT=NOUT+1,OUT(NOUT)="Number of updated DICOM object entries: "_COUNT
  1. S OUT(1)=NOUT-1
  1. Q
  1. ;
  1. RETRY ; Entry point from option driver
  1. N FAILTIME,MAGERR,MAGFDA,SITE,XMITTIME
  1. ;
  1. W !!!,?7,"--- UPDATE THE RETRY TIMES FOR EXPORTING DICOM IMAGES ---"
  1. ;
  1. S SITE=$O(^MAG(2006.1,"B",DUZ(2),""))
  1. S XMITTIME=$$GET1^DIQ(2006.1,SITE,208)
  1. S FAILTIME=$$GET1^DIQ(2006.1,SITE,209)
  1. ;
  1. S XMITTIME=$$RETRY1("XMIT",XMITTIME,0) ; XMIT is disabled by default
  1. S FAILTIME=$$RETRY1("FAIL",FAILTIME,300) ; default for FAIL is 5 minutes
  1. ;
  1. S SITE=SITE_","
  1. S MAGFDA(2006.1,SITE,208)=XMITTIME
  1. S MAGFDA(2006.1,SITE,209)=FAILTIME
  1. D UPDATE^DIE("","MAGFDA",,"MAGERR")
  1. Q
  1. ;
  1. RETRY1(STATE,ORIGINALVALUE,DEFAULTVALUE) ; function for Retry option
  1. N DEFAULT,DONE
  1. S DEFAULT=ORIGINALVALUE I DEFAULT="" S DEFAULT=DEFAULTVALUE
  1. S DONE=0
  1. F D Q:DONE
  1. . W !!,"Enter time to retry exporting an image in the ",STATE," STATE: //",DEFAULT
  1. . R " ",X:DTIME E S X="^"
  1. . I X="" S X=DEFAULT W X
  1. . I X["^" S DONE=-1 Q
  1. . I X["?" D
  1. . . W !!,"Enter the number of seconds to retry transmitting an image with the ",STATE," state."
  1. . . W !,"Entering zero (0) will cause the retry process to be disabled."
  1. . . W !,"The default value is ",DEFAULT," seconds. The minimum time is 60 seconds."
  1. . . Q
  1. . I X="@" W !,"-- Removing ",STATE," DICOM export site parameter --" S DONE=1 Q
  1. . I X'?1N.N W " ???" Q
  1. . I 'X W !,"-- Disabling retrying export of an image in the ",STATE," state --"
  1. . E I X<60 W " ???",!," -- Minimum time is 60 seconds --" Q
  1. . S DONE=1
  1. . Q
  1. Q X