source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTII.m@ 628

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

initial load of FOIAVistA 6/30/08 version

File size: 9.2 KB
Line 
1MAGGTII ;WOIFO/GEK - RETURN IMAGE INFO ; [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**8,48,63,59**;Nov 27, 2007;Build 20
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
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 of IMAGE FILE (2005)
19 ; RETURNS MAGFILE='^' delimited string of Image information.
20 ;
21 ;
22INFO ;Get info for an Image File entry
23 ; We assume that MAGXX exists and is the Image File entry
24 ; We return a '^' delimited string for the Image entry.
25 ; $P(1^2^3) IEN^Image FullPath and name^Abstract FullPath and Name
26 ; $P(4) SHORT DESCRIPTION field and desc of offline JukeBox
27 ; $P(5) PROCEDURE/ EXAM DATE/TIME field
28 ; $P(6) OBJECT TYPE
29 ; $P(7) PROCEDURE field
30 ; $P(8) display date
31 ; $P(9) to return the PARENT DATA FILE image pointer
32 ; $p(10) return the ABSTYPE 'M' magnetic 'W' worm 'O' offline
33 ; $p(11) is 'A' accessible 'O' offline
34 ; $p(12^13) Dicom Series Number $p(12) and Image Number $p(13)
35 ; $p(14) is count of images in group, 1 if single image.
36 ; VISN15
37 ; $p(15^16) SiteParameter IEN ^ SiteParameter CODE
38 ; $P(17) is err description of Integrity Check
39 ; $P(18) Image BIGPath and name //Patch 5
40 ; $P(19^20) Patient DFN ^ Patient Name; // Patch 3.8
41 ; $P(21) Image Class: Clin,Admin,Clin/Admin,Admin/Clin
42 ; $p(22) Date Time Image Saved(FLD 7)
43 ; $p(23) Document Date (FLD 110)
44 ;
45 N FILETYPE,MAGPREF,MAGJBCP,GRPTYPE,GRPIEN,ABSTYPE,MAGTYPE,MAGJBOL
46 N MAGOFFLN,FULLTYPE,MAGOBJT,MAGQI,X
47 N ABSFILE,FULLFILE,BIGFILE,PATCH,MDFN,FNL,PLC,PLCODE
48 N MAGN0,MAGN2,MAGN40,MAGN100
49 ; set the Variables for the Global Nodes of the Image Entry
50 S MAGN0=$G(^MAG(2005,MAGXX,0))
51 S MDFN=$P(MAGN0,"^",7)
52 S MAGN2=$G(^MAG(2005,MAGXX,2))
53 S MAGN40=$G(^MAG(2005,MAGXX,40))
54 S MAGN100=$G(^MAG(2005,MAGXX,100))
55 ; Set Name in Variable, Call $$GET 1 time not 2000
56 I MDFN I '$D(MAGJOB("PTNM",MDFN)) S MAGJOB("PTNM",MDFN)=$$GET1^DIQ(2,MDFN_",",.01)
57 I '$D(MAGJOB("NETPLC")) D NETPLCS^MAGGTU6
58 ; Object Type
59 S MAGOBJT=$P(MAGN0,"^",6)
60 ; if this is a group, change MAGXX to first image in group to get
61 ; that abstract to use for the group abstract
62 I MAGOBJT=11!(MAGOBJT=16) S GRPTYPE=MAGOBJT D
63 . S X=$O(^MAG(2005,MAGXX,1,0))
64 . ; next line to account for group of NO images for whatever reason.
65 . ; we change Object Type to XRAY (3) or STILL IMAGE (1)
66 . I 'X S MAGOBJT=$S(MAGOBJT=11:3,MAGOBJT=16:1,1:1) K GRPTYPE Q
67 . S X=^MAG(2005,MAGXX,1,X,0)
68 . ; keep the Real IEN, so we can change back later
69 . S GRPIEN=MAGXX,MAGXX=+X
70 . Q
71 S MAGJBCP=0 ; Don't Queue a copy from JukeBox.
72 ; The call to FINDFILE returns:
73 ; MAGFILE1=LA100066.ABS filename
74 ; if no Network Location pointer or INVALID Pointer
75 ; then MAGFILE1=-1~NO NETWORK LOCATION POINTER
76 ; or -1~INVALID NETWORK LOCATION POINTER
77 ; MAGFILE1(.01)=ONE,PATIENT 111223333 image desc
78 ; MAGJBOL= desc of Offline server
79 ; MAGOFFLN= if JB is offline
80 ; MAGPREF=C:\TEMP\LA\10\00\ path
81 ; MAGTYPE=MAG MAG or WORM
82 ;
83 ; first get Full Path and File Name of the Abstract
84 S FILETYPE="ABSTRACT" K MAGFILE1("ERROR")
85 S MAGPREF="" D FINDFILE^MAGFILEB
86 S MAGFILE1=$TR(MAGFILE1,"^","~") ; MAGFILE1 has '^' in it if errors
87 I $D(MAGFILE1("ERROR")) S MAGFILE1=MAGFILE1("ERROR")
88 S ABSTYPE=$E(MAGTYPE,1) I MAGOFFLN S ABSTYPE="O"
89 ; Here we must test for +MAGFILE1 = -1 which means we don't have
90 ; any entry in the Image File for the Abstract Network Location
91 ; pointer.
92 S MAGPREF=$G(MAGPREF)
93 S ABSFILE=MAGPREF_MAGFILE1
94 ;
95 ; now lets get the Full Path and file name FULL RES image.
96 S FULLTYPE="A" ; Accessible
97 S FILETYPE="FULL" K MAGFILE1("ERROR")
98 S MAGPREF="" D FINDFILE^MAGFILEB
99 S MAGFILE1=$TR(MAGFILE1,"^","~") ; MAGFILE1 has '^' in it if errors
100 I $D(MAGFILE1("ERROR")) S MAGFILE1=MAGFILE1("ERROR")
101 I MAGOFFLN S FULLTYPE="O" ; Offline
102 ; here we have to do the same test as above. for bad data.
103 S MAGPREF=$G(MAGPREF)
104 S FULLFILE=MAGPREF_MAGFILE1
105 ;
106 ; now lets get the Full Path and file name for BIG image.
107 S FILETYPE="BIG" K MAGFILE1("ERROR")
108 S MAGPREF="" D FINDFILE^MAGFILEB
109 S MAGFILE1=$TR(MAGFILE1,"^","~") ; MAGFILE1 has '^' in it if errors
110 I $D(MAGFILE1("ERROR")) S MAGFILE1=MAGFILE1("ERROR")
111 S MAGPREF=$G(MAGPREF)
112 S BIGFILE=$S($E(MAGFILE1,1,2)="-1":"",1:MAGPREF_MAGFILE1)
113 ;
114 K MAGFILE1 ; Cleanup
115 ; Site and Site Code are in Entry of first Image in Group
116 ; so we need to set here, before MAGXX is changed back.
117 S X=$G(^MAG(2005,MAGXX,0))
118 S FNL=$S(+$P(X,"^",3):$P(X,"^",3),1:+$P(X,"^",5))
119 S PLC=$P($G(MAGJOB("NETPLC",FNL)),"^",1)
120 S PLCODE=$P($G(MAGJOB("NETPLC",FNL)),"^",2)
121 I PLC="" S PLC=$G(MAGJOB("PLC")),PLCODE=$G(MAGJOB("PLCODE")) ; Group of 0 need this.
122 ; if we were using first image of a group, reset the Real IEN
123 I $G(GRPIEN) S MAGXX=GRPIEN
124 ;
125 ; we have to change the OBJECT TYPE variable back to real value
126 ; MAGOBJT might have been changed if we had Group of no images.
127 ; but we need to keep it changed, because Delphi window checks this
128 ; entry to determine which window to open.
129 ; i.e. Group window, Single image window,
130 S MAGOBJT=$P(MAGN0,U,6)
131 ;
132 ; now start building the return string
133 ;
134 S PATCH=$P($G(MAGJOB("VERSION")),".",3) ; //'="3.0.8")
135 K MAGFILE
136 S $P(MAGFILE,U,25)="" ; We put extra '^^^' on end of String to stop error in Delphi.
137 ; Pieces 26 BrokerServer and 27 Broker Port are set if this is P59 Client.
138 ; Clients Prior to Patch 59, the String must only be 25 pieces. - Patch 45 snafu
139 ;
140 ; $P(1^2^3) IEN^Image FullPath and name^Abstract FullPath and Name
141 S $P(MAGFILE,U,1,3)=MAGXX_U_FULLFILE_U_ABSFILE
142 ;
143 ; now set $P(4) SHORT DESCRIPTION field and desc of offline JukeBox
144 S $P(MAGFILE,U,4)=$P(MAGN2,U,4)_$G(MAGJBOL)
145 ;
146 ; now set $P(5)PROCEDURE/ EXAM DATE/TIME field
147 S $P(MAGFILE,U,5)=$P(MAGN2,U,5)
148 ;
149 ; now set $P(6) OBJECT TYPE
150 S $P(MAGFILE,U,6)=MAGOBJT
151 ;
152 ; now set $P(7) PROCEDURE field
153 S $P(MAGFILE,U,7)=$P(MAGN0,U,8)
154 ;
155 ; now we're making a DATE to display and will use it for a sort in
156 ; the delphi TStringGrid so we display mm/dd/yyyy
157 ; now set $P(8) display date
158 S X=$$FMTE^XLFDT($P(MAGN2,U,5),"5Z")
159 S X=$TR(X,"@"," ")
160 S $P(MAGFILE,U,8)=X
161 ;
162 ; now return the PARENT DATA FILE image pointer
163 S $P(MAGFILE,U,9)=$P(MAGN2,U,8)
164 ;
165 ; now return the ABSTYPE ( this is 'M' or 'W' or 'O' )
166 ; 'M' magnetic 'W' worm 'O' offline
167 S $P(MAGFILE,U,10)=ABSTYPE
168 ;
169 ; now return the code to show if full res image is offline 'A' or 'O'
170 ; 'A' accessible 'O' offline
171 S $P(MAGFILE,U,11)=FULLTYPE
172 ;
173 ; 2/1/99 Dicom Series number and Dicom Image Number
174 ; $p(12) and $p(13)
175 ;
176 ; 14 - count of images , if this is a group
177 S X=+$P($G(^MAG(2005,MAGXX,1,0)),U,4),$P(MAGFILE,U,14)=$S(X:X,1:1)
178 ;
179 ; $p(15^16 ) are SiteIEN and SiteCode Consolidation - DBI
180 ; We use SiteIEN and SiteCODE from above
181 S $P(MAGFILE,"^",15)=PLC
182 S $P(MAGFILE,"^",16)=PLCODE
183 ;
184 ; $p(17) 8/22/01 GEK Mod for integrity check.
185 I '$G(MAGNOCHK) D CHK^MAGGSQI(.MAGQI,MAGXX) I 'MAGQI(0) D
186 . ; remove the Abstract and Image File Names ; 2/14/03 remove c:\program files... with .\bmp\
187 . S $P(MAGFILE,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
188 . ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
189 . S $P(MAGFILE,U,6)=$S(($P(MAGFILE,U,6)'=11):"99",1:11)
190 . S $P(MAGFILE,U,10)="M"
191 . ;Send the error message
192 . S $P(MAGFILE,U,17)=$P(MAGQI(0),U,2)
193 ; $p(18) is BIGFile Full name and path.
194 S $P(MAGFILE,U,18)=BIGFILE
195 ; DFN
196 S $P(MAGFILE,U,19)=$P(MAGN0,U,7)
197 ; Patient Name
198 S $P(MAGFILE,U,20)=$S(MDFN:MAGJOB("PTNM",MDFN),1:MDFN)
199 S $P(MAGFILE,U,21)=$S(+$P(MAGN40,U,2):$P(^MAG(2005.82,$P(MAGN40,U,2),0),U),1:"")
200 S X=$$FMTE^XLFDT($P(MAGN2,U,1),"5Z") ; Date/Time Image Saved #7
201 S X=$TR(X,"@"," ")
202 S $P(MAGFILE,U,22)=X
203 S X=$$FMTE^XLFDT($P(MAGN100,U,6),"5Z") ; DocumentDate #110
204 S X=$TR(X,"@"," ")
205 S $P(MAGFILE,U,23)=X
206 ; If Patch 59 Client - we can set beyond 25 pieces.
207 I $D(MAGJOB("RPCSERVER"))&$D(MAGJOB("RPCPORT")) D
208 . S $P(MAGFILE,U,26)=MAGJOB("RPCSERVER")
209 . S $P(MAGFILE,U,27)=MAGJOB("RPCPORT")
210 . S $P(MAGFILE,U,28)="" ; "^" at end, stops problems in delphi
211 . Q
212 ; Stop displaying a Group of 1 as a Group, so here we'll change Object type
213 ; to that of the '1ST' image in the group of 1.
214 I $P($G(^MAG(2005,MAGXX,1,0)),U,4)=1 D
215 . S X=$O(^MAG(2005,MAGXX,1,0))
216 . S X=+^MAG(2005,MAGXX,1,X,0)
217 . S $P(MAGFILE,U,6)=$P(^MAG(2005,X,0),U,6) ; OBJECT TYPE OF 1ST IMAGE IN GROUP
218 . S $P(MAGFILE,U,1)=X
219 . Q
220 Q
Note: See TracBrowser for help on using the repository browser.