source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTID.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: 8.0 KB
Line 
1MAGGTID ;WOIFO/SRR/RED/SAF/GEK - Deletion of Images and Pointers ; [ 06/20/2001 08:56 ]
2 ;;3.0;IMAGING;**8,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 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20 ;
21IMAGEDEL(MAGGRY,MAGIEN,MAGGRPDF,REASON) ;RPC [MAGG IMAGE DELETE]
22 ; Call to Delete Image entry from Image file ^MAG(2005
23 ; MAGIEN Image IEN ^ SYSDEL flag
24 ; MAGGRPDF group delete flag 1 = group delete allowed
25 ; SYSDEL Flag that forces delete, even if no KEY
26 ;
27 N Y,RY
28 ; 1 in 3rd piece means : DELETE the Image File Also.
29 S MAGGRPDF=+$G(MAGGRPDF),REASON=$G(REASON)
30 L +^MAG(2005,MAGIEN):4
31 E S MAGGRY(0)="Image ID# "_MAGIEN_" is Locked. Delete is Canceled" Q
32 D DELETE(.MAGGRY,MAGIEN,1,MAGGRPDF,REASON)
33 L -^MAG(2005,MAGIEN)
34 Q
35DELETE(RY,MAGIEN,DF,GRPDF,REASON) ;RPC [MAGQ DIK] Entry point for silent call
36 ;RY=Return Array RY(0)="1^SUCCESS"
37 ; RY(0)="0^reason for failure"
38 ; ;NOT RETURNING LIST AT THIS TIME
39 ; ( RY(1)..RY(n)= IEN's of deleted images.)
40 ;MAGIEN=Image entry number to be deleted
41 ; if MAGIEN has a 2nd piece = 1 then we force delete, don't test
42 ; for MAG DELETE KEY
43 ;DF=Delete file flag - 1=delete the Image file
44 ; - 0=don't delete the image file
45 ;
46 S REASON=$G(REASON) I REASON="" S REASON="Unknown reason"
47 S RY(0)="0^Image Delete Failed, reason unknown."
48 S:'$D(MAGSYS) MAGSYS=^%ZOSF("VOL")
49 N MAGERR,SYSDEL,Z
50 S SYSDEL=+$P(MAGIEN,U,2)
51 ; Check the business rules for deleting an image
52 D DELETE^MAGSIMBR(.RY,MAGIEN,SYSDEL) I +RY(0)=0 Q
53 S MAGIEN=+MAGIEN
54 ; a couple tests of privilage and valid IEN
55 I '$D(^MAG(2005,MAGIEN,0)) D Q
56 . S RY(0)="0^Image entry doesn't exist in image file"
57 I +$O(^MAG(2005,MAGIEN,1,0)),+$G(GRPDF)=0 D Q
58 . S RY(0)="0^Deleting a Group is not allowed."
59 I +$O(^MAG(2005,MAGIEN,1,0)),+$G(GRPDF)'=0 D Q
60 . N MAGGRP S MAGGRP=MAGIEN N MAGIEN,MAGX,MAGOK,MAGFAIL
61 . S MAGX=0,MAGOK=0,MAGFAIL=0
62 . F S MAGX=$O(^MAG(2005,MAGGRP,1,MAGX)) Q:'MAGX D
63 . . S MAGIEN=$P($G(^MAG(2005,MAGGRP,1,MAGX,0)),"^") D DEL1IMG
64 . . I +RY(0) S Z=+$O(RY(""),-1),RY(Z)=RY(Z)_"^"_RY(0),MAGOK=MAGOK+1
65 . . E S Z=+$O(RY(""),-1)+1,RY(Z)=MAGIEN_"^"_RY(0),MAGFAIL=MAGFAIL+1
66 . . Q
67 . I +MAGFAIL=0 S RY(0)="1^Deletion of Group #"_MAGGRP_" was successful.^"_MAGOK_"^0"
68 . E S RY(0)="0^Error deleting child image(s). Group Not Deleted.^"_MAGOK_"^"_MAGFAIL
69 . Q
70 ;
71 ; Ok lets start
72 ; lets delete the parent pointers first.
73DEL1IMG ;
74 N DELMSG,Z
75 D DELPAR^MAGSDEL2
76 I $G(MAGERR) S RY(0)="0^Error: Deleting Specialty Pointers. Image Not Deleted. "_DELMSG Q
77 ;
78 ; Now delete image record & xref's
79 ; if this Image is member of group DELGRP will delete those pointers
80 ; and delete the Group, if this is only image in it.
81 S MAGDFN=$P($G(^MAG(2005,MAGIEN,0)),"^",7) ; Moved here from below. DELGRP needs MAGDFN now.
82 D DELGRP
83 I $G(MAGERR) S RY(0)="0^Error deleting Group Pointers." Q
84 ;
85 ; write the deleted by, delete reason, and delete date to the file.
86 D SETDEL(MAGIEN,REASON)
87 ;
88 ; save the Image record to the archive before we delete it.
89 D ARCHIVE(MAGIEN)
90 ;
91 ; Now let's set the Queue to delete the Image File, if Flag is set
92 I $G(DF) D DELFILE
93 ;
94 ; we're having "APPXDT" crossref left around, lets delete it first.
95 S X=MAGDFN,DA=MAGIEN D KILPPXD^MAGUXRF
96 ;
97 ; now lets delete the image.
98 K DIK,DA,DA(1),DA(2),DIC,DR,DIE,DIR S DIK="^MAG(2005,",DA=MAGIEN
99 D ^DIK
100 S Z=+$O(RY(""),-1)+1,RY(Z)=MAGIEN
101 ; we were having problems with "AC" so lets check to make sure.
102 I $D(^MAG(2005,"AC",MAGDFN,MAGIEN)) K ^MAG(2005,"AC",MAGDFN,MAGIEN)
103 ; log it.
104 D ENTRY^MAGLOG("DELETE",$G(DUZ),$G(MAGIEN),"PARENT:"_$G(MAGSTORE),$G(MAGDFN),1)
105 S X="DEL^"_$G(MAGDFN)_"^"_$G(MAGIEN)
106 D ACTION^MAGGTAU(X,"1")
107 S RY(0)="1^Deletion of Image was Successful."
108 Q
109DELGRP ;del grp ptrs and check to see if this is the last image in the group
110 N MAGGRP,MAGX,MAGQUIT,MAGIFNS,Z
111 S MAGGRP=$P($G(^MAG(2005,MAGIEN,0)),"^",10)
112 Q:'$G(MAGGRP)
113 K DIK,DA,DA(1),DA(2),DIC,DR,DIE,DIR
114 S MAGX=0,MAGQUIT=0
115 F S MAGX=$O(^MAG(2005,MAGGRP,1,MAGX)) Q:'MAGX D Q:MAGQUIT
116 . I +^MAG(2005,MAGGRP,1,MAGX,0)=MAGIEN D
117 . . S DIK="^MAG(2005,MAGGRP,1,",DA(1)=MAGGRP,DA=MAGX D ^DIK S MAGQUIT=1
118 . . ;added DA(1) needed for xref deletion of dicom series
119 . I $O(^MAG(2005,MAGGRP,1,0))="" D
120 . . I $P($G(^MAG(2005,MAGGRP,2)),"^",6) D
121 . . . ;report is on group - need to delete it
122 . . . S MAGIFNS=MAGIEN,MAGIEN=MAGGRP
123 . . . D DELPAR^MAGSDEL2
124 . . . S MAGIEN=MAGIFNS
125 . . I '$D(MAGERR) D
126 . . . D SETDEL(MAGGRP,REASON),ARCHIVE(MAGGRP) S DIK="^MAG(2005,",DA=MAGGRP D ^DIK
127 . . . ; Log the Deletion of The Group Header to ^MAG(2006.95, and ^MAG(2006.82
128 . . . D ENTRY^MAGLOG("DELETE",$G(DUZ),$G(MAGGRP),"PARENT:"_$G(MAGSTORE),$G(MAGDFN),1,"Group Header deleted")
129 . . . S X="DEL^"_$G(MAGDFN)_"^"_$G(MAGGRP)
130 . . . D ACTION^MAGGTAU(X,"1")
131 . . . S Z=+$O(RY(""),-1)+1,RY(Z)=MAGGRP_"^1^Deletion of Group was Successful."
132 . . . Q
133 . . Q
134 . Q
135 Q
136SETDEL(MAGIEN,REASON) ; set deletion fields
137 N DA,DR,DIE,X
138 ;N %H
139 ;S %H=$H D YMD^%DTC
140 S X=$$NOW^XLFDT
141 ; gek - changed 3 slash to 4 slash. to stop FM question marks. ??
142 S DR="30////"_DUZ_";30.1////"_X_";30.2////"_REASON
143 S DIE="2005",DA=MAGIEN D ^DIE
144 Q
145 ;
146ARCHIVE(MAGARCIE) ;save image data before deletion
147 N MAGCNT,MAGLAST,%X,%Y
148 S MAGCNT=$P(^MAG(2005.1,0),U,4)+1
149 S %X="^MAG(2005,"_MAGARCIE_",",%Y="^MAG(2005.1,"_MAGARCIE_","
150 D %XY^%RCR
151 ; GEK 9/29/00 Fix the 3rd piece to be last ien in file.
152 S MAGLAST=$O(^MAG(2005.1,"A"),-1)
153 S $P(^MAG(2005.1,0),U,4)=MAGCNT
154 I '($P(^MAG(2005.1,0),U,3)=MAGLAST) S $P(^MAG(2005.1,0),U,3)=MAGLAST
155 S DA=MAGARCIE
156 S DIK="^MAG(2005.1," D IX1^DIK
157 Q
158DELFILE ;Delete image file on server if exists
159 ;gek 3/21/2003 Changed to stop using FullRes Path for Abs,Big
160 ; and only Delete .TXT and Alternates if Full is being deleted.
161 N X0,X1,X2,ALTEXT,ALTPATH,MAGXX,XBIG
162 N MAGPLC ; DBI - SEB 9/20/2002
163 ; MAGIEN IS ASSUMED TO BE DEFINED.
164 ; MAGXX - This is IEN in ^MAG(2005, MAGFILEB Expects this to be defined.
165 ; MAGPLC - "Place" of Full Res Image.
166 ; ALTEXT - Extension of the Alternate image file.
167 ; ALTPATH - Full path of Alternate image file.
168 S X0=^MAG(2005,MAGIEN,0)
169 ;delete Full Res if one exists on Magnetic
170 I $P(X0,U,3) D
171 . S MAGXX=MAGIEN
172 . S MAGPLC=$$DA2PLC^MAGBAPIP(MAGIEN,"F")
173 . D VSTNOCP^MAGFILEB
174 . S X=$$DELETE^MAGBAPI(MAGFILE2,MAGPLC)
175 . ;Delete any other ALTernate files. ( TXT)
176 . ;gek 3/31/03 Since ALT files are (for now) always on same server as Full
177 . ; We only attempt to delete them here (If we have a path to FullRes on Magnetic)
178 . S X2=0
179 . F S X2=$O(^MAG(2006.1,MAGPLC,2,X2)) Q:'X2 D
180 . . S ALTEXT=^MAG(2006.1,MAGPLC,2,X2,0)
181 . . S ALTPATH=$P(MAGFILE2,".")_"."_ALTEXT
182 . . S X=$$DELETE^MAGBAPI(ALTPATH,MAGPLC)
183 . Q
184 ;
185 ;delete image abstract if one exists on Magnetic
186 I $P(X0,U,4) D
187 . S MAGXX=MAGIEN
188 . D ABSNOCP^MAGFILEB
189 . S X=$$DELETE^MAGBAPI(MAGFILE2,$$DA2PLC^MAGBAPIP(MAGIEN,"A")) ; DBI - SEB 9/20/2002
190 ;
191 ;delete the big file if one exists on Magnetic
192 S XBIG=$G(^MAG(2005,MAGIEN,"FBIG"))
193 I $P(XBIG,U) D
194 . S MAGXX=MAGIEN
195 . D BIGNOCP^MAGFILEB
196 . S X=$$DELETE^MAGBAPI(MAGFILE2,$$DA2PLC^MAGBAPIP(MAGIEN,"B")) ; DBI - SEB 9/20/2002
197 Q
Note: See TracBrowser for help on using the repository browser.