source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGFILEB.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1MAGFILEB ;WOIFO/RED - CREATE FILE REFERENCE FROM ^MAG(2005) ; 10/22/2002 06:39
2 ;;3.0;IMAGING;**8,48**;Jan 11, 2005
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
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 Q
41VST ; Entry point to get a full size image with copying from JB to MAG DISK
42 N MAGPREF,MAGJBCP S MAGJBCP=1 G FULL
43 ;
44VSTNOCP ; Entry point to get a full size image without copying it from the JB
45 N MAGPREF,MAGJBCP S MAGJBCP=0 G FULL
46 ;
47ABS ; Entry point to get an image abstract with copying from JB to MAG DISK
48 N MAGPREF,MAGJBCP S MAGJBCP=1 G ABSTRACT
49 ;
50ABSNOCP ; Entry point to get an image abstract without copying it from the JB
51 N MAGPREF,MAGJBCP S MAGJBCP=0 G ABSTRACT
52 ;
53BIG ; Entry point to get a big file with copying from JB to MAG DISK
54 N MAGPREF,MAGJBCP S MAGJBCP=1 G BIGFILE
55 ;
56BIGNOCP ; Entry point to get a big without copying it from the JB
57 N MAGPREF,MAGJBCP S MAGJBCP=0 G BIGFILE
58 ;
59FULL N FILETYPE,MAGTYPE S FILETYPE="FULL" D FINDFILE G EXIT
60 ;
61ABSTRACT N FILETYPE,MAGTYPE S FILETYPE="ABSTRACT" D FINDFILE G EXIT
62 ;
63BIGFILE N FILETYPE,MAGTYPE S FILETYPE="BIG" D FINDFILE G EXIT
64 ;
65EXIT S MAGPREF=$G(MAGPREF)
66 S MAGFILE2=MAGPREF_MAGFILE1,MAGFILE=MAGFILE2_$C(0)
67 K MAGXX Q
68 ;
69FINDFILE ;
70 N MAG0,MAGERR,MAGREF,MAGSTORE,CNDBMP
71 K MAGPREF,MAGFILE1("ERROR") S (MAGJBOL,MAGERR,MAGTYPE,MAGOFFLN,MAGREF)=""
72 I '$D(^MAG(2005,+MAGXX,0)) S MAGFILE1="-13,Image "_MAGXX_" is deleted",MAGERR=1 Q
73 S MAG0=^MAG(2005,+MAGXX,0),MAGFILE1=$P(MAG0,"^",2)
74 S MAGFILE1(.01)=$P(MAG0,"^") ; for MAILMAN interface
75 S MAGFILE1=$P(MAGFILE1,"\",$L(MAGFILE1,"\"))
76 ;
77 I FILETYPE="TEXT" S FILETYPE="FULL" S $P(MAGFILE1,".",2)="TXT"
78 ;
79 I FILETYPE="FULL" D ; code for full size image
80 . S MAGREF=$P(MAG0,"^",3)
81 . I MAGREF="" S MAGJB=1,MAGREF=$P(MAG0,"^",5) ; get file from jukebox
82 . Q
83 ;
84 I FILETYPE="ABSTRACT" D Q:MAGERR ; code for abstract
85 . ; gek 8/26/02 not sending full as the abstract for Documents.
86 . ; If Abs doesn't exist for Document (TIF) we'll Queue it. (don't know if it's on JB)
87 . S MAGREF=$P(MAG0,"^",4)
88 . I (MAGREF="") D Q:MAGERR
89 . . D RSLVABS^MAGGTU3(MAGXX,.CNDBMP)
90 . . I $L(CNDBMP) S MAGFILE1=CNDBMP,MAGERR=1 Q
91 . . S MAGJB=1,MAGREF=$P(MAG0,"^",5) ; get file from jukebox
92 . . ;Patch 48 stop queing abstracts.
93 . . ;I $P(MAG0,"^",6)=15 S X=$$ABSTRACT^MAGBAPI(+MAGXX)
94 . . Q
95 . S $P(MAGFILE1,".",2)="ABS"
96 . Q
97 ;
98 I FILETYPE="BIG" D Q:MAGERR ; code for big file
99 . N FBIG
100 . S FBIG=$G(^MAG(2005,MAGXX,"FBIG"))
101 . I FBIG="" D Q ; no big file exists
102 . . S MAGPREF="",MAGFILE1="-1~BIG File Does NOT Exist",MAGERR=1
103 . S $P(MAGFILE1,".",2)="BIG"
104 . S MAGREF=$P(FBIG,"^") ; get file from magnetic disk, if possible
105 . I MAGREF="" S MAGREF=$P(FBIG,"^",2) ; get file from jukebox
106 . Q
107 ;
108 I MAGREF="" D Q ;NO NETWORK LOCATION
109 . S MAGFILE1="-1~NO NETWORK OR JUKEBOX LOCATION DEFINED"
110 ;
111 I '$D(^MAG(2005.2,MAGREF,0)) D Q ; BAD POINTER
112 . S MAGFILE1="-1~INVALID NETWORK LOCATION POINTER ->"_MAGREF
113 ;
114 S MAGSTORE=^MAG(2005.2,MAGREF,0),MAGTYPE=$P(MAGSTORE,"^",7)
115 I MAGTYPE="" S MAGTYPE=$E(MAGSTORE,1,4) ; in case the type is null
116 ;
117 S MAGERR=""
118 I '$P(MAGSTORE,"^",6) D Q:MAGERR ; the network device is off-line
119 . I MAGTYPE["MAG" D Q:MAGERR ; get the jukebox device
120 . . S MAGSTORE=$P(MAG0,"^",5)
121 . . I 'MAGSTORE D NOWHERE S MAGERR=1 Q ;big trouble:nowhere on jbox
122 . . S MAGSTORE=^MAG(2005.2,MAGSTORE,0) ; get the file from the jbox
123 . . Q
124 . I '$P(MAGSTORE,"^",6) D OFFLINE S MAGERR=1 Q ;jbox cartridge offline
125 . S MAGREF=$P(MAG0,"^",5)
126 . Q
127 ;
128 S MAGPREF=""
129 I MAGTYPE["MAG" S MAGPREF=$P(MAGSTORE,"^",2)
130 ;
131 I MAGTYPE?1"WORM".E D ; code for Jukeboxes
132 . I MAGTYPE=("WORM-OTG") S MAGPREF=$P(MAGSTORE,"^",2)
133 . E I MAGTYPE="WORM-PDT" S MAGPREF=$P(MAGSTORE,"^",2)
134 . E I MAGTYPE["WORM-DG" D ; this code is for DG/SONY jukebox
135 . . N SUBDIR ; the subdirectory is the last two digits of the file name
136 . . S SUBDIR=$P(MAGFILE1,".")
137 . . S SUBDIR=$E(100+$E(SUBDIR,$L(SUBDIR)-1,999),2,3)_"\"
138 . . S MAGPREF=$P(MAGSTORE,"^",2)_SUBDIR
139 . . Q
140 . ; The following is for tracking offline images
141 . I $$IMOFFLN(MAGFILE1) S MAGOFFLN=1
142 . I MAGJBCP D ; add the image to the JukeBox TO Hard Disk copy queue
143 . . S X=$$JBTOHD^MAGBAPI(MAGXX_"^"_FILETYPE,$$GET1^DIQ(2005.2,MAGREF,.04,"I")) ; DBI - SEB Patch 4
144 . . Q
145 . Q
146 ;
147 S MAGPREF=MAGPREF_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)
148 ;
149 Q
150 ;
151DIRHASH(FILENAME,NETLOCN) ; determine the hierarchical file directory hash
152 ;
153 ; Input Variables:
154 ; FILENAME -- the name of the file, with or without the extension
155 ; NETLOCN --- the network location file internal entry number
156 ; Return Value: the hierarchical file directory hash
157 ;
158 N FN,HASHFLAG,HASH,I
159 S HASHFLAG=$P(^MAG(2005.2,NETLOCN,0),"^",8)
160 I HASHFLAG="Y" D ; calculate the hierarchical directory hash
161 . ; for an 8.3 filename AB123456.XYZ, the directory hash is AB\12\34
162 . ; for a 14.3 filename BALT1234567890.XYZ, its BALT\12\34\56\78
163 . S FN=$P(FILENAME,".") ; strip off the extension
164 . I $L(FN)=8 S HASH=$E(FN,1,2)_"\"_$E(FN,3,4)_"\"_$E(FN,5,6)
165 . E S HASH=$E(FN,1,4) F I=5,7,9,11 S HASH=HASH_"\"_$E(FN,I,I+1)
166 . S HASH=HASH_"\" ; add the trailing directory separator
167 . Q
168 E S HASH="" ; flat directory structure, no hierarchical hashing
169 Q HASH
170 ;
171NOWHERE ; File is not anywhere on the jukebox -- output error message
172 ; Requested image file is not on the Jukebox
173 S MAGPREF="",MAGFILE1="-1^"_MAGXX_"^^NOWHERE"
174 S MAGFILE1("ERROR")="-1~Network device Off-Line and Image not on JukeBox"
175 Q
176 ;
177OFFLINE ; Jukebox Cartridge is off-line -- output error message
178 ; Jukebox Cartridge with image file is off-line."
179 S MAGPREF="",MAGFILE1="-1^"_MAGXX_"^"_$P(MAG0,"^",5)_"^OFFLINE"
180 Q
181IMOFFLN(FILE) ;Check to see if image is offline (jb platter removed)
182 N XX,X
183 I '$L(FILE) Q 0
184 S X=FILE X ^%ZOSF("UPPERCASE") S FILE=Y
185 I $D(^MAGQUEUE(2006.033,"B",FILE)) D Q 1
186 . S XX="",XX=$O(^MAGQUEUE(2006.033,"B",FILE,XX))
187 . S MAGJBOL=" ** "_$P(^MAGQUEUE(2006.033,XX,0),"^",2)_" **"
188 Q 0
Note: See TracBrowser for help on using the repository browser.