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