| 1 | MAGSDHCP ;WOIFO/LB - Routine to delete entries in file 2006.5839 ; 10/08/2003  09:54
 | 
|---|
| 2 |  ;;3.0;IMAGING;**10**;Nov 06, 2003
 | 
|---|
| 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
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 | DCMTEMP(RESULT,IMAGE) ;
 | 
|---|
| 21 |  N DA,DIK,IEN,FILE,ENTRY,IMG
 | 
|---|
| 22 |  S RESULT="0^Failure could not delete entry from file."
 | 
|---|
| 23 |  Q:'IMAGE
 | 
|---|
| 24 |  Q:'$D(^MAG(2005,IMAGE,0))
 | 
|---|
| 25 |  I $P(^MAG(2005,IMAGE,0),"^",10) D  Q
 | 
|---|
| 26 |  . S RESULT="1^Parent pointer does not need to be resolved."
 | 
|---|
| 27 |  . ; This should allow code to continue deleting image entry.
 | 
|---|
| 28 |  . Q
 | 
|---|
| 29 |  ; Can only delete if the image is a group entry.
 | 
|---|
| 30 |  ; Find the DA entry. 
 | 
|---|
| 31 |  S DA=0
 | 
|---|
| 32 |  S FILE=$P(^MAG(2005,IMAGE,2),"^",6) Q:FILE'=2006.5839
 | 
|---|
| 33 |  S ENTRY=$P(^MAG(2005,IMAGE,2),"^",7) Q:'ENTRY
 | 
|---|
| 34 |  I $D(^MAG(2006.5839,"C",123,ENTRY)) D
 | 
|---|
| 35 |  . S IEN=$O(^MAG(2006.5839,"C",123,ENTRY,0)) Q:'IEN
 | 
|---|
| 36 |  . Q:'$D(^MAG(2006.5839,IEN,0))
 | 
|---|
| 37 |  . S IMG=$P(^MAG(2006.5839,IEN,0),"^",3)
 | 
|---|
| 38 |  . I IMAGE'=IMG S DA=0
 | 
|---|
| 39 |  . S DA=IEN
 | 
|---|
| 40 |  . Q
 | 
|---|
| 41 |  I 'DA S RESULT="0^Entry in file 2006.5839 does not exist" Q
 | 
|---|
| 42 |  S IEN=DA
 | 
|---|
| 43 |  S DIK="^MAG(2006.5839," D ^DIK
 | 
|---|
| 44 |  I '$D(^MAG(2006.5839,IEN,0)) D
 | 
|---|
| 45 |  . S RESULT="1^Success in deleting entry in file 2006.5839."
 | 
|---|
| 46 |  . Q
 | 
|---|
| 47 |  Q
 | 
|---|