| [613] | 1 | MAGSDEL2 ;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 | ;;
|
|---|
| 18 | DELPAR ; 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_","
|
|---|
| 43 | CHECK 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),"..."
|
|---|
| 54 | EXIT K DA,DA(1),DIK,DA(2) Q
|
|---|
| 55 | DELMED ;
|
|---|
| 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
|
|---|
| 60 | DELTIU ; 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
|
|---|
| 66 | DELLAB ; 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
|
|---|
| 70 | DELHCP ;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
|
|---|
| 74 | ERROR I $D(MAGVERB) W !,"The backwards pointers are not correct. Image pointers cannot be removed from parent file."
|
|---|
| 75 | S MAGERR=1 G EXIT
|
|---|
