- 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 Feb 18, 2025@23:35:24 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
