- 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 Feb 18, 2025@23:34:39 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