MAGSDEL2 ;WOIFO/SRR/RED - Delete parent pointers ; [ 06/20/2001 08:57 ]
;;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. |
;; +---------------------------------------------------------------+
;;
DELPAR ; delete parent pointers
I '$D(^MAG(2005,MAGIEN,2)) S DELMSG="Image IEN doesn't Exist in Image File" G ERROR
S MAGTMP=^MAG(2005,MAGIEN,2),MAGSTORE=$P(MAGTMP,"^",6)_":"_$P(MAGTMP,"^",7)_":"_$P(MAGTMP,"^",8)_":"_$P(MAGTMP,"^",10)
S MAGPARRT=$P(MAGTMP,"^",6) I MAGPARRT="" G EXIT ;No parent pointer
I '$D(^MAG(2005.03,MAGPARRT,0)) S DELMSG="Image Entry has INVALID Pointer to Imaging Parent Data File " G ERROR
S MAGPAR=^MAG(2005.03,MAGPARRT,0)
S MAGTYP=$P(MAGPAR,"^",3)
S MAGPARRT=$P(MAGPAR,"^",4) I MAGPARRT="" S DELMSG="Parent Data File entry is missing field 'File Pointer'" G ERROR
S DA=$P(MAGTMP,"^",8) ;G:DA="" ERROR
; /GEK added next 2 lines, comment out G:DA in line above
; this will catch PACS images that don't send IEN of the 2005 Multiple
; in the parent file.
N MAGRT,MAGROOT
I 'DA,MAGPARRT[2006.5839 S DA=123
; Setting DA to 123 is for the DICOM TEMP file.
I 'DA D GETDA^MAGSDEL4(MAGPARRT,$P(MAGTMP,"^",7),MAGIEN,.DA)
I 'DA I '$P(^MAG(2005,MAGIEN,0),"^",10) D G ERROR
. S DELMSG="Image entry invalid field: PARENT DATA FILE IMAGE POINTER"
I 'DA I $P(^MAG(2005,MAGIEN,0),"^",10) G EXIT
;G:'DA ERROR
D FILE^DID(MAGPARRT,"","GLOBAL NAME","MAGRT")
S MAGROOT=$G(MAGRT("GLOBAL NAME")) Q:MAGROOT=""
I MAGTYP<3 S DA(1)=$P(MAGTMP,"^",7),DIK=MAGROOT_DA(1)_",2005," K DA(2) G CHECK
S DA(2)=$P(MAGTMP,"^",7),DA(1)=$P(MAGTMP,"^",10)
S DIK=MAGROOT_DA(2)_","""_$E($P(MAGPAR,"^",2),1,2)_""","_DA(1)_","_2005_","
CHECK I DIK'["^" S DELMSG="Can't resolve 'DIK' Global Node. " G ERROR
;I $D(MAGVERB) W !,"Ready to delete ",DIK,DA R !,"ok? ",ANS:DTIME Q:ANS="N"
;if medicine, call medicine api
I MAGPARRT>690,MAGPARRT<705 G DELMED
;if TIU goto call TIU api
I MAGPARRT=8925 G DELTIU
;if lab, call lab api
I MAGPARRT["63" G DELLAB
I MAGPARRT["2006.5839" G DELHCP
D ^DIK
I $D(MAGVERB) W !,"Parent pointer deleted from ",$P(MAGPAR,"^",1),"..."
EXIT K DA,DA(1),DIK,DA(2) Q
DELMED ;
D KILL^MCUIMAG0(MAGPARRT,DA(1),DA,.MAGSTAT)
I +MAGSTAT=1 G EXIT
E S DELMSG="Error calling Medicine Routine to Delete Pointer." G ERROR
Q
DELTIU ; Delete the TIU pointers
Q:$P(^MAG(2005,MAGIEN,0),"^",10)
; Quit if image is a child of a group.
D DELIMAGE^TIUSRVPL(.MAGY,DA(1),MAGIEN)
I 'MAGY S DELMSG="Error calling TIU API : "_$P(MAGY,"^",2) G ERROR
G EXIT
DELLAB ; delete lab pointer entries
D EN^MAGSDEL3(MAGIEN,.MAGRES)
I '+MAGRES S DELMSG="Error calling Lab Routine to Delete Pointer." G ERROR
Q
DELHCP ;Delete the DICOM GMRC TEMP file entry pointers
D DCMTEMP^MAGSDHCP(.MAGY,MAGIEN)
I '+MAGY S DELMSG=$G(MAGY(0)) G ERROR
G EXIT
ERROR I $D(MAGVERB) W !,"The backwards pointers are not correct. Image pointers cannot be removed from parent file."
S MAGERR=1 G EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGSDEL2 3864 printed Dec 13, 2024@02:08:11 Page 2
MAGSDEL2 ;WOIFO/SRR/RED - Delete parent pointers ; [ 06/20/2001 08:57 ]
+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 ;;
DELPAR ; delete parent pointers
+1 IF '$DATA(^MAG(2005,MAGIEN,2))
SET DELMSG="Image IEN doesn't Exist in Image File"
GOTO ERROR
+2 SET MAGTMP=^MAG(2005,MAGIEN,2)
SET MAGSTORE=$PIECE(MAGTMP,"^",6)_":"_$PIECE(MAGTMP,"^",7)_":"_$PIECE(MAGTMP,"^",8)_":"_$PIECE(MAGTMP,"^",10)
+3 ;No parent pointer
SET MAGPARRT=$PIECE(MAGTMP,"^",6)
IF MAGPARRT=""
GOTO EXIT
+4 IF '$DATA(^MAG(2005.03,MAGPARRT,0))
SET DELMSG="Image Entry has INVALID Pointer to Imaging Parent Data File "
GOTO ERROR
+5 SET MAGPAR=^MAG(2005.03,MAGPARRT,0)
+6 SET MAGTYP=$PIECE(MAGPAR,"^",3)
+7 SET MAGPARRT=$PIECE(MAGPAR,"^",4)
IF MAGPARRT=""
SET DELMSG="Parent Data File entry is missing field 'File Pointer'"
GOTO ERROR
+8 ;G:DA="" ERROR
SET DA=$PIECE(MAGTMP,"^",8)
+9 ; /GEK added next 2 lines, comment out G:DA in line above
+10 ; this will catch PACS images that don't send IEN of the 2005 Multiple
+11 ; in the parent file.
+12 NEW MAGRT,MAGROOT
+13 IF 'DA
IF MAGPARRT[2006.5839
SET DA=123
+14 ; Setting DA to 123 is for the DICOM TEMP file.
+15 IF 'DA
DO GETDA^MAGSDEL4(MAGPARRT,$PIECE(MAGTMP,"^",7),MAGIEN,.DA)
+16 IF 'DA
IF '$PIECE(^MAG(2005,MAGIEN,0),"^",10)
Begin DoDot:1
+17 SET DELMSG="Image entry invalid field: PARENT DATA FILE IMAGE POINTER"
End DoDot:1
GOTO ERROR
+18 IF 'DA
IF $PIECE(^MAG(2005,MAGIEN,0),"^",10)
GOTO EXIT
+19 ;G:'DA ERROR
+20 DO FILE^DID(MAGPARRT,"","GLOBAL NAME","MAGRT")
+21 SET MAGROOT=$GET(MAGRT("GLOBAL NAME"))
if MAGROOT=""
QUIT
+22 IF MAGTYP<3
SET DA(1)=$PIECE(MAGTMP,"^",7)
SET DIK=MAGROOT_DA(1)_",2005,"
KILL DA(2)
GOTO CHECK
+23 SET DA(2)=$PIECE(MAGTMP,"^",7)
SET DA(1)=$PIECE(MAGTMP,"^",10)
+24 SET DIK=MAGROOT_DA(2)_","""_$EXTRACT($PIECE(MAGPAR,"^",2),1,2)_""","_DA(1)_","_2005_","
CHECK IF DIK'["^"
SET DELMSG="Can't resolve 'DIK' Global Node. "
GOTO ERROR
+1 ;I $D(MAGVERB) W !,"Ready to delete ",DIK,DA R !,"ok? ",ANS:DTIME Q:ANS="N"
+2 ;if medicine, call medicine api
+3 IF MAGPARRT>690
IF MAGPARRT<705
GOTO DELMED
+4 ;if TIU goto call TIU api
+5 IF MAGPARRT=8925
GOTO DELTIU
+6 ;if lab, call lab api
+7 IF MAGPARRT["63"
GOTO DELLAB
+8 IF MAGPARRT["2006.5839"
GOTO DELHCP
+9 DO ^DIK
+10 IF $DATA(MAGVERB)
WRITE !,"Parent pointer deleted from ",$PIECE(MAGPAR,"^",1),"..."
EXIT KILL DA,DA(1),DIK,DA(2)
QUIT
DELMED ;
+1 DO KILL^MCUIMAG0(MAGPARRT,DA(1),DA,.MAGSTAT)
+2 IF +MAGSTAT=1
GOTO EXIT
+3 IF '$TEST
SET DELMSG="Error calling Medicine Routine to Delete Pointer."
GOTO ERROR
+4 QUIT
DELTIU ; Delete the TIU pointers
+1 if $PIECE(^MAG(2005,MAGIEN,0),"^",10)
QUIT
+2 ; Quit if image is a child of a group.
+3 DO DELIMAGE^TIUSRVPL(.MAGY,DA(1),MAGIEN)
+4 IF 'MAGY
SET DELMSG="Error calling TIU API : "_$PIECE(MAGY,"^",2)
GOTO ERROR
+5 GOTO EXIT
DELLAB ; delete lab pointer entries
+1 DO EN^MAGSDEL3(MAGIEN,.MAGRES)
+2 IF '+MAGRES
SET DELMSG="Error calling Lab Routine to Delete Pointer."
GOTO ERROR
+3 QUIT
DELHCP ;Delete the DICOM GMRC TEMP file entry pointers
+1 DO DCMTEMP^MAGSDHCP(.MAGY,MAGIEN)
+2 IF '+MAGY
SET DELMSG=$GET(MAGY(0))
GOTO ERROR
+3 GOTO EXIT
ERROR IF $DATA(MAGVERB)
WRITE !,"The backwards pointers are not correct. Image pointers cannot be removed from parent file."
+1 SET MAGERR=1
GOTO EXIT
