MAGD350L ;WOIFO/RED/PMK - CREATE FILE REFERENCE FROM ^MAG(2005) ; Jan 03, 2023@10:37:34
;;3.0;IMAGING;**350**;Mar 19, 2002;Build 4
;; 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. |
;; +---------------------------------------------------------------+
;
; Copied from MAGFILEB and then modified to support TIER-2 lookups
;
Q
; CALL WITH MAGXX=IEN NUMBER IN IMAGE FILE (2005)
;Calling FINDFILE requires FILETYPE to be defined ["FULL"|"ABSTRACT"|"BIG"|"TEXT"]
;P350 ALLOWS FILETYPE to be defined ["FULL TIER-2"|"ABSTRACT TIER-2"|"BIG TIER-2"|"TEXT TIER-2"]
; 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="TEXT TIER-2" S FILETYPE="FULL TIER-2" S $P(MAGFILE1,".",2)="TXT" ; P350 PMK 12/21/2022
;
I FILETYPE="FULL" D ; code for full size image
. S MAGREF=$P(MAG0,"^",3)
. I MAGREF="" S MAGJB=1,MAGREF=$$TIER2LOC ; get file from jukebox
. Q
;
I FILETYPE="FULL TIER-2" D ; code for full size image - P350 PMK 12/21/2022
. S MAGREF=$$TIER2LOC ; get file from TIER-2 storage
. 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=$$TIER2LOC ; 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="ABSTRACT TIER-2" D Q:MAGERR ; code for abstract - P350 PMK 12/21/2022
. S MAGREF=$$TIER2LOC ; get file from TIER-2 storage
. 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 FILETYPE="BIG TIER-2" D Q:MAGERR ; code for big file - P350 PMK 12/21/2022
. 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,"^",2) ; get file from TIER-2 storage
. 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=$$TIER2LOC
. . 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=$$TIER2LOC
. 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 imagQe 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_"^"_$$TIER2LOC_"^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
;
TIER2LOC() ; Get the TIER-2 location for the image entry and set it if null
N IEN,KSITEPAR,TIER2LOC
S TIER2LOC=$P(MAG0,"^",5)
I TIER2LOC="" D
. S KSITEPAR=$$KSP^XUPARAM("INST")
. S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
. S TIER2LOC=$$GET1^DIQ(2006.1,IEN,2.01,"I") ; JUKEBOX WRITE LOCATION
. S $P(^MAG(2005,+MAGXX,0),"^",5)=TIER2LOC ; update TIER-2 location
. S MAG0=^MAG(2005,+MAGXX,0) ; necessary for additional calls
. Q
Q TIER2LOC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGD350L 9821 printed Dec 13, 2024@01:59:40 Page 2
MAGD350L ;WOIFO/RED/PMK - CREATE FILE REFERENCE FROM ^MAG(2005) ; Jan 03, 2023@10:37:34
+1 ;;3.0;IMAGING;**350**;Mar 19, 2002;Build 4
+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 ; Copied from MAGFILEB and then modified to support TIER-2 lookups
+18 ;
+19 QUIT
+20 ; CALL WITH MAGXX=IEN NUMBER IN IMAGE FILE (2005)
+21 ;Calling FINDFILE requires FILETYPE to be defined ["FULL"|"ABSTRACT"|"BIG"|"TEXT"]
+22 ;P350 ALLOWS FILETYPE to be defined ["FULL TIER-2"|"ABSTRACT TIER-2"|"BIG TIER-2"|"TEXT TIER-2"]
+23 ; returns :
+24 ; ..MAGFILE1 = FILENAME ONLY
+25 ; ..MAGFILE1(.01)= .01 FIELD OF FILE (2005)
+26 ; ..MAGFILE1("ERROR") = Message if NetWork device is offline and Image Not On JB
+27 ; ..MAGINST = Pointer to Institution File (Consolidated)
+28 ; .. OR IEN of Imaging Site Parameters only entry (Non-Consolidated)
+29 ; ..MAGJBOL = NULL("") OR " ** "_Name of Platter that is Offline"_" ** "
+30 ; ..MAGOFFLN = NULL("") OR "1" "1" means image is on platter that is offline.
+31 ; ..MAGPLACE = PLACE of Image. (IEN of IMAGING SITE PARAMETERS FILE)
+32 ; .. Determined from Network Location file
+33 ; ..MAGPREF = Full Path of Image Network (or Jukebox) Directory
+34 ;
+35 ;Calling other TAGS (VST,VSTNOCP,ABS,ABSNOCP,BIG,BIGNOCP,FULL,ABSTRACT,BIGFILE)
+36 ; return all of above and :
+37 ; ..MAGFILE = FILE NAME WITH FULL PATH FOLLOWED BY $C(0)
+38 ; ..MAGFILE2 = FILE NAME WITH FULL PATH W/O $C(0)
+39 ; .. Deletes MAGXX
+40 ; .. Does not Return MAGPREF
+41 ; Modified to handle hierarchical directory hash 4/23/98 -- PMK
+42 ;
+43 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 ; P350 PMK 12/21/2022
IF FILETYPE="TEXT TIER-2"
SET FILETYPE="FULL TIER-2"
SET $PIECE(MAGFILE1,".",2)="TXT"
+10 ;
+11 ; code for full size image
IF FILETYPE="FULL"
Begin DoDot:1
+12 SET MAGREF=$PIECE(MAG0,"^",3)
+13 ; get file from jukebox
IF MAGREF=""
SET MAGJB=1
SET MAGREF=$$TIER2LOC
+14 QUIT
End DoDot:1
+15 ;
+16 ; code for full size image - P350 PMK 12/21/2022
IF FILETYPE="FULL TIER-2"
Begin DoDot:1
+17 ; get file from TIER-2 storage
SET MAGREF=$$TIER2LOC
+18 QUIT
End DoDot:1
+19 ;
+20 ; code for abstract
IF FILETYPE="ABSTRACT"
Begin DoDot:1
+21 ; gek 8/26/02 not sending full as the abstract for Documents.
+22 ; If Abs doesn't exist for Document (TIF) we'll Queue it. (don't know if it's on JB)
+23 SET MAGREF=$PIECE(MAG0,"^",4)
+24 IF (MAGREF="")
Begin DoDot:2
+25 DO RSLVABS^MAGGTU3(MAGXX,.CNDBMP)
+26 IF $LENGTH(CNDBMP)
SET MAGFILE1=CNDBMP
SET MAGERR=1
QUIT
+27 ; get file from jukebox
SET MAGJB=1
SET MAGREF=$$TIER2LOC
+28 ;Patch 48 stop queing abstracts.
+29 ;I $P(MAG0,"^",6)=15 S X=$$ABSTRACT^MAGBAPI(+MAGXX)
+30 QUIT
End DoDot:2
if MAGERR
QUIT
+31 SET $PIECE(MAGFILE1,".",2)="ABS"
+32 QUIT
End DoDot:1
if MAGERR
QUIT
+33 ;
+34 ; code for abstract - P350 PMK 12/21/2022
IF FILETYPE="ABSTRACT TIER-2"
Begin DoDot:1
+35 ; get file from TIER-2 storage
SET MAGREF=$$TIER2LOC
+36 SET $PIECE(MAGFILE1,".",2)="ABS"
+37 QUIT
End DoDot:1
if MAGERR
QUIT
+38 ;
+39 ; code for big file
IF FILETYPE="BIG"
Begin DoDot:1
+40 ;
NEW EXT,FBIG
+41 SET FBIG=$GET(^MAG(2005,MAGXX,"FBIG"))
+42 ; no big file exists
IF FBIG=""
Begin DoDot:2
+43 SET MAGPREF=""
SET MAGFILE1="-1~BIG File Does NOT Exist"
SET MAGERR=1
+44 QUIT
End DoDot:2
QUIT
+45 SET EXT=$PIECE(FBIG,"^",3)
IF EXT=""
SET EXT="BIG"
+46 SET $PIECE(MAGFILE1,".",2)=EXT
+47 ; get file from magnetic disk, if possible
SET MAGREF=$PIECE(FBIG,"^")
+48 ; get file from jukebox
IF MAGREF=""
SET MAGREF=$PIECE(FBIG,"^",2)
+49 QUIT
End DoDot:1
if MAGERR
QUIT
+50 ;
+51 ; code for big file - P350 PMK 12/21/2022
IF FILETYPE="BIG TIER-2"
Begin DoDot:1
+52 ;
NEW EXT,FBIG
+53 SET FBIG=$GET(^MAG(2005,MAGXX,"FBIG"))
+54 ; no big file exists
IF FBIG=""
Begin DoDot:2
+55 SET MAGPREF=""
SET MAGFILE1="-1~BIG File Does NOT Exist"
SET MAGERR=1
+56 QUIT
End DoDot:2
QUIT
+57 SET EXT=$PIECE(FBIG,"^",3)
IF EXT=""
SET EXT="BIG"
+58 SET $PIECE(MAGFILE1,".",2)=EXT
+59 ; get file from TIER-2 storage
SET MAGREF=$PIECE(FBIG,"^",2)
+60 QUIT
End DoDot:1
if MAGERR
QUIT
+61 ;
+62 ;NO NETWORK LOCATION
IF MAGREF=""
Begin DoDot:1
+63 SET MAGFILE1="-1~NO NETWORK OR JUKEBOX LOCATION DEFINED"
End DoDot:1
QUIT
+64 ;
+65 ; BAD POINTER
IF '$DATA(^MAG(2005.2,MAGREF,0))
Begin DoDot:1
+66 SET MAGFILE1="-1~INVALID NETWORK LOCATION POINTER ->"_MAGREF
End DoDot:1
QUIT
+67 ;
+68 SET MAGSTORE=^MAG(2005.2,MAGREF,0)
SET MAGTYPE=$PIECE(MAGSTORE,"^",7)
+69 ; in case the type is null
IF MAGTYPE=""
SET MAGTYPE=$EXTRACT(MAGSTORE,1,4)
+70 ;
+71 SET MAGERR=""
+72 ; the network device is off-line
IF '$PIECE(MAGSTORE,"^",6)
Begin DoDot:1
+73 ; get the jukebox device
IF MAGTYPE["MAG"
Begin DoDot:2
+74 SET MAGSTORE=$$TIER2LOC
+75 ;big trouble:nowhere on jbox
IF 'MAGSTORE
DO NOWHERE
SET MAGERR=1
QUIT
+76 ; get the file from the jbox
SET MAGSTORE=^MAG(2005.2,MAGSTORE,0)
+77 QUIT
End DoDot:2
if MAGERR
QUIT
+78 ;jbox cartridge offline
IF '$PIECE(MAGSTORE,"^",6)
DO OFFLINE
SET MAGERR=1
QUIT
+79 SET MAGREF=$$TIER2LOC
+80 QUIT
End DoDot:1
if MAGERR
QUIT
+81 ;
+82 SET MAGPREF=""
+83 IF MAGTYPE["MAG"
SET MAGPREF=$PIECE(MAGSTORE,"^",2)
+84 ;
+85 ; code for Jukeboxes
IF MAGTYPE?1"WORM".E
Begin DoDot:1
+86 IF MAGTYPE=("WORM-OTG")
SET MAGPREF=$PIECE(MAGSTORE,"^",2)
+87 IF '$TEST
IF MAGTYPE="WORM-PDT"
SET MAGPREF=$PIECE(MAGSTORE,"^",2)
+88 ; this code is for DG/SONY jukebox
IF '$TEST
IF MAGTYPE["WORM-DG"
Begin DoDot:2
+89 ; the subdirectory is the last two digits of the file name
NEW SUBDIR
+90 SET SUBDIR=$PIECE(MAGFILE1,".")
+91 SET SUBDIR=$EXTRACT(100+$EXTRACT(SUBDIR,$LENGTH(SUBDIR)-1,999),2,3)_"\"
+92 SET MAGPREF=$PIECE(MAGSTORE,"^",2)_SUBDIR
+93 QUIT
End DoDot:2
+94 ; The following is for tracking offline images
+95 IF $$IMOFFLN(MAGFILE1)
SET MAGOFFLN=1
+96 ; add the image to the JukeBox TO Hard Disk copy queue
IF MAGJBCP
Begin DoDot:2
+97 ; DBI - SEB Patch 4
SET X=$$JBTOHD^MAGBAPI(MAGXX_"^"_FILETYPE,$$GET1^DIQ(2005.2,MAGREF,.04,"I"))
+98 QUIT
End DoDot:2
+99 QUIT
End DoDot:1
+100 ;
+101 SET MAGPREF=MAGPREF_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)
+102 ;
+103 QUIT
+104 ;
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 imagQe 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_"^"_$$TIER2LOC_"^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
+8 ;
TIER2LOC() ; Get the TIER-2 location for the image entry and set it if null
+1 NEW IEN,KSITEPAR,TIER2LOC
+2 SET TIER2LOC=$PIECE(MAG0,"^",5)
+3 IF TIER2LOC=""
Begin DoDot:1
+4 SET KSITEPAR=$$KSP^XUPARAM("INST")
+5 SET IEN=$ORDER(^MAG(2006.1,"B",KSITEPAR,""))
+6 ; JUKEBOX WRITE LOCATION
SET TIER2LOC=$$GET1^DIQ(2006.1,IEN,2.01,"I")
+7 ; update TIER-2 location
SET $PIECE(^MAG(2005,+MAGXX,0),"^",5)=TIER2LOC
+8 ; necessary for additional calls
SET MAG0=^MAG(2005,+MAGXX,0)
+9 QUIT
End DoDot:1
+10 QUIT TIER2LOC
