- MAGFILEB ;WOIFO/RED - CREATE FILE REFERENCE FROM ^MAG(2005) ; 10/22/2002 06:39
- ;;3.0;IMAGING;**8,48,39**;Mar 19, 2002;Build 2010;Mar 08, 2011
- ;; 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
- ; CALL WITH MAGXX=IEN NUMBER IN IMAGE FILE (2005)
- ;Calling FINDFILE requires FILETYPE to be defined ["FULL"|"ABSTRACT"|"BIG"|"TEXT"]
- ; returns :
- ; ..MAGFILE1 = FILENAME ONLY
- ; ..MAGFILE1(.01)= .01 FIELD OF FILE (2005)
- ; ..MAGFILE1("ERROR") = Message if NetWork device is offline and Image Not On JB
- ; ..MAGINST = Pointer to Institution File (Consolidated)
- ; .. OR IEN of Imaging Site Parameters only entry (Non-Consolidated)
- ; ..MAGJBOL = NULL("") OR " ** "_Name of Platter that is Offline"_" ** "
- ; ..MAGOFFLN = NULL("") OR "1" "1" means image is on platter that is offline.
- ; ..MAGPLACE = PLACE of Image. (IEN of IMAGING SITE PARAMETERS FILE)
- ; .. Determined from Network Location file
- ; ..MAGPREF = Full Path of Image Network (or Jukebox) Directory
- ;
- ;Calling other TAGS (VST,VSTNOCP,ABS,ABSNOCP,BIG,BIGNOCP,FULL,ABSTRACT,BIGFILE)
- ; return all of above and :
- ; ..MAGFILE = FILE NAME WITH FULL PATH FOLLOWED BY $C(0)
- ; ..MAGFILE2 = FILE NAME WITH FULL PATH W/O $C(0)
- ; .. Deletes MAGXX
- ; .. Does not Return MAGPREF
- ; Modified to handle hierarchical directory hash 4/23/98 -- PMK
- ;
- Q
- VST ; Entry point to get a full size image with copying from JB to MAG DISK
- N MAGPREF,MAGJBCP S MAGJBCP=1 G FULL
- ;
- VSTNOCP ; Entry point to get a full size image without copying it from the JB
- N MAGPREF,MAGJBCP S MAGJBCP=0 G FULL
- ;
- ABS ; Entry point to get an image abstract with copying from JB to MAG DISK
- N MAGPREF,MAGJBCP S MAGJBCP=1 G ABSTRACT
- ;
- ABSNOCP ; Entry point to get an image abstract without copying it from the JB
- N MAGPREF,MAGJBCP S MAGJBCP=0 G ABSTRACT
- ;
- BIG ; Entry point to get a big file with copying from JB to MAG DISK
- N MAGPREF,MAGJBCP S MAGJBCP=1 G BIGFILE
- ;
- BIGNOCP ; Entry point to get a big without copying it from the JB
- N MAGPREF,MAGJBCP S MAGJBCP=0 G BIGFILE
- ;
- FULL N FILETYPE,MAGTYPE S FILETYPE="FULL" D FINDFILE G EXIT
- ;
- ABSTRACT N FILETYPE,MAGTYPE S FILETYPE="ABSTRACT" D FINDFILE G EXIT
- ;
- BIGFILE N FILETYPE,MAGTYPE S FILETYPE="BIG" D FINDFILE G EXIT
- ;
- EXIT S MAGPREF=$G(MAGPREF)
- S MAGFILE2=MAGPREF_MAGFILE1,MAGFILE=MAGFILE2_$C(0)
- K MAGXX Q
- ;
- FINDFILE ;
- N MAG0,MAGERR,MAGREF,MAGSTORE,CNDBMP
- K MAGPREF,MAGFILE1("ERROR") S (MAGJBOL,MAGERR,MAGTYPE,MAGOFFLN,MAGREF)=""
- I '$D(^MAG(2005,+MAGXX,0)) S MAGFILE1="-13,Image "_MAGXX_" is deleted",MAGERR=1 Q
- S MAG0=^MAG(2005,+MAGXX,0),MAGFILE1=$P(MAG0,"^",2)
- S MAGFILE1(.01)=$P(MAG0,"^") ; for MAILMAN interface
- S MAGFILE1=$P(MAGFILE1,"\",$L(MAGFILE1,"\"))
- ;
- I FILETYPE="TEXT" S FILETYPE="FULL" S $P(MAGFILE1,".",2)="TXT"
- ;
- I FILETYPE="FULL" D ; code for full size image
- . S MAGREF=$P(MAG0,"^",3)
- . I MAGREF="" S MAGJB=1,MAGREF=$P(MAG0,"^",5) ; get file from jukebox
- . Q
- ;
- I FILETYPE="ABSTRACT" D Q:MAGERR ; code for abstract
- . ; gek 8/26/02 not sending full as the abstract for Documents.
- . ; If Abs doesn't exist for Document (TIF) we'll Queue it. (don't know if it's on JB)
- . S MAGREF=$P(MAG0,"^",4)
- . I (MAGREF="") D Q:MAGERR
- . . D RSLVABS^MAGGTU3(MAGXX,.CNDBMP)
- . . I $L(CNDBMP) S MAGFILE1=CNDBMP,MAGERR=1 Q
- . . S MAGJB=1,MAGREF=$P(MAG0,"^",5) ; get file from jukebox
- . . ;Patch 48 stop queing abstracts.
- . . ;I $P(MAG0,"^",6)=15 S X=$$ABSTRACT^MAGBAPI(+MAGXX)
- . . Q
- . S $P(MAGFILE1,".",2)="ABS"
- . Q
- ;
- I FILETYPE="BIG" D Q:MAGERR ; code for big file
- . N EXT,FBIG ;
- . S FBIG=$G(^MAG(2005,MAGXX,"FBIG"))
- . I FBIG="" D Q ; no big file exists
- . . S MAGPREF="",MAGFILE1="-1~BIG File Does NOT Exist",MAGERR=1
- . . Q
- . S EXT=$P(FBIG,"^",3) I EXT="" S EXT="BIG"
- . S $P(MAGFILE1,".",2)=EXT
- . S MAGREF=$P(FBIG,"^") ; get file from magnetic disk, if possible
- . I MAGREF="" S MAGREF=$P(FBIG,"^",2) ; get file from jukebox
- . Q
- ;
- I MAGREF="" D Q ;NO NETWORK LOCATION
- . S MAGFILE1="-1~NO NETWORK OR JUKEBOX LOCATION DEFINED"
- ;
- I '$D(^MAG(2005.2,MAGREF,0)) D Q ; BAD POINTER
- . S MAGFILE1="-1~INVALID NETWORK LOCATION POINTER ->"_MAGREF
- ;
- S MAGSTORE=^MAG(2005.2,MAGREF,0),MAGTYPE=$P(MAGSTORE,"^",7)
- I MAGTYPE="" S MAGTYPE=$E(MAGSTORE,1,4) ; in case the type is null
- ;
- S MAGERR=""
- I '$P(MAGSTORE,"^",6) D Q:MAGERR ; the network device is off-line
- . I MAGTYPE["MAG" D Q:MAGERR ; get the jukebox device
- . . S MAGSTORE=$P(MAG0,"^",5)
- . . I 'MAGSTORE D NOWHERE S MAGERR=1 Q ;big trouble:nowhere on jbox
- . . S MAGSTORE=^MAG(2005.2,MAGSTORE,0) ; get the file from the jbox
- . . Q
- . I '$P(MAGSTORE,"^",6) D OFFLINE S MAGERR=1 Q ;jbox cartridge offline
- . S MAGREF=$P(MAG0,"^",5)
- . Q
- ;
- S MAGPREF=""
- I MAGTYPE["MAG" S MAGPREF=$P(MAGSTORE,"^",2)
- ;
- I MAGTYPE?1"WORM".E D ; code for Jukeboxes
- . I MAGTYPE=("WORM-OTG") S MAGPREF=$P(MAGSTORE,"^",2)
- . E I MAGTYPE="WORM-PDT" S MAGPREF=$P(MAGSTORE,"^",2)
- . E I MAGTYPE["WORM-DG" D ; this code is for DG/SONY jukebox
- . . N SUBDIR ; the subdirectory is the last two digits of the file name
- . . S SUBDIR=$P(MAGFILE1,".")
- . . S SUBDIR=$E(100+$E(SUBDIR,$L(SUBDIR)-1,999),2,3)_"\"
- . . S MAGPREF=$P(MAGSTORE,"^",2)_SUBDIR
- . . Q
- . ; The following is for tracking offline images
- . I $$IMOFFLN(MAGFILE1) S MAGOFFLN=1
- . I MAGJBCP D ; add the image to the JukeBox TO Hard Disk copy queue
- . . S X=$$JBTOHD^MAGBAPI(MAGXX_"^"_FILETYPE,$$GET1^DIQ(2005.2,MAGREF,.04,"I")) ; DBI - SEB Patch 4
- . . Q
- . Q
- ;
- S MAGPREF=MAGPREF_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)
- ;
- Q
- ;
- DIRHASH(FILENAME,NETLOCN) ; determine the hierarchical file directory hash
- ;
- ; Input Variables:
- ; FILENAME -- the name of the file, with or without the extension
- ; NETLOCN --- the network location file internal entry number
- ; Return Value: the hierarchical file directory hash
- ;
- N FN,HASHFLAG,HASH,I
- S HASHFLAG=$P(^MAG(2005.2,NETLOCN,0),"^",8)
- I HASHFLAG="Y" D ; calculate the hierarchical directory hash
- . ; for an 8.3 filename AB123456.XYZ, the directory hash is AB\12\34
- . ; for a 14.3 filename BALT1234567890.XYZ, its BALT\12\34\56\78
- . S FN=$P(FILENAME,".") ; strip off the extension
- . I $L(FN)=8 S HASH=$E(FN,1,2)_"\"_$E(FN,3,4)_"\"_$E(FN,5,6)
- . E S HASH=$E(FN,1,4) F I=5,7,9,11 S HASH=HASH_"\"_$E(FN,I,I+1)
- . S HASH=HASH_"\" ; add the trailing directory separator
- . Q
- E S HASH="" ; flat directory structure, no hierarchical hashing
- Q HASH
- ;
- NOWHERE ; File is not anywhere on the jukebox -- output error message
- ; Requested image file is not on the Jukebox
- S MAGPREF="",MAGFILE1="-1^"_MAGXX_"^^NOWHERE"
- S MAGFILE1("ERROR")="-1~Network device Off-Line and Image not on JukeBox"
- Q
- ;
- OFFLINE ; Jukebox Cartridge is off-line -- output error message
- ; Jukebox Cartridge with image file is off-line."
- S MAGPREF="",MAGFILE1="-1^"_MAGXX_"^"_$P(MAG0,"^",5)_"^OFFLINE"
- Q
- IMOFFLN(FILE) ;Check to see if image is offline (jb platter removed)
- N XX,X,Y
- I '$L(FILE) Q 0
- S X=FILE X ^%ZOSF("UPPERCASE") S FILE=Y
- I $D(^MAGQUEUE(2006.033,"B",FILE)) D Q 1
- . S XX="",XX=$O(^MAGQUEUE(2006.033,"B",FILE,XX))
- . S MAGJBOL=" ** "_$P(^MAGQUEUE(2006.033,XX,0),"^",2)_" **"
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGFILEB 8398 printed Jan 18, 2025@03:03:27 Page 2
- MAGFILEB ;WOIFO/RED - CREATE FILE REFERENCE FROM ^MAG(2005) ; 10/22/2002 06:39
- +1 ;;3.0;IMAGING;**8,48,39**;Mar 19, 2002;Build 2010;Mar 08, 2011
- +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 ; CALL WITH MAGXX=IEN NUMBER IN IMAGE FILE (2005)
- +19 ;Calling FINDFILE requires FILETYPE to be defined ["FULL"|"ABSTRACT"|"BIG"|"TEXT"]
- +20 ; returns :
- +21 ; ..MAGFILE1 = FILENAME ONLY
- +22 ; ..MAGFILE1(.01)= .01 FIELD OF FILE (2005)
- +23 ; ..MAGFILE1("ERROR") = Message if NetWork device is offline and Image Not On JB
- +24 ; ..MAGINST = Pointer to Institution File (Consolidated)
- +25 ; .. OR IEN of Imaging Site Parameters only entry (Non-Consolidated)
- +26 ; ..MAGJBOL = NULL("") OR " ** "_Name of Platter that is Offline"_" ** "
- +27 ; ..MAGOFFLN = NULL("") OR "1" "1" means image is on platter that is offline.
- +28 ; ..MAGPLACE = PLACE of Image. (IEN of IMAGING SITE PARAMETERS FILE)
- +29 ; .. Determined from Network Location file
- +30 ; ..MAGPREF = Full Path of Image Network (or Jukebox) Directory
- +31 ;
- +32 ;Calling other TAGS (VST,VSTNOCP,ABS,ABSNOCP,BIG,BIGNOCP,FULL,ABSTRACT,BIGFILE)
- +33 ; return all of above and :
- +34 ; ..MAGFILE = FILE NAME WITH FULL PATH FOLLOWED BY $C(0)
- +35 ; ..MAGFILE2 = FILE NAME WITH FULL PATH W/O $C(0)
- +36 ; .. Deletes MAGXX
- +37 ; .. Does not Return MAGPREF
- +38 ; Modified to handle hierarchical directory hash 4/23/98 -- PMK
- +39 ;
- +40 QUIT
- VST ; Entry point to get a full size image with copying from JB to MAG DISK
- +1 NEW MAGPREF,MAGJBCP
- SET MAGJBCP=1
- GOTO FULL
- +2 ;
- VSTNOCP ; Entry point to get a full size image without copying it from the JB
- +1 NEW MAGPREF,MAGJBCP
- SET MAGJBCP=0
- GOTO FULL
- +2 ;
- ABS ; Entry point to get an image abstract with copying from JB to MAG DISK
- +1 NEW MAGPREF,MAGJBCP
- SET MAGJBCP=1
- GOTO ABSTRACT
- +2 ;
- ABSNOCP ; Entry point to get an image abstract without copying it from the JB
- +1 NEW MAGPREF,MAGJBCP
- SET MAGJBCP=0
- GOTO ABSTRACT
- +2 ;
- BIG ; Entry point to get a big file with copying from JB to MAG DISK
- +1 NEW MAGPREF,MAGJBCP
- SET MAGJBCP=1
- GOTO BIGFILE
- +2 ;
- BIGNOCP ; Entry point to get a big without copying it from the JB
- +1 NEW MAGPREF,MAGJBCP
- SET MAGJBCP=0
- GOTO BIGFILE
- +2 ;
- FULL NEW FILETYPE,MAGTYPE
- SET FILETYPE="FULL"
- DO FINDFILE
- GOTO EXIT
- +1 ;
- ABSTRACT NEW FILETYPE,MAGTYPE
- SET FILETYPE="ABSTRACT"
- DO FINDFILE
- GOTO EXIT
- +1 ;
- BIGFILE NEW FILETYPE,MAGTYPE
- SET FILETYPE="BIG"
- DO FINDFILE
- GOTO EXIT
- +1 ;
- EXIT SET MAGPREF=$GET(MAGPREF)
- +1 SET MAGFILE2=MAGPREF_MAGFILE1
- SET MAGFILE=MAGFILE2_$CHAR(0)
- +2 KILL MAGXX
- QUIT
- +3 ;
- FINDFILE ;
- +1 NEW MAG0,MAGERR,MAGREF,MAGSTORE,CNDBMP
- +2 KILL MAGPREF,MAGFILE1("ERROR")
- SET (MAGJBOL,MAGERR,MAGTYPE,MAGOFFLN,MAGREF)=""
- +3 IF '$DATA(^MAG(2005,+MAGXX,0))
- SET MAGFILE1="-13,Image "_MAGXX_" is deleted"
- SET MAGERR=1
- QUIT
- +4 SET MAG0=^MAG(2005,+MAGXX,0)
- SET MAGFILE1=$PIECE(MAG0,"^",2)
- +5 ; for MAILMAN interface
- SET MAGFILE1(.01)=$PIECE(MAG0,"^")
- +6 SET MAGFILE1=$PIECE(MAGFILE1,"\",$LENGTH(MAGFILE1,"\"))
- +7 ;
- +8 IF FILETYPE="TEXT"
- SET FILETYPE="FULL"
- SET $PIECE(MAGFILE1,".",2)="TXT"
- +9 ;
- +10 ; code for full size image
- IF FILETYPE="FULL"
- Begin DoDot:1
- +11 SET MAGREF=$PIECE(MAG0,"^",3)
- +12 ; get file from jukebox
- IF MAGREF=""
- SET MAGJB=1
- SET MAGREF=$PIECE(MAG0,"^",5)
- +13 QUIT
- End DoDot:1
- +14 ;
- +15 ; code for abstract
- IF FILETYPE="ABSTRACT"
- Begin DoDot:1
- +16 ; gek 8/26/02 not sending full as the abstract for Documents.
- +17 ; If Abs doesn't exist for Document (TIF) we'll Queue it. (don't know if it's on JB)
- +18 SET MAGREF=$PIECE(MAG0,"^",4)
- +19 IF (MAGREF="")
- Begin DoDot:2
- +20 DO RSLVABS^MAGGTU3(MAGXX,.CNDBMP)
- +21 IF $LENGTH(CNDBMP)
- SET MAGFILE1=CNDBMP
- SET MAGERR=1
- QUIT
- +22 ; get file from jukebox
- SET MAGJB=1
- SET MAGREF=$PIECE(MAG0,"^",5)
- +23 ;Patch 48 stop queing abstracts.
- +24 ;I $P(MAG0,"^",6)=15 S X=$$ABSTRACT^MAGBAPI(+MAGXX)
- +25 QUIT
- End DoDot:2
- if MAGERR
- QUIT
- +26 SET $PIECE(MAGFILE1,".",2)="ABS"
- +27 QUIT
- End DoDot:1
- if MAGERR
- QUIT
- +28 ;
- +29 ; code for big file
- IF FILETYPE="BIG"
- Begin DoDot:1
- +30 ;
- NEW EXT,FBIG
- +31 SET FBIG=$GET(^MAG(2005,MAGXX,"FBIG"))
- +32 ; no big file exists
- IF FBIG=""
- Begin DoDot:2
- +33 SET MAGPREF=""
- SET MAGFILE1="-1~BIG File Does NOT Exist"
- SET MAGERR=1
- +34 QUIT
- End DoDot:2
- QUIT
- +35 SET EXT=$PIECE(FBIG,"^",3)
- IF EXT=""
- SET EXT="BIG"
- +36 SET $PIECE(MAGFILE1,".",2)=EXT
- +37 ; get file from magnetic disk, if possible
- SET MAGREF=$PIECE(FBIG,"^")
- +38 ; get file from jukebox
- IF MAGREF=""
- SET MAGREF=$PIECE(FBIG,"^",2)
- +39 QUIT
- End DoDot:1
- if MAGERR
- QUIT
- +40 ;
- +41 ;NO NETWORK LOCATION
- IF MAGREF=""
- Begin DoDot:1
- +42 SET MAGFILE1="-1~NO NETWORK OR JUKEBOX LOCATION DEFINED"
- End DoDot:1
- QUIT
- +43 ;
- +44 ; BAD POINTER
- IF '$DATA(^MAG(2005.2,MAGREF,0))
- Begin DoDot:1
- +45 SET MAGFILE1="-1~INVALID NETWORK LOCATION POINTER ->"_MAGREF
- End DoDot:1
- QUIT
- +46 ;
- +47 SET MAGSTORE=^MAG(2005.2,MAGREF,0)
- SET MAGTYPE=$PIECE(MAGSTORE,"^",7)
- +48 ; in case the type is null
- IF MAGTYPE=""
- SET MAGTYPE=$EXTRACT(MAGSTORE,1,4)
- +49 ;
- +50 SET MAGERR=""
- +51 ; the network device is off-line
- IF '$PIECE(MAGSTORE,"^",6)
- Begin DoDot:1
- +52 ; get the jukebox device
- IF MAGTYPE["MAG"
- Begin DoDot:2
- +53 SET MAGSTORE=$PIECE(MAG0,"^",5)
- +54 ;big trouble:nowhere on jbox
- IF 'MAGSTORE
- DO NOWHERE
- SET MAGERR=1
- QUIT
- +55 ; get the file from the jbox
- SET MAGSTORE=^MAG(2005.2,MAGSTORE,0)
- +56 QUIT
- End DoDot:2
- if MAGERR
- QUIT
- +57 ;jbox cartridge offline
- IF '$PIECE(MAGSTORE,"^",6)
- DO OFFLINE
- SET MAGERR=1
- QUIT
- +58 SET MAGREF=$PIECE(MAG0,"^",5)
- +59 QUIT
- End DoDot:1
- if MAGERR
- QUIT
- +60 ;
- +61 SET MAGPREF=""
- +62 IF MAGTYPE["MAG"
- SET MAGPREF=$PIECE(MAGSTORE,"^",2)
- +63 ;
- +64 ; code for Jukeboxes
- IF MAGTYPE?1"WORM".E
- Begin DoDot:1
- +65 IF MAGTYPE=("WORM-OTG")
- SET MAGPREF=$PIECE(MAGSTORE,"^",2)
- +66 IF '$TEST
- IF MAGTYPE="WORM-PDT"
- SET MAGPREF=$PIECE(MAGSTORE,"^",2)
- +67 ; this code is for DG/SONY jukebox
- IF '$TEST
- IF MAGTYPE["WORM-DG"
- Begin DoDot:2
- +68 ; the subdirectory is the last two digits of the file name
- NEW SUBDIR
- +69 SET SUBDIR=$PIECE(MAGFILE1,".")
- +70 SET SUBDIR=$EXTRACT(100+$EXTRACT(SUBDIR,$LENGTH(SUBDIR)-1,999),2,3)_"\"
- +71 SET MAGPREF=$PIECE(MAGSTORE,"^",2)_SUBDIR
- +72 QUIT
- End DoDot:2
- +73 ; The following is for tracking offline images
- +74 IF $$IMOFFLN(MAGFILE1)
- SET MAGOFFLN=1
- +75 ; add the image to the JukeBox TO Hard Disk copy queue
- IF MAGJBCP
- Begin DoDot:2
- +76 ; DBI - SEB Patch 4
- SET X=$$JBTOHD^MAGBAPI(MAGXX_"^"_FILETYPE,$$GET1^DIQ(2005.2,MAGREF,.04,"I"))
- +77 QUIT
- End DoDot:2
- +78 QUIT
- End DoDot:1
- +79 ;
- +80 SET MAGPREF=MAGPREF_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)
- +81 ;
- +82 QUIT
- +83 ;
- DIRHASH(FILENAME,NETLOCN) ; determine the hierarchical file directory hash
- +1 ;
- +2 ; Input Variables:
- +3 ; FILENAME -- the name of the file, with or without the extension
- +4 ; NETLOCN --- the network location file internal entry number
- +5 ; Return Value: the hierarchical file directory hash
- +6 ;
- +7 NEW FN,HASHFLAG,HASH,I
- +8 SET HASHFLAG=$PIECE(^MAG(2005.2,NETLOCN,0),"^",8)
- +9 ; calculate the hierarchical directory hash
- IF HASHFLAG="Y"
- Begin DoDot:1
- +10 ; for an 8.3 filename AB123456.XYZ, the directory hash is AB\12\34
- +11 ; for a 14.3 filename BALT1234567890.XYZ, its BALT\12\34\56\78
- +12 ; strip off the extension
- SET FN=$PIECE(FILENAME,".")
- +13 IF $LENGTH(FN)=8
- SET HASH=$EXTRACT(FN,1,2)_"\"_$EXTRACT(FN,3,4)_"\"_$EXTRACT(FN,5,6)
- +14 IF '$TEST
- SET HASH=$EXTRACT(FN,1,4)
- FOR I=5,7,9,11
- SET HASH=HASH_"\"_$EXTRACT(FN,I,I+1)
- +15 ; add the trailing directory separator
- SET HASH=HASH_"\"
- +16 QUIT
- End DoDot:1
- +17 ; flat directory structure, no hierarchical hashing
- IF '$TEST
- SET HASH=""
- +18 QUIT HASH
- +19 ;
- NOWHERE ; File is not anywhere on the jukebox -- output error message
- +1 ; Requested image file is not on the Jukebox
- +2 SET MAGPREF=""
- SET MAGFILE1="-1^"_MAGXX_"^^NOWHERE"
- +3 SET MAGFILE1("ERROR")="-1~Network device Off-Line and Image not on JukeBox"
- +4 QUIT
- +5 ;
- OFFLINE ; Jukebox Cartridge is off-line -- output error message
- +1 ; Jukebox Cartridge with image file is off-line."
- +2 SET MAGPREF=""
- SET MAGFILE1="-1^"_MAGXX_"^"_$PIECE(MAG0,"^",5)_"^OFFLINE"
- +3 QUIT
- IMOFFLN(FILE) ;Check to see if image is offline (jb platter removed)
- +1 NEW XX,X,Y
- +2 IF '$LENGTH(FILE)
- QUIT 0
- +3 SET X=FILE
- XECUTE ^%ZOSF("UPPERCASE")
- SET FILE=Y
- +4 IF $DATA(^MAGQUEUE(2006.033,"B",FILE))
- Begin DoDot:1
- +5 SET XX=""
- SET XX=$ORDER(^MAGQUEUE(2006.033,"B",FILE,XX))
- +6 SET MAGJBOL=" ** "_$PIECE(^MAGQUEUE(2006.033,XX,0),"^",2)_" **"
- End DoDot:1
- QUIT 1
- +7 QUIT 0