Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGGTID

MAGGTID.m

Go to the documentation of this file. 
  1. MAGGTID ;WOIFO/SRR/RED/SAF/GEK/SG/JSL/NST - Deletion of Images and Pointers ;
  1.  ;;3.0;IMAGING;**8,59,93,118,150,138,167**;Mar 19, 2002;Build 30;Dec 19, 2016
  1.  ;;
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1. IMAGEDEL(MAGGRY,MAGIEN,MAGGRPDF,REASON) ;RPC [MAGG IMAGE DELETE]
  1.  ; Call to Delete Image entry from Image file ^MAG(2005
  1.  ; MAGIEN   Image IEN ^ SYSDEL flag
  1.  ; MAGGRPDF   group delete flag   1 = group delete allowed
  1.  ; SYSDEL    Flag that forces delete, even if no KEY
  1.  ; 
  1.  N IEN,Y,RY
  1.  ; 1 in 3rd piece means : DELETE the Image File Also.
  1.  S MAGGRPDF=+$G(MAGGRPDF),REASON=$G(REASON),IEN=+MAGIEN
  1.  L +^MAG(2005,IEN):4
  1.  E  S MAGGRY(0)="Image ID# "_IEN_" is Locked. Delete is Canceled" Q
  1.  D DELETE(.MAGGRY,MAGIEN,1,MAGGRPDF,REASON)
  1.  L -^MAG(2005,IEN)
  1.  Q
  1. DELETE(RY,MAGIEN,DF,GRPDF,REASON) ;RPC [MAGQ DIK] Entry point for silent call
  1.  ;RY=Return Array RY(0)="1^SUCCESS" 
  1.  ;                RY(0)="0^reason for failure"
  1.  ;                ;NOT RETURNING LIST AT THIS TIME
  1.  ;                ( RY(1)..RY(n)= IEN's of deleted images.)
  1.  ;MAGIEN=Image entry number to be deleted
  1.  ; if MAGIEN has a 2nd piece = 1 then we force delete, don't test 
  1.  ; for MAG DELETE KEY
  1.  ; if MAGIEN has a 3rd piece,  it's an Xtra PRocessing Flag ;P150
  1.  ; Patch 129 Capture and Patch 135 Import API Now send this flag.  ;P150
  1.  ;DF=Delete file flag - 1=delete the Image file
  1.  ;                    - 0=don't delete the image file
  1.  ;
  1.  S REASON=$G(REASON) I REASON="" S REASON="Unknown reason"
  1.  S RY(0)="0^Image Delete Failed, reason unknown."
  1.  I '$D(MAGSYS) D
  1.  . N Y
  1.  . D GETENV^%ZOSV  ; IA # 10097 
  1.  . S MAGSYS=$P(Y,"^",2)
  1.  . Q
  1.  N MAGERR,SYSDEL,Z,GRPDEL,MAGACN
  1.  N XPRC,NOIMG ; P150
  1.  S XPRC=$$UP^XLFSTR($P(MAGIEN,U,3)) ;P150 The new $p(,,3) says there is XtraPRocessing.
  1.  S SYSDEL=+$P(MAGIEN,U,2),MAGIEN=+MAGIEN
  1.  S NOIMG=$S(XPRC="NOIMAGE":1,1:0) ; P150
  1.  I NOIMG D NOIMAGE(MAGIEN) ;P150
  1.  ; Check the business rules for deleting an image
  1.  I 'NOIMG D DELETE^MAGSIMBR(.RY,MAGIEN,SYSDEL) I +RY(0)=0 Q  ;150 put 'NOIMG
  1.  ;  a couple tests of privilege and valid IEN
  1.  I '$D(^MAG(2005,MAGIEN,0)) D  Q
  1.  . S RY(0)="0^Image entry doesn't exist in image file"
  1.  I +$O(^MAG(2005,MAGIEN,1,0)),+$G(GRPDF)=0 D  Q
  1.  . S RY(0)="0^Deleting a Group is not allowed."
  1.  I +$O(^MAG(2005,MAGIEN,1,0)),+$G(GRPDF)'=0 D  Q
  1.  . N MAGGRP S MAGGRP=MAGIEN N MAGIEN,MAGX,MAGOK,MAGFAIL
  1.  . S MAGX=0,MAGOK=0,MAGFAIL=0
  1.  . S GRPDEL=1  ; we are deleting a group - used in DELGRP entry
  1.  . F  S MAGX=$O(^MAG(2005,MAGGRP,1,MAGX)) Q:'MAGX  D
  1.  . . S MAGIEN=$P($G(^MAG(2005,MAGGRP,1,MAGX,0)),"^") D DEL1IMG
  1.  . . I +RY(0) S Z=+$O(RY(""),-1),RY(Z)=RY(Z)_"^"_RY(0),MAGOK=MAGOK+1
  1.  . . E  S Z=+$O(RY(""),-1)+1,RY(Z)=MAGIEN_"^"_RY(0),MAGFAIL=MAGFAIL+1
  1.  . . Q
  1.  . I +MAGFAIL=0 S RY(0)="1^Deletion of Group #"_MAGGRP_" was successful.^"_MAGOK_"^0"
  1.  . E  S RY(0)="0^Error deleting child image(s). Group Not Deleted.^"_MAGOK_"^"_MAGFAIL
  1.  . I (+MAGFAIL=0),$G(MAGACN)'="" D  ; No errors and Accession number exists
  1.  . . N SSEP,OUT
  1.  . . S SSEP=$$STATSEP^MAGVRS41
  1.  . . D DELNEW^MAGVD008(.OUT,MAGACN,REASON)  ; Delete studies in P34 data structure by accession number
  1.  . . I OUT<0 S RY(0)="0^Deletion of Group #"_MAGGRP_" was successful but failed in New: "_$P(OUT,SSEP,2)
  1.  . . Q
  1.  . Q
  1.  ; Ok lets start
  1.  ; lets delete the parent pointers first.
  1. DEL1IMG ;
  1.  N DELMSG,Z,MAGDFN
  1.  D DELPAR^MAGSDEL2
  1.  I $G(MAGERR) S RY(0)="0^Error: Deleting Specialty Pointers. Image Not Deleted. "_DELMSG Q
  1.  ;
  1.  ; Now delete image record & xref's
  1.  ; if this Image is member of group DELGRP will delete those pointers
  1.  ; and delete the Group, if this is only image in it.
  1.  S MAGDFN=$P($G(^MAG(2005,MAGIEN,0)),"^",7) ; Moved here from below. DELGRP needs MAGDFN now.
  1.  D DELGRP
  1.  I $G(MAGERR) S RY(0)="0^Error deleting Group Pointers." Q
  1.  ;
  1.  ; write the deleted by, delete reason, and delete date to the file.
  1.  ; P150   If NOIMAGE,  SetDel was already called.
  1.  I 'NOIMG D SETDEL(MAGIEN,REASON) ;P150 NOIMG
  1.  ;
  1.  ; save the Image record to the archive before we delete it.
  1.  D ARCHIVE(MAGIEN)
  1.  ;
  1.  ; Now let's set the Queue to delete the Image File, if Flag is set
  1.  I $G(DF) D DELFILE
  1.  ; 
  1.  ; we're having "APPXDT" crossref left around, lets delete it first.
  1.  S X=MAGDFN,DA=MAGIEN D KILPPXD^MAGUXRF
  1.  ;
  1.  ; now lets delete the image.
  1.  K DIK,DA,DA(1),DA(2),DIC,DR,DIE,DIR S DIK="^MAG(2005,",DA=MAGIEN
  1.  D ^DIK
  1.  S Z=+$O(RY(""),-1)+1,RY(Z)=MAGIEN
  1.  ; we were having problems with "AC" so lets check to make sure.
  1.  I $D(^MAG(2005,"AC",MAGDFN,MAGIEN)) K ^MAG(2005,"AC",MAGDFN,MAGIEN)
  1.  ; log it.
  1.  S X=$S(NOIMG:"NOIMAGE",1:"DELETE") ; P150 NOIMG
  1.  D ENTRY^MAGLOG(X,$G(DUZ),$G(MAGIEN),"PARENT:"_$G(MAGSTORE),$G(MAGDFN),1) ;P150
  1.  S X=$S(NOIMG:"NOIMAGE^",1:"DEL^") ; 150 NOIMG
  1.  S X=X_$G(MAGDFN)_"^"_$G(MAGIEN) ; 150 use X instead of "DEL^"
  1.  D ACTION^MAGGTAU(X,"1")
  1.  ; The 140 cross reference of 2005.1 has set the Status to 12,  here we change it to 13 ;P150
  1.  I NOIMG D SETSTAT(MAGIEN,13) ;P150
  1.  S RY(0)="1^Deletion of Image was Successful." ;P150 
  1.  ; P150 Put above line back in.  Code below is new for 118.
  1.  I '$G(GRPDEL),$G(MAGACN)'="" D  ; If we delete a single image in a group and ACN is defined
  1.  . N SSEP,OUT
  1.  . S SSEP=$$STATSEP^MAGVRS41
  1.  . D DELNEW^MAGVD008(.OUT,MAGACN,REASON)  ; Delete studies in P34 data structure by accession number
  1.  . I OUT<0 S RY(0)="0^Deletion of Image in Legacy was Successful but failed in New: "_$P(OUT,SSEP,2)
  1.  . E  S RY(0)="1^Deletion of Image was Successful."
  1.  . Q
  1.  Q
  1. NOIMAGE(MAGNOT) ; P150 Whole function is new. This is called when No Image exists.
  1.  ; Clear the Fields #2,  #2.1 and 102 This is the Abstract, Full and BIG
  1.  ;   pointers to the Image Share (Image Network Drive) ( Tier1 ) 
  1.  ; Set Status and Status Reason
  1.  ; Set SysDel and GrpDel Flags to allow deleting in all instances.
  1.  N MAGNFDA,MAGGXE,MAGERR,REASDESC,REASDA,MAGDA
  1.  S REASDESC="Image Never Existed"
  1.  S REASDA=$O(^MAG(2005.88,"B",REASDESC,""))
  1.  D SETDEL(MAGNOT,REASDESC) ; Set the Delete Fields. 
  1.  ;
  1.  S MAGDA=MAGNOT
  1.  S MAGNOT=MAGNOT_","
  1.  S MAGNFDA(2005,MAGNOT,2)="@" ;
  1.  S MAGNFDA(2005,MAGNOT,2.1)="@"
  1.  S MAGNFDA(2005,MAGNOT,102)="@"
  1.  S MAGNFDA(2005,MAGNOT,113)=13
  1.  S MAGNFDA(2005,MAGNOT,113.3)=REASDA
  1.  ;;;;;;;
  1.  D UPDATE^DIE("","MAGNFDA","","MAGGXE")
  1.  ;  ? ? If Error during UPdate..  Delete the entry.
  1.  I $D(DIERR) D  S RY=MAGERR Q
  1.  . D RTRNERR(.MAGERR)
  1.  . S DA=MAGDA,DIK="^MAG(2005," D ^DIK
  1.  . K DA,DIC,DIK
  1.  . D CLEAN^DILF
  1.  Q
  1. RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
  1.  ; P150 this function put in to keep NOIMAGE same
  1.  S ETXT="0^ERROR  "_MAGGXE("DIERR",1,"TEXT",1)
  1.  Q
  1. DELGRP ;del grp ptrs and check to see if this is the last image in the group
  1.  N MAGGRP,MAGX,MAGQUIT,MAGIFNS,Z
  1.  S MAGGRP=$P($G(^MAG(2005,MAGIEN,0)),"^",10)
  1.  Q:'$G(MAGGRP)
  1.  K DIK,DA,DA(1),DA(2),DIC,DR,DIE,DIR
  1.  S MAGX=0,MAGQUIT=0
  1.  F  S MAGX=$O(^MAG(2005,MAGGRP,1,MAGX)) Q:'MAGX  D  Q:MAGQUIT
  1.  . I +^MAG(2005,MAGGRP,1,MAGX,0)=MAGIEN D
  1.  . . S DIK="^MAG(2005,MAGGRP,1,",DA(1)=MAGGRP,DA=MAGX D ^DIK S MAGQUIT=1
  1.  . . ;added DA(1) needed for xref deletion of dicom series 
  1.  . I $O(^MAG(2005,MAGGRP,1,0))="" D
  1.  . . I $P($G(^MAG(2005,MAGGRP,2)),"^",6) D
  1.  . . . ;report is on group - need to delete it
  1.  . . . S MAGIFNS=MAGIEN,MAGIEN=MAGGRP
  1.  . . . D DELPAR^MAGSDEL2
  1.  . . . S MAGIEN=MAGIFNS
  1.  . . I '$D(MAGERR) D
  1.  . . . I $T(^MAGVD003)'="" D  ; This check needs to be removed after release of patch 118
  1.  . . . . N OUT
  1.  . . . . D GETACN^MAGVD003(.OUT,MAGGRP)  ; Get accession number for this group first
  1.  . . . . S MAGACN=$S($$ISOK^MAGVAF02(OUT):$$GETVAL^MAGVAF02(OUT),1:"")
  1.  . . . . Q
  1.  . . . D SETDEL(MAGGRP,REASON),ARCHIVE(MAGGRP) S DIK="^MAG(2005,",DA=MAGGRP D ^DIK
  1.  . . . ; Log the Deletion of The Group Header to  ^MAG(2006.95, and ^MAG(2006.82 
  1.  . . . D ENTRY^MAGLOG("DELETE",$G(DUZ),$G(MAGGRP),"PARENT:"_$G(MAGSTORE),$G(MAGDFN),1,"Group Header deleted")
  1.  . . . S X="DEL^"_$G(MAGDFN)_"^"_$G(MAGGRP)
  1.  . . . D ACTION^MAGGTAU(X,"1")
  1.  . . . S Z=+$O(RY(""),-1)+1,RY(Z)=MAGGRP_"^1^Deletion of Group was Successful."
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  Q
  1. SETDEL(MAGIEN,REASON) ; set deletion fields
  1.  N DA,DR,DIE,X
  1.  ;N %H
  1.  ;S %H=$H D YMD^%DTC
  1.  S X=$$NOW^XLFDT
  1.  ;  gek - changed 3 slash to 4 slash. to stop FM question marks. ??
  1.  S DR="30////"_DUZ_";30.1////"_X_";30.2////"_REASON
  1.  S DIE="2005",DA=MAGIEN D ^DIE
  1.  Q
  1.  ;
  1. SETSTAT(MAGIEN,STAT) ; p150 new function.  Set STATUS fields
  1.  N DA,DR,DIE
  1.  ; 4 slash. to stop FM question marks. ??
  1.  S DR="113////"_STAT
  1.  S DIE="2005.1",DA=MAGIEN D ^DIE
  1.  Q
  1. ARCHIVE(MAGARCIE) ;save image data before deletion
  1.  N DA,DIK,MAGCNT,MAGLAST,SUB,TMP,%X,%Y
  1.  S MAGCNT=$P(^MAG(2005.1,0),U,4)+1
  1.  S %X="^MAG(2005,"_MAGARCIE_",",%Y="^MAG(2005.1,"_MAGARCIE_","
  1.  D %XY^%RCR
  1.  ;--- GEK 9/29/00 Fix the 3rd piece to be last IEN in file.
  1.  S MAGLAST=$O(^MAG(2005.1,"A"),-1)
  1.  S $P(^MAG(2005.1,0),U,4)=MAGCNT
  1.  I '($P(^MAG(2005.1,0),U,3)=MAGLAST) S $P(^MAG(2005.1,0),U,3)=MAGLAST
  1.  ;
  1.  ;--- Fix subfile numbers in the headers of the multiples (MAG*3*93).
  1.  ;    IF DEFINITIONS OF MULTIPLES OF THE IMAGE AUDIT FILE (#2005.1)
  1.  ;    CHANGE OR NEW MULTIPLES ARE ADDED, THE FOLLOWING CODE MUST BE
  1.  ;--- CHECKED AND UPDATED IF NECESSARY!
  1.  ;
  1.  F SUB="1^2005.14P","4^2005.1106DA","5^2005.11PA","6^2005.1111A","99^2005.199D"  D
  1.  . S TMP=$P(SUB,U)  Q:'($D(^MAG(2005.1,MAGARCIE,TMP,0))#2)
  1.  . S $P(^MAG(2005.1,MAGARCIE,TMP,0),U,2)=$P(SUB,U,2)
  1.  . Q
  1.  ;
  1.  ;--- Create cross-reference entries for the entry
  1.  S DA=MAGARCIE
  1.  S DIK="^MAG(2005.1," D IX1^DIK
  1.  Q
  1. DELFILE ;Delete image file on server if exists 
  1.  ;gek 3/21/2003  Changed to stop using FullRes Path for Abs,Big
  1.  ;   and only Delete .TXT and Alternates if Full is being deleted.
  1.  N X0,X1,X2,ALTEXT,ALTPATH,MAGXX,XBIG,MAGFILE2
  1.  N MAGPLC ; DBI - SEB 9/20/2002
  1.  ; MAGIEN IS ASSUMED TO BE DEFINED.
  1.  ; MAGXX         - This is IEN in ^MAG(2005, MAGFILEB Expects this to be defined.
  1.  ; MAGPLC        - "Place" of Full Res Image.  
  1.  ; ALTEXT        - Extension of the Alternate image file.
  1.  ; ALTPATH       - Full path of Alternate image file.
  1.  S X0=^MAG(2005,MAGIEN,0)
  1.  ;delete Full Res if one exists on Magnetic
  1.  I $P(X0,U,3) D
  1.  . S MAGXX=MAGIEN
  1.  . S MAGPLC=$$DA2PLC^MAGBAPIP(MAGIEN,"F")
  1.  . D VSTNOCP^MAGFILEB
  1.  . S X=$$DELETE^MAGBAPI(MAGFILE2,MAGPLC)
  1.  . ;Delete any other ALTernate files. ( TXT) 
  1.  . ;gek 3/31/03  Since ALT files are (for now) always on same server as Full
  1.  . ;    We only attempt to delete them here  (If we have a path to FullRes on Magnetic)
  1.  . S X2=0
  1.  . F  S X2=$O(^MAG(2006.1,MAGPLC,2,X2)) Q:'X2  D
  1.  . . S ALTEXT=$P(^MAG(2006.1,MAGPLC,2,X2,0),"^",1)             ;CR1023
  1.  . . S ALTPATH=MAGFILE2,$P(ALTPATH,".",$L(ALTPATH,"."))=ALTEXT ;CR1023 for FQDN issue
  1.  . . S X=$$DELETE^MAGBAPI(ALTPATH,MAGPLC)
  1.  . Q
  1.  ;
  1.  ;delete image abstract if one exists on Magnetic
  1.  I $P(X0,U,4) D
  1.  . S MAGXX=MAGIEN
  1.  . D ABSNOCP^MAGFILEB
  1.  . S X=$$DELETE^MAGBAPI(MAGFILE2,$$DA2PLC^MAGBAPIP(MAGIEN,"A")) ; DBI - SEB 9/20/2002
  1.  ;
  1.  ;delete the big file if one exists on Magnetic
  1.  S XBIG=$G(^MAG(2005,MAGIEN,"FBIG"))
  1.  I $P(XBIG,U) D 
  1.  . S MAGXX=MAGIEN
  1.  . D BIGNOCP^MAGFILEB
  1.  . S X=$$DELETE^MAGBAPI(MAGFILE2,$$DA2PLC^MAGBAPIP(MAGIEN,"B")) ; DBI - SEB 9/20/2002
  1.  Q