| 1 | MAGGTID ;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 | ;
|
|---|
| 21 | IMAGEDEL(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
|
|---|
| 35 | DELETE(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.
|
|---|
| 73 | DEL1IMG ;
|
|---|
| 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
|
|---|
| 109 | DELGRP ;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
|
|---|
| 136 | SETDEL(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 | ;
|
|---|
| 146 | ARCHIVE(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
|
|---|
| 158 | DELFILE ;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
|
|---|
