source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGSDEL2.m@ 1599

Last change on this file since 1599 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1MAGSDEL2 ;WOIFO/SRR/RED - Delete parent pointers ; [ 06/20/2001 08:57 ]
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 ;;
18DELPAR ; delete parent pointers
19 I '$D(^MAG(2005,MAGIEN,2)) S DELMSG="Image IEN doesn't Exist in Image File" G ERROR
20 S MAGTMP=^MAG(2005,MAGIEN,2),MAGSTORE=$P(MAGTMP,"^",6)_":"_$P(MAGTMP,"^",7)_":"_$P(MAGTMP,"^",8)_":"_$P(MAGTMP,"^",10)
21 S MAGPARRT=$P(MAGTMP,"^",6) I MAGPARRT="" G EXIT ;No parent pointer
22 I '$D(^MAG(2005.03,MAGPARRT,0)) S DELMSG="Image Entry has INVALID Pointer to Imaging Parent Data File " G ERROR
23 S MAGPAR=^MAG(2005.03,MAGPARRT,0)
24 S MAGTYP=$P(MAGPAR,"^",3)
25 S MAGPARRT=$P(MAGPAR,"^",4) I MAGPARRT="" S DELMSG="Parent Data File entry is missing field 'File Pointer'" G ERROR
26 S DA=$P(MAGTMP,"^",8) ;G:DA="" ERROR
27 ; /GEK added next 2 lines, comment out G:DA in line above
28 ; this will catch PACS images that don't send IEN of the 2005 Multiple
29 ; in the parent file.
30 N MAGRT,MAGROOT
31 I 'DA,MAGPARRT[2006.5839 S DA=123
32 ; Setting DA to 123 is for the DICOM TEMP file.
33 I 'DA D GETDA^MAGSDEL4(MAGPARRT,$P(MAGTMP,"^",7),MAGIEN,.DA)
34 I 'DA I '$P(^MAG(2005,MAGIEN,0),"^",10) D G ERROR
35 . S DELMSG="Image entry invalid field: PARENT DATA FILE IMAGE POINTER"
36 I 'DA I $P(^MAG(2005,MAGIEN,0),"^",10) G EXIT
37 ;G:'DA ERROR
38 D FILE^DID(MAGPARRT,"","GLOBAL NAME","MAGRT")
39 S MAGROOT=$G(MAGRT("GLOBAL NAME")) Q:MAGROOT=""
40 I MAGTYP<3 S DA(1)=$P(MAGTMP,"^",7),DIK=MAGROOT_DA(1)_",2005," K DA(2) G CHECK
41 S DA(2)=$P(MAGTMP,"^",7),DA(1)=$P(MAGTMP,"^",10)
42 S DIK=MAGROOT_DA(2)_","""_$E($P(MAGPAR,"^",2),1,2)_""","_DA(1)_","_2005_","
43CHECK I DIK'["^" S DELMSG="Can't resolve 'DIK' Global Node. " G ERROR
44 ;I $D(MAGVERB) W !,"Ready to delete ",DIK,DA R !,"ok? ",ANS:DTIME Q:ANS="N"
45 ;if medicine, call medicine api
46 I MAGPARRT>690,MAGPARRT<705 G DELMED
47 ;if TIU goto call TIU api
48 I MAGPARRT=8925 G DELTIU
49 ;if lab, call lab api
50 I MAGPARRT["63" G DELLAB
51 I MAGPARRT["2006.5839" G DELHCP
52 D ^DIK
53 I $D(MAGVERB) W !,"Parent pointer deleted from ",$P(MAGPAR,"^",1),"..."
54EXIT K DA,DA(1),DIK,DA(2) Q
55DELMED ;
56 D KILL^MCUIMAG0(MAGPARRT,DA(1),DA,.MAGSTAT)
57 I +MAGSTAT=1 G EXIT
58 E S DELMSG="Error calling Medicine Routine to Delete Pointer." G ERROR
59 Q
60DELTIU ; Delete the TIU pointers
61 Q:$P(^MAG(2005,MAGIEN,0),"^",10)
62 ; Quit if image is a child of a group.
63 D DELIMAGE^TIUSRVPL(.MAGY,DA(1),MAGIEN)
64 I 'MAGY S DELMSG="Error calling TIU API : "_$P(MAGY,"^",2) G ERROR
65 G EXIT
66DELLAB ; delete lab pointer entries
67 D EN^MAGSDEL3(MAGIEN,.MAGRES)
68 I '+MAGRES S DELMSG="Error calling Lab Routine to Delete Pointer." G ERROR
69 Q
70DELHCP ;Delete the DICOM GMRC TEMP file entry pointers
71 D DCMTEMP^MAGSDHCP(.MAGY,MAGIEN)
72 I '+MAGY S DELMSG=$G(MAGY(0)) G ERROR
73 G EXIT
74ERROR I $D(MAGVERB) W !,"The backwards pointers are not correct. Image pointers cannot be removed from parent file."
75 S MAGERR=1 G EXIT
Note: See TracBrowser for help on using the repository browser.