MAGSDHCP ;WOIFO/LB - Routine to delete entries in file 2006.5839 ; 10/08/2003 09:54
;;3.0;IMAGING;**10**;Nov 06, 2003
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
DCMTEMP(RESULT,IMAGE) ;
N DA,DIK,IEN,FILE,ENTRY,IMG
S RESULT="0^Failure could not delete entry from file."
Q:'IMAGE
Q:'$D(^MAG(2005,IMAGE,0))
I $P(^MAG(2005,IMAGE,0),"^",10) D Q
. S RESULT="1^Parent pointer does not need to be resolved."
. ; This should allow code to continue deleting image entry.
. Q
; Can only delete if the image is a group entry.
; Find the DA entry.
S DA=0
S FILE=$P(^MAG(2005,IMAGE,2),"^",6) Q:FILE'=2006.5839
S ENTRY=$P(^MAG(2005,IMAGE,2),"^",7) Q:'ENTRY
I $D(^MAG(2006.5839,"C",123,ENTRY)) D
. S IEN=$O(^MAG(2006.5839,"C",123,ENTRY,0)) Q:'IEN
. Q:'$D(^MAG(2006.5839,IEN,0))
. S IMG=$P(^MAG(2006.5839,IEN,0),"^",3)
. I IMAGE'=IMG S DA=0
. S DA=IEN
. Q
I 'DA S RESULT="0^Entry in file 2006.5839 does not exist" Q
S IEN=DA
S DIK="^MAG(2006.5839," D ^DIK
I '$D(^MAG(2006.5839,IEN,0)) D
. S RESULT="1^Success in deleting entry in file 2006.5839."
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGSDHCP 2060 printed Apr 09, 2024@21:09:30 Page 2
MAGSDHCP ;WOIFO/LB - Routine to delete entries in file 2006.5839 ; 10/08/2003 09:54
+1 ;;3.0;IMAGING;**10**;Nov 06, 2003
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
DCMTEMP(RESULT,IMAGE) ;
+1 NEW DA,DIK,IEN,FILE,ENTRY,IMG
+2 SET RESULT="0^Failure could not delete entry from file."
+3 if 'IMAGE
QUIT
+4 if '$DATA(^MAG(2005,IMAGE,0))
QUIT
+5 IF $PIECE(^MAG(2005,IMAGE,0),"^",10)
Begin DoDot:1
+6 SET RESULT="1^Parent pointer does not need to be resolved."
+7 ; This should allow code to continue deleting image entry.
+8 QUIT
End DoDot:1
QUIT
+9 ; Can only delete if the image is a group entry.
+10 ; Find the DA entry.
+11 SET DA=0
+12 SET FILE=$PIECE(^MAG(2005,IMAGE,2),"^",6)
if FILE'=2006.5839
QUIT
+13 SET ENTRY=$PIECE(^MAG(2005,IMAGE,2),"^",7)
if 'ENTRY
QUIT
+14 IF $DATA(^MAG(2006.5839,"C",123,ENTRY))
Begin DoDot:1
+15 SET IEN=$ORDER(^MAG(2006.5839,"C",123,ENTRY,0))
if 'IEN
QUIT
+16 if '$DATA(^MAG(2006.5839,IEN,0))
QUIT
+17 SET IMG=$PIECE(^MAG(2006.5839,IEN,0),"^",3)
+18 IF IMAGE'=IMG
SET DA=0
+19 SET DA=IEN
+20 QUIT
End DoDot:1
+21 IF 'DA
SET RESULT="0^Entry in file 2006.5839 does not exist"
QUIT
+22 SET IEN=DA
+23 SET DIK="^MAG(2006.5839,"
DO ^DIK
+24 IF '$DATA(^MAG(2006.5839,IEN,0))
Begin DoDot:1
+25 SET RESULT="1^Success in deleting entry in file 2006.5839."
+26 QUIT
End DoDot:1
+27 QUIT
