Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGD350L

MAGD350L.m

Go to the documentation of this file. 
  1. 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
  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.  ; Copied from MAGFILEB and then modified to support TIER-2 lookups
  1.  ;
  1.  Q
  1.  ; CALL WITH MAGXX=IEN NUMBER IN IMAGE FILE (2005)
  1.  ;Calling FINDFILE requires FILETYPE to be defined ["FULL"|"ABSTRACT"|"BIG"|"TEXT"]
  1.  ;P350 ALLOWS FILETYPE to be defined ["FULL TIER-2"|"ABSTRACT TIER-2"|"BIG TIER-2"|"TEXT TIER-2"]
  1.  ;   returns : 
  1.  ; ..MAGFILE1 =          FILENAME ONLY
  1.  ; ..MAGFILE1(.01)=      .01 FIELD OF FILE (2005)
  1.  ; ..MAGFILE1("ERROR") = Message if NetWork device is offline and Image Not On JB
  1.  ; ..MAGINST =                   Pointer to Institution File (Consolidated)
  1.  ; ..                      OR  IEN of Imaging Site Parameters only entry (Non-Consolidated)
  1.  ; ..MAGJBOL =                   NULL("")  OR " ** "_Name of Platter that is Offline"_" ** "
  1.  ; ..MAGOFFLN =                  NULL("")  OR "1"   "1" means image is on platter that is offline.
  1.  ; ..MAGPLACE =                  PLACE of Image. (IEN of IMAGING SITE PARAMETERS FILE)
  1.  ; ..                                      Determined from Network Location file                 
  1.  ; ..MAGPREF  =          Full Path of Image Network (or Jukebox) Directory 
  1.  ;
  1.  ;Calling other TAGS (VST,VSTNOCP,ABS,ABSNOCP,BIG,BIGNOCP,FULL,ABSTRACT,BIGFILE)      
  1.  ;   return all of above and : 
  1.  ; ..MAGFILE  =          FILE NAME WITH FULL PATH FOLLOWED BY $C(0)
  1.  ; ..MAGFILE2 =          FILE NAME WITH FULL PATH W/O $C(0)
  1.  ; .. Deletes MAGXX
  1.  ; .. Does not Return MAGPREF
  1.  ; Modified to handle hierarchical directory hash 4/23/98 -- PMK
  1.  ;
  1.  Q
  1. VST ; Entry point to get a full size image with copying from JB to MAG DISK
  1.  N MAGPREF,MAGJBCP S MAGJBCP=1 G FULL
  1.  ;
  1. VSTNOCP ; Entry point to get a full size image without copying it from the JB
  1.  N MAGPREF,MAGJBCP S MAGJBCP=0 G FULL
  1.  ;
  1. ABS ; Entry point to get an image abstract with copying from JB to MAG DISK
  1.  N MAGPREF,MAGJBCP S MAGJBCP=1 G ABSTRACT
  1.  ;
  1. ABSNOCP ; Entry point to get an image abstract without copying it from the JB
  1.  N MAGPREF,MAGJBCP S MAGJBCP=0 G ABSTRACT
  1.  ;
  1. BIG ; Entry point to get a big file with copying from JB to MAG DISK
  1.  N MAGPREF,MAGJBCP S MAGJBCP=1 G BIGFILE
  1.  ;
  1. BIGNOCP ; Entry point to get a big without copying it from the JB
  1.  N MAGPREF,MAGJBCP S MAGJBCP=0 G BIGFILE
  1.  ;
  1. FULL N FILETYPE,MAGTYPE S FILETYPE="FULL" D FINDFILE G EXIT
  1.  ;
  1. ABSTRACT N FILETYPE,MAGTYPE S FILETYPE="ABSTRACT" D FINDFILE G EXIT
  1.  ;
  1. BIGFILE N FILETYPE,MAGTYPE S FILETYPE="BIG" D FINDFILE G EXIT
  1.  ;
  1. EXIT S MAGPREF=$G(MAGPREF)
  1.  S MAGFILE2=MAGPREF_MAGFILE1,MAGFILE=MAGFILE2_$C(0)
  1.  K MAGXX Q
  1.  ;
  1. FINDFILE ;
  1.  N MAG0,MAGERR,MAGREF,MAGSTORE,CNDBMP
  1.  K MAGPREF,MAGFILE1("ERROR") S (MAGJBOL,MAGERR,MAGTYPE,MAGOFFLN,MAGREF)=""
  1.  I '$D(^MAG(2005,+MAGXX,0)) S MAGFILE1="-13,Image "_MAGXX_" is deleted",MAGERR=1 Q
  1.  S MAG0=^MAG(2005,+MAGXX,0),MAGFILE1=$P(MAG0,"^",2)
  1.  S MAGFILE1(.01)=$P(MAG0,"^") ; for MAILMAN interface
  1.  S MAGFILE1=$P(MAGFILE1,"\",$L(MAGFILE1,"\"))
  1.  ; 
  1.  I FILETYPE="TEXT" S FILETYPE="FULL" S $P(MAGFILE1,".",2)="TXT"
  1.  I FILETYPE="TEXT TIER-2" S FILETYPE="FULL TIER-2" S $P(MAGFILE1,".",2)="TXT" ; P350 PMK 12/21/2022
  1.  ;
  1.  I FILETYPE="FULL" D  ; code for full size image
  1.  . S MAGREF=$P(MAG0,"^",3)
  1.  . I MAGREF="" S MAGJB=1,MAGREF=$$TIER2LOC ; get file from jukebox
  1.  . Q
  1.  ;
  1.  I FILETYPE="FULL TIER-2" D  ; code for full size image - P350 PMK 12/21/2022
  1.  . S MAGREF=$$TIER2LOC ; get file from TIER-2 storage
  1.  . Q
  1.  ;
  1.  I FILETYPE="ABSTRACT" D  Q:MAGERR  ; code for abstract
  1.  . ;  gek 8/26/02 not sending full as the abstract for Documents.
  1.  . ;  If Abs doesn't exist for Document (TIF) we'll Queue it. (don't know if it's on JB)
  1.  . S MAGREF=$P(MAG0,"^",4)
  1.  . I (MAGREF="") D  Q:MAGERR
  1.  . . D RSLVABS^MAGGTU3(MAGXX,.CNDBMP)
  1.  . . I $L(CNDBMP) S MAGFILE1=CNDBMP,MAGERR=1 Q
  1.  . . S MAGJB=1,MAGREF=$$TIER2LOC ; get file from jukebox
  1.  . . ;Patch 48 stop queing abstracts.
  1.  . . ;I $P(MAG0,"^",6)=15 S X=$$ABSTRACT^MAGBAPI(+MAGXX)
  1.  . . Q
  1.  . S $P(MAGFILE1,".",2)="ABS"
  1.  . Q
  1.  ;
  1.  I FILETYPE="ABSTRACT TIER-2" D  Q:MAGERR  ; code for abstract - P350 PMK 12/21/2022
  1.  . S MAGREF=$$TIER2LOC ; get file from TIER-2 storage
  1.  . S $P(MAGFILE1,".",2)="ABS"
  1.  . Q
  1.  ;
  1.  I FILETYPE="BIG" D  Q:MAGERR  ; code for big file
  1.  . N EXT,FBIG  ;
  1.  . S FBIG=$G(^MAG(2005,MAGXX,"FBIG"))
  1.  . I FBIG="" D  Q  ; no big file exists
  1.  . . S MAGPREF="",MAGFILE1="-1~BIG File Does NOT Exist",MAGERR=1
  1.  . . Q
  1.  . S EXT=$P(FBIG,"^",3) I EXT="" S EXT="BIG"
  1.  . S $P(MAGFILE1,".",2)=EXT
  1.  . S MAGREF=$P(FBIG,"^") ; get file from magnetic disk, if possible
  1.  . I MAGREF="" S MAGREF=$P(FBIG,"^",2) ; get file from jukebox
  1.  . Q
  1.  ;
  1.   I FILETYPE="BIG TIER-2" D  Q:MAGERR  ; code for big file - P350 PMK 12/21/2022
  1.  . N EXT,FBIG  ;
  1.  . S FBIG=$G(^MAG(2005,MAGXX,"FBIG"))
  1.  . I FBIG="" D  Q  ; no big file exists
  1.  . . S MAGPREF="",MAGFILE1="-1~BIG File Does NOT Exist",MAGERR=1
  1.  . . Q
  1.  . S EXT=$P(FBIG,"^",3) I EXT="" S EXT="BIG"
  1.  . S $P(MAGFILE1,".",2)=EXT
  1.  . S MAGREF=$P(FBIG,"^",2) ; get file from TIER-2 storage
  1.  . Q
  1.  ;
  1.  I MAGREF="" D  Q  ;NO NETWORK LOCATION
  1.  . S MAGFILE1="-1~NO NETWORK OR JUKEBOX LOCATION DEFINED"
  1.  ;
  1.  I '$D(^MAG(2005.2,MAGREF,0)) D  Q  ; BAD POINTER
  1.  . S MAGFILE1="-1~INVALID NETWORK LOCATION POINTER ->"_MAGREF
  1.  ;
  1.  S MAGSTORE=^MAG(2005.2,MAGREF,0),MAGTYPE=$P(MAGSTORE,"^",7)
  1.  I MAGTYPE="" S MAGTYPE=$E(MAGSTORE,1,4) ; in case the type is null
  1.  ;
  1.  S MAGERR=""
  1.  I '$P(MAGSTORE,"^",6) D  Q:MAGERR  ; the network device is off-line
  1.  . I MAGTYPE["MAG" D  Q:MAGERR  ; get the jukebox device
  1.  . . S MAGSTORE=$$TIER2LOC
  1.  . . I 'MAGSTORE D NOWHERE S MAGERR=1 Q  ;big trouble:nowhere on jbox
  1.  . . S MAGSTORE=^MAG(2005.2,MAGSTORE,0) ; get the file from the jbox
  1.  . . Q
  1.  . I '$P(MAGSTORE,"^",6) D OFFLINE S MAGERR=1 Q  ;jbox cartridge offline
  1.  . S MAGREF=$$TIER2LOC
  1.  . Q
  1.  ;
  1.  S MAGPREF=""
  1.  I MAGTYPE["MAG" S MAGPREF=$P(MAGSTORE,"^",2)
  1.  ;
  1.  I MAGTYPE?1"WORM".E D  ; code for Jukeboxes
  1.  . I MAGTYPE=("WORM-OTG") S MAGPREF=$P(MAGSTORE,"^",2)
  1.  . E  I MAGTYPE="WORM-PDT" S MAGPREF=$P(MAGSTORE,"^",2)
  1.  . E  I MAGTYPE["WORM-DG" D  ; this code is for DG/SONY jukebox
  1.  . . N SUBDIR ; the subdirectory is the last two digits of the file name
  1.  . . S SUBDIR=$P(MAGFILE1,".")
  1.  . . S SUBDIR=$E(100+$E(SUBDIR,$L(SUBDIR)-1,999),2,3)_"\"
  1.  . . S MAGPREF=$P(MAGSTORE,"^",2)_SUBDIR
  1.  . . Q
  1.  . ; The following is for tracking offline images
  1.  . I $$IMOFFLN(MAGFILE1) S MAGOFFLN=1
  1.  . I MAGJBCP D  ; add the image to the JukeBox TO Hard Disk copy queue
  1.  . . S X=$$JBTOHD^MAGBAPI(MAGXX_"^"_FILETYPE,$$GET1^DIQ(2005.2,MAGREF,.04,"I")) ; DBI - SEB Patch 4
  1.  . . Q
  1.  . Q
  1.  ;
  1.  S MAGPREF=MAGPREF_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)
  1.  ;
  1.  Q
  1.  ;
  1. DIRHASH(FILENAME,NETLOCN) ; determine the hierarchical file directory hash 
  1.  ;
  1.  ; Input Variables:
  1.  ; FILENAME -- the name of the file, with or without the extension
  1.  ; NETLOCN --- the network location file internal entry number
  1.  ; Return Value: the hierarchical file directory hash
  1.  ;
  1.  N FN,HASHFLAG,HASH,I
  1.  S HASHFLAG=$P(^MAG(2005.2,NETLOCN,0),"^",8)
  1.  I HASHFLAG="Y" D  ; calculate the hierarchical directory hash
  1.  . ; for an 8.3 filename AB123456.XYZ, the directory hash is AB\12\34
  1.  . ; for a 14.3 filename BALT1234567890.XYZ, its BALT\12\34\56\78
  1.  . S FN=$P(FILENAME,".") ; strip off the extension
  1.  . I $L(FN)=8 S HASH=$E(FN,1,2)_"\"_$E(FN,3,4)_"\"_$E(FN,5,6)
  1.  . E  S HASH=$E(FN,1,4) F I=5,7,9,11 S HASH=HASH_"\"_$E(FN,I,I+1)
  1.  . S HASH=HASH_"\" ; add the trailing directory separator
  1.  . Q
  1.  E  S HASH="" ; flat directory structure, no hierarchical hashing 
  1.  Q HASH
  1.  ; 
  1. NOWHERE ; File is not anywhere on the jukebox -- output error message
  1.  ; Requested imagQe file is not on the Jukebox
  1.  S MAGPREF="",MAGFILE1="-1^"_MAGXX_"^^NOWHERE"
  1.  S MAGFILE1("ERROR")="-1~Network device Off-Line and Image not on JukeBox"
  1.  Q
  1.  ;
  1. OFFLINE ; Jukebox Cartridge is off-line -- output error message
  1.  ; Jukebox Cartridge with image file is off-line."
  1.  S MAGPREF="",MAGFILE1="-1^"_MAGXX_"^"_$$TIER2LOC_"^OFFLINE"
  1.  Q
  1. IMOFFLN(FILE) ;Check to see if image is offline (jb platter removed)
  1.  N XX,X,Y
  1.  I '$L(FILE) Q 0
  1.  S X=FILE X ^%ZOSF("UPPERCASE") S FILE=Y
  1.  I $D(^MAGQUEUE(2006.033,"B",FILE)) D   Q 1
  1.  . S XX="",XX=$O(^MAGQUEUE(2006.033,"B",FILE,XX))
  1.  . S MAGJBOL=" ** "_$P(^MAGQUEUE(2006.033,XX,0),"^",2)_" **"
  1.  Q 0
  1.  ;
  1. TIER2LOC() ; Get the TIER-2 location for the image entry and set it if null
  1.  N IEN,KSITEPAR,TIER2LOC
  1.  S TIER2LOC=$P(MAG0,"^",5)
  1.  I TIER2LOC="" D
  1.  . S KSITEPAR=$$KSP^XUPARAM("INST")
  1.  . S IEN=$O(^MAG(2006.1,"B",KSITEPAR,""))
  1.  . S TIER2LOC=$$GET1^DIQ(2006.1,IEN,2.01,"I") ; JUKEBOX WRITE LOCATION
  1.  . S $P(^MAG(2005,+MAGXX,0),"^",5)=TIER2LOC ; update TIER-2 location
  1.  . S MAG0=^MAG(2005,+MAGXX,0) ; necessary for additional calls
  1.  . Q
  1.  Q TIER2LOC