source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTIG.m@ 1751

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1MAGGTIG ;WOIFO/GEK - MAGGT Image Get. Callbacks to Get Image lists ; [ 11/08/2001 17:18 ]
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 Q
19GRPCOUNT(MAGRY,MAGIEN) ;
20 S MAGRY=+$P($G(^MAG(2005,MAGIEN,1,0)),U,4)
21 Q
22IMAGES(MAGRY,MAGDFN) ;RPC [MAGG PAT IMAGES]
23 ; Call to return a list of images for a patient.
24 ; We are returning all images for a patient, Groups are returned
25 ; as one Image.
26 ; The Images are returned in Rev Chronological Order, latest image
27 ; first, oldest image last.
28 ; User can reorder at the workstation level.
29 K MAGRY
30 N Y,RDT,PRX,CT,IEN,GBLRET
31 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
32 S MAGDFN=+MAGDFN
33 ; if no Images for the patient, then quit.
34 I '$D(^MAG(2005,"APDTPX",MAGDFN)) S MAGRY(0)="1^0" Q
35 ; the "APDTPX" cross reference is :
36 ; "APDTPX",DFN,Rev Date,Procedure,MAGIEN )
37 ;
38 ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
39 S GBLRET=0
40 S MAGRY="MAGRY"
41 S CT=0,RDT=""
42 F S RDT=$O(^MAG(2005,"APDTPX",MAGDFN,RDT)) Q:'RDT D
43 . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX)) Q:PRX="" D
44 . . S IEN=""
45 . . F S IEN=$O(^MAG(2005,"APDTPX",MAGDFN,RDT,PRX,IEN)) Q:'IEN D
46 . . . Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
47 . . . S CT=CT+1
48 . . . I (CT>100),'GBLRET D ARY2GLB
49 . . . S MAGXX=IEN D INFO^MAGGTII
50 . . . S @MAGRY@(CT)="B2^"_MAGFILE
51 S @MAGRY@(0)="1^"_CT
52 Q
53PHOTOS(MAGRY,MAGDFN) ;RPC [MAGG PAT PHOTOS]
54 ; Call to return list of all Photo ID's on file for a patient.
55 ; We are returning all Photo ID images for a patient.
56 ; The Images are returned in Rev Chronological Order, latest image
57 ; first, oldest image last.
58 K MAGRY
59 N Y,RDT,PRX,CT,IEN,IENS,GBLRET,MAGXX
60 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
61 S MAGDFN=+MAGDFN
62 ; if no Photo ID Images for the patient, then quit.
63 I '$D(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID")) S MAGRY(0)="1^0" Q
64 ; the "APPXDT" cross reference is :
65 ; "APPXDT",DFN,Procedure,Rev Date,MAGIEN )
66 ;
67 ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
68 S GBLRET=0
69 S MAGRY="MAGRY"
70 S CT=0
71 S RDT="" F S RDT=$O(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT)) Q:RDT="" D
72 . S IEN=""
73 . F S IEN=$O(^MAG(2005,"APPXDT",MAGDFN,"PHOTO ID",RDT,IEN)) Q:'IEN D
74 . . ;Q:$P($G(^MAG(2005,IEN,0)),"^",10) ; CHILD OF GROUP
75 . . S IENS(IEN)=""
76 . . Q
77 . Q
78 S IEN="" F S IEN=$O(IENS(IEN),-1) Q:'IEN D
79 . S CT=CT+1
80 . S MAGXX=IEN D INFO^MAGGTII
81 . S @MAGRY@(CT)="B2^"_MAGFILE
82 . Q
83 S @MAGRY@(0)="1^"_CT
84 Q
85EACHIMG(MAGRY,MAGDFN,MAX) ;RPC [MAGG PAT EACH IMAGE]
86 ; Call Returns list of recent Patient images.
87 ; MAX = maximum number of images to return
88 ; MAGDFN = patient DFN
89 ; We are returning all images for a patient, and listing each image.
90 ; This is called from Capture Window where groups aren't listed.
91 ; The Images are returned in Rev Chronological Order, latest image
92 ; first, oldest image last.
93 ; User can decide how many of the most recent they want to list.
94 K MAGRY
95 N Y,RDT,PRX,CT,IEN,GBLRET
96 S MAX=$S($G(MAX)>0:MAX,1:50) ; 50 IS DEFAULT
97 N $ETRAP,$ESTACK S $ETRAP="D ERRG^MAGGTERR"
98 S MAGDFN=+MAGDFN
99 ; if no Images for the patient, then quit.
100 I '$D(^MAG(2005,"AC",MAGDFN)) S MAGRY(0)="1^0" Q
101 ; the "AC" cross reference is :
102 ; "AC",DFN,IEN )
103 ;
104 ; we'll use @ notation, this'll work if an Array or a Global Array is begin returned
105 S GBLRET=0
106 S MAGRY="MAGRY"
107 S CT=0,IEN=""
108 F S IEN=$O(^MAG(2005,"AC",MAGDFN,IEN),-1) Q:'IEN D Q:(CT>MAX)
109 . Q:$P($G(^MAG(2005,IEN,0)),U,6)=11 ; NOT LISTING GROUP ENTRIES
110 . S CT=CT+1
111 . I (CT>100),'GBLRET D ARY2GLB
112 . S @MAGRY@(CT)=$$CAPINFO(IEN)
113 S @MAGRY@(0)="1^"_CT
114 Q
115CAPINFO(IEN) ; RETURN A STRING OF INFORMATION ABOUT THE IMAGE
116 ; This is for Capture App
117 N RETY,N2
118 S MAGXX=IEN D INFO^MAGGTII
119 S RETY=$P(MAGFILE,U,1,7)_U
120 S N2=$G(^MAG(2005,IEN,2))
121 S RETY=RETY_$$FMTE^XLFDT($P(N2,U,1),"5P")_U
122 S X=$P(RETY,U,5),X=$$FMTE^XLFDT(X,"5"),X=$P(X,"@")
123 S $P(RETY,U,5)=X
124 Q RETY
125 Q
126ARY2GLB ; Image count is getting big, switch from array to Global return type
127 S GBLRET=1
128 K ^TMP("MAGGTIG",$J)
129 S MAGRY=""
130 M ^TMP("MAGGTIG",$J)=MAGRY
131 K MAGRY
132 S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
133 S MAGRY=$NA(^TMP("MAGGTIG",$J))
134 Q
135GROUP(MAGRY,MAGIEN,NOCHK) ;RPC [MAGG GROUP IMAGES]
136 ; CalL to Return image list of a Group.
137 ; MAGIEN = the entry in MAG(2005 we assume it is a group.
138 ; NOCHK = flag - Do (or) Not Do QI Check.
139 N Y,MAGDFN,I,MAGCHILD,MAGCT,MAGTMPAR,MSGX,MAGQI,MAGY
140 N MAGNOCHK
141 ;
142 ;Test BigGroup S BKG=+$G(BKG)
143 ;Test BigGroup K ^TMP("MAGBGRP")
144 S MAGIEN=+MAGIEN,MSGX=""
145 S NOCHK=+$G(NOCHK)
146 I '$D(^MAG(2005,MAGIEN,0)) S MAGRY(0)="0^ERROR: Image entry "_MAGIEN_" Doesn't exist" Q
147 I $O(^MAG(2005,MAGIEN,1,0))="" S MAGRY(0)="0^ERROR: There are NO Images defined for this Group" Q
148 ;
149 ; we'll use @ notation, this'll work if an Array or a Global Array is being returned
150 S MAGRY="MAGRY"
151 ;
152 ; if we are switching to a Global Array because too many images,
153 ; then set MAGRY and clean it up first
154 ;I +$P($G(^MAG(2005,MAGIEN,1,0)),U,4)>100
155 D
156 . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
157 . S MAGRY=$NA(^TMP("MAGGTIG",$J))
158 . K @MAGRY
159 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
160 ;
161 ;Test BigGroup I $D(^TMP("MAGBGRP",MAGIEN)) D Q
162 ;Test BigGroup . M ^TMP("MAGGTIG",$J)=^TMP("MAGBGRP",MAGIEN)
163 ;Test BigGroup . Q
164 ; integrity check, stop if group entry is questionable
165 ; NOCHK is sent from Image Delete window (so user with DELETE and SYSTEM keys)
166 ; can see group abstracts before the group is deleted.
167 I 'NOCHK D CHK^MAGGSQI(.MAGQI,MAGIEN) I 'MAGQI(0) D Q
168 . S @MAGRY@(0)=MAGQI(0)
169 ;
170 S MAGNOCHK=1
171 S I=0,MAGCT=0,MAGDFN=$P(^MAG(2005,MAGIEN,0),"^",7)
172 I $D(^MAG(2005,MAGIEN,1,"ADCM")) D
173 . N INUM,SNUM
174 . S INUM="" ; GEK 4/3/00 changed Q:'INUM to Q:INUM="" below
175 . F S INUM=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM)) Q:INUM="" D
176 . . S SNUM=""
177 . . F S SNUM=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM)) Q:SNUM="" D
178 . . . S MAGCHILD=""
179 . . . F S MAGCHILD=$O(^MAG(2005,MAGIEN,1,"ADCM",INUM,SNUM,MAGCHILD)) Q:'MAGCHILD D
180 . . . . S MAGCT=MAGCT+1
181 . . . . I '$D(^MAG(2005,MAGCHILD)) D INVALID(MAGCHILD,.MSGX) S @MAGRY@(MAGCT)=MSGX Q
182 . . . . ; Added for MAGQI integrity check
183 . . . . K MAGY
184 . . . . D CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD) I 'MAGY D INVCH(.MAGY,MAGCHILD) S @MAGRY@(MAGCT)=MAGY Q
185 . . . . S MAGXX=MAGCHILD
186 . . . . S MAGTMPAR(MAGXX)=""
187 . . . . D INFO^MAGGTII
188 . . . . S $P(MAGFILE,U,12,13)=INUM_U_SNUM
189 . . . . S @MAGRY@(MAGCT)="B2^"_MAGFILE
190 . . . . ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
191 . . . . ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
192 ;GEK 4/8/99 MODIFIED, because now we have groups, that some entries
193 ; have dicom numbers and some don't. So we have to go through the group again.
194 ;Test BigGroup - Need a Pre/Post init, that fixes Groups where some entries have Dicom values, and some
195 ; don't. In such a group, we will make Dicom values for the images that don't have them.
196 ; Testing in Washington - this will take hours.
197 ;
198 S I=0
199 F S I=$O(^MAG(2005,MAGIEN,1,I)) Q:'I D
200 . S MAGCHILD=+^MAG(2005,MAGIEN,1,I,0)
201 . I $D(MAGTMPAR(MAGCHILD)) Q
202 . S MAGCT=MAGCT+1
203 . I '$D(^MAG(2005,MAGCHILD)) D INVALID(MAGCHILD,.MSGX) S @MAGRY@(MAGCT)=MSGX Q
204 . ;Added for MAGQI integrity check
205 . K MAGY
206 . D CHKGRPCH^MAGGSQI(.MAGY,MAGIEN,MAGDFN,MAGCHILD) I 'MAGY D INVCH(.MAGY,MAGCHILD) S @MAGRY@(MAGCT)=MAGY Q
207 . S MAGXX=MAGCHILD
208 . D INFO^MAGGTII
209 . S @MAGRY@(MAGCT)="B2^"_MAGFILE
210 . ;Test BigGroup I 'BKG S @MAGRY@(MAGCT)="B2^"_MAGFILE
211 . ;Test BigGroup E S ^TMP("MAGBGRP",MAGIEN,MAGCT)="B2^"_MAGFILE
212 S @MAGRY@(0)="1^"_MAGCT
213 Q
214INVALID(MAGX,MAGZ) ;
215 ;
216 I $D(^MAG(2005.1,MAGX,0)) S MAGZ="B2^"_MAGX_"^^^INVALID Reference to Deleted Image^^66^^^^^^^^"
217 E S MAGZ="B2^"_MAGX_"^^^INVALID Image ID (IEN)^^67^^^^^^^^"
218 ;Added with MAGQI integrity check,
219 S MAGTMPAR(MAGX)=""
220 Q
221INVCH(MSG,CHILD) ;Added for MAGQI integrity check
222 ; MSG is passed by reference, we create a MAGFILE equivalent and pass it back.
223 N EMSG
224 S EMSG=$P(MSG,U,2)
225 K MSG
226 S $P(MSG,U)=CHILD
227 ; remove dependency on c:\program files. with .\bmp\
228 S $P(MSG,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
229 S $P(MSG,U,4)=$P($G(^MAG(2005,CHILD,2)),U,4)
230 S $P(MSG,U,6)=$S(($P(MSG,U,6)'=11):"99",1:11)
231 ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
232 S $P(MSG,U,10)="M"
233 ;Send the error message
234 S $P(MSG,U,17)=EMSG
235 S MSG="B2^"_MSG
236 S MAGTMPAR(CHILD)=""
237 Q
Note: See TracBrowser for help on using the repository browser.