MAGUF ;WOIFO/MLH - file utility routine ; 31 Dec 2009 5:53 PM
;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
NEARFMT(IMAGE,EXT) ; FUNCTION - return code for the format that's nearest
; This function lets the user know whether the nearest accessible version
; of the file associated with this image IEN is the magnetic or WORM
; version, or whether the image is stored offline.
;
; input: IMAGE file name or internal entry number on IMAGE File (#2005)
; EXT what file type is desired (ABS, BIG, FULL, or TXT)
;
; function return: code for nearest accessible version
; M = magnetic
; W = WORM
; O = offline
; I = invalid image number / no record found
; A = Image has been deleted / in archive file (#2005.1)
;
N NEARCOD ; -- function return code for the nearest accessible version
N IEN,TYPE,FILNAM,EXT,REC0,RECBIG
;
S IEN="",NEARCOD="I" ; assume not valid
I IMAGE'?1N.N D Q:('IEN)!(NEARCOD="A") NEARCOD
. S FILNAM=$P(IMAGE,".") Q:FILNAM=""
. I $D(^MAG(2005.1,"F",FILNAM)) S NEARCOD="A" Q
. Q:'$D(^MAG(2005,"F",FILNAM))
. S IEN=$O(^MAG(2005,"F",FILNAM,""))
. Q
E S IEN=IMAGE
I $D(^MAG(2005.1,IEN)) S NEARCOD="A" Q NEARCOD
S EXT=$S($D(EXT):EXT,$P($G(IMAGE),".",2):$P($G(IMAGE),".",2),1:"FULL")
I $$PATCH^XPDUTL("MAG*3.0*39") S TYPE=$$FTYPE^MAGQBPRG(EXT,IEN) ;post P39
E S TYPE=$$FTYPE^MAGQBPRG(EXT) ;pre P39
D ;find applicable case, if any, and break
. ; is the file on the OFFLINE IMAGES File?
. N FNFULL ; -- full file name
. S FNFULL=$P($G(^MAG(2005,IEN,0)),"^",2)
. I FNFULL'="",$D(^MAGQUEUE(2006.033,"B",FNFULL)) S NEARCOD="O" Q
. ; no, search for network location by file extension
. I TYPE="ABS" D Q ;ABS has no independent worm reference
. . S REC0=$G(^MAG(2005,IEN,0))
. . I REC0="" S NEARCOD="I" Q
. . I $P($G(^MAG(2005.2,+$P(REC0,"^",4),0)),"^",6) S NEARCOD="M" Q
. . I $P($G(^MAG(2005.2,+$P(REC0,"^",5),0)),"^",6) S NEARCOD="W" Q
. . S NEARCOD="O" Q
. I (TYPE="FULL")!(TYPE="TXT") D Q ;txt has no independent reference
. . S REC0=$G(^MAG(2005,IEN,0))
. . I REC0="" S NEARCOD="I" Q
. . I $P($G(^MAG(2005.2,+$P(REC0,"^",3),0)),"^",6) S NEARCOD="M" Q
. . I $P($G(^MAG(2005.2,+$P(REC0,"^",5),0)),"^",6) S NEARCOD="W" Q
. . S NEARCOD="O" Q
. I TYPE="BIG" D Q
. . S RECBIG=$G(^MAG(2005,IEN,"FBIG"))
. . I RECBIG="" S NEARCOD="I" Q
. . I $P($G(^MAG(2005.2,+$P(RECBIG,"^",1),0)),"^",6) S NEARCOD="M" Q
. . I $P($G(^MAG(2005.2,+$P(RECBIG,"^",2),0)),"^",6) S NEARCOD="W" Q
. . S NEARCOD="O" Q
. Q
Q NEARCOD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUF 3668 printed Apr 09, 2024@21:08:17 Page 2
MAGUF ;WOIFO/MLH - file utility routine ; 31 Dec 2009 5:53 PM
+1 ;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
+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 QUIT
+18 ;
NEARFMT(IMAGE,EXT) ; FUNCTION - return code for the format that's nearest
+1 ; This function lets the user know whether the nearest accessible version
+2 ; of the file associated with this image IEN is the magnetic or WORM
+3 ; version, or whether the image is stored offline.
+4 ;
+5 ; input: IMAGE file name or internal entry number on IMAGE File (#2005)
+6 ; EXT what file type is desired (ABS, BIG, FULL, or TXT)
+7 ;
+8 ; function return: code for nearest accessible version
+9 ; M = magnetic
+10 ; W = WORM
+11 ; O = offline
+12 ; I = invalid image number / no record found
+13 ; A = Image has been deleted / in archive file (#2005.1)
+14 ;
+15 ; -- function return code for the nearest accessible version
NEW NEARCOD
+16 NEW IEN,TYPE,FILNAM,EXT,REC0,RECBIG
+17 ;
+18 ; assume not valid
SET IEN=""
SET NEARCOD="I"
+19 IF IMAGE'?1N.N
Begin DoDot:1
+20 SET FILNAM=$PIECE(IMAGE,".")
if FILNAM=""
QUIT
+21 IF $DATA(^MAG(2005.1,"F",FILNAM))
SET NEARCOD="A"
QUIT
+22 if '$DATA(^MAG(2005,"F",FILNAM))
QUIT
+23 SET IEN=$ORDER(^MAG(2005,"F",FILNAM,""))
+24 QUIT
End DoDot:1
if ('IEN)!(NEARCOD="A")
QUIT NEARCOD
+25 IF '$TEST
SET IEN=IMAGE
+26 IF $DATA(^MAG(2005.1,IEN))
SET NEARCOD="A"
QUIT NEARCOD
+27 SET EXT=$SELECT($DATA(EXT):EXT,$PIECE($GET(IMAGE),".",2):$PIECE($GET(IMAGE),".",2),1:"FULL")
+28 ;post P39
IF $$PATCH^XPDUTL("MAG*3.0*39")
SET TYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
+29 ;pre P39
IF '$TEST
SET TYPE=$$FTYPE^MAGQBPRG(EXT)
+30 ;find applicable case, if any, and break
Begin DoDot:1
+31 ; is the file on the OFFLINE IMAGES File?
+32 ; -- full file name
NEW FNFULL
+33 SET FNFULL=$PIECE($GET(^MAG(2005,IEN,0)),"^",2)
+34 IF FNFULL'=""
IF $DATA(^MAGQUEUE(2006.033,"B",FNFULL))
SET NEARCOD="O"
QUIT
+35 ; no, search for network location by file extension
+36 ;ABS has no independent worm reference
IF TYPE="ABS"
Begin DoDot:2
+37 SET REC0=$GET(^MAG(2005,IEN,0))
+38 IF REC0=""
SET NEARCOD="I"
QUIT
+39 IF $PIECE($GET(^MAG(2005.2,+$PIECE(REC0,"^",4),0)),"^",6)
SET NEARCOD="M"
QUIT
+40 IF $PIECE($GET(^MAG(2005.2,+$PIECE(REC0,"^",5),0)),"^",6)
SET NEARCOD="W"
QUIT
+41 SET NEARCOD="O"
QUIT
End DoDot:2
QUIT
+42 ;txt has no independent reference
IF (TYPE="FULL")!(TYPE="TXT")
Begin DoDot:2
+43 SET REC0=$GET(^MAG(2005,IEN,0))
+44 IF REC0=""
SET NEARCOD="I"
QUIT
+45 IF $PIECE($GET(^MAG(2005.2,+$PIECE(REC0,"^",3),0)),"^",6)
SET NEARCOD="M"
QUIT
+46 IF $PIECE($GET(^MAG(2005.2,+$PIECE(REC0,"^",5),0)),"^",6)
SET NEARCOD="W"
QUIT
+47 SET NEARCOD="O"
QUIT
End DoDot:2
QUIT
+48 IF TYPE="BIG"
Begin DoDot:2
+49 SET RECBIG=$GET(^MAG(2005,IEN,"FBIG"))
+50 IF RECBIG=""
SET NEARCOD="I"
QUIT
+51 IF $PIECE($GET(^MAG(2005.2,+$PIECE(RECBIG,"^",1),0)),"^",6)
SET NEARCOD="M"
QUIT
+52 IF $PIECE($GET(^MAG(2005.2,+$PIECE(RECBIG,"^",2),0)),"^",6)
SET NEARCOD="W"
QUIT
+53 SET NEARCOD="O"
QUIT
End DoDot:2
QUIT
+54 QUIT
End DoDot:1
+55 QUIT NEARCOD
