MAGVD010 ;WOIFO/BT,NST,MLH,PML,PMK - Delete Study By Accession Number - display outputs ; Feb 15, 2022@10:24:32
;;3.0;IMAGING;**118,231,305**;Mar 19, 2002;Build 3
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | 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. |
;; +---------------------------------------------------------------+
;;
Q
;
STYSERKT(KT,SUBARY) ; count all the studies & series referenced by a subarray node
Q:SUBARY=""
N STYARY
D ; process matching image indices
. N MAGIX,STYIX
. S MAGIX=0 F S MAGIX=$O(@SUBARY@(MAGIX)) Q:'MAGIX D
. . S STYIX=@SUBARY@(MAGIX)
. . ; old or new structure?
. . I STYIX="" D OLD(MAGIX,.KT) Q ; old
. . I STYIX'="" S STYARY(STYIX)="" Q ; new
. . Q
. Q
D ; do counts from new structure
. S STYIX="" F S STYIX=$O(STYARY(STYIX)) Q:'STYIX D NEW(STYIX,.KT)
. Q
D ; do counts from old structure
. N STYUID,SERUID,MAGIX
. S STYUID="" F KT=0:1 S STYUID=$O(KT("STUDY",STYUID)) Q:STYUID=""
. S KT("STUDY")=$G(KT("STUDY"))+KT
. S SERUID="" F KT=0:1 S SERUID=$O(KT("SERIES",SERUID)) Q:SERUID=""
. S KT("SERIES")=$G(KT("SERIES"))+KT
. S MAGIX="" F KT=0:1 S MAGIX=$O(KT("IMAGE",MAGIX)) Q:MAGIX=""
. S KT("IMAGE")=$G(KT("IMAGE"))+KT
. Q
Q
NEW(STYIX,KT) ; new structure - can build counts directly from structure
Q:'STYIX
; the PROBLEM6n functions were added in P305 - PMK 12/01/2021
N SERIX
S KT("STUDY")=$G(KT("STUDY"))+1
S SERIX=""
F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
. I $$PROBLEM63^MAGDSTA8(SERIX) Q ; if the series is not available, don't count it - quit
. N SOPIX
. ; If Series deleted don't count - quit
. ; Q:$G(^MAGV(2005.63,SERIX,9))'="A"
. S KT("SERIES")=$G(KT("SERIES"))+1
. S SOPIX=""
. F S SOPIX=$O(^MAGV(2005.64,"C",SERIX,SOPIX)) Q:'SOPIX D
. . ; If SOP deleted don't count - quit
. . ; Q:$G(^MAGV(2005.64,SOPIX,11))'="A"
. . I $$PROBLEM64^MAGDSTA8(SOPIX) Q ; if the sop instance is not available, don't count it - quit"
. . N IMAGEIX
. . S IMAGEIX=""
. . F S IMAGEIX=$O(^MAGV(2005.65,"C",SOPIX,IMAGEIX)) Q:'IMAGEIX D
. . . I $$PROBLEM65^MAGDSTA8(IMAGEIX) Q ; if the original image is not available, don't count it - quit
. . . S KT("IMAGE")=$G(KT("IMAGE"))+1
. . . Q
. . Q
. Q
Q
OLD(MAGIX,KT) ; old structure - must build counts from instances
Q:'$G(MAGIX)
I '$D(^MAG(2005,MAGIX)) S KT("DELETED")="" Q ; deleted study - P231 PMK 12.09/2021
N PARENT,UID,CHILD,CHILDIX
I '$D(^MAG(2005,MAGIX,1)) D Q ; child
. S KT("IMAGE",MAGIX)=""
. S UID=$P($G(^MAG(2005,MAGIX,"SERIESUID")),"^",1) ; series instance UID
. S:UID'="" KT("SERIES",UID)=""
. S PARENT=$P($G(^MAG(2005,MAGIX,0)),"^",10) Q:PARENT="" ; P231 PMK 4/3/2020
. S UID=$P($G(^MAG(2005,PARENT,"PACS")),"^",1) ; study instance UID
. S:UID'="" KT("STUDY",UID)=""
. Q
I $D(^MAG(2005,MAGIX,1)) D Q ; parent
. S UID=$P($G(^MAG(2005,MAGIX,"PACS")),"^",1)
. S:UID'="" KT("STUDY",UID)="" ; study instance UID
. S CHILD=0
. F S CHILD=$O(^MAG(2005,MAGIX,1,CHILD)) Q:'CHILD D
. . S CHILDIX=$P($G(^MAG(2005,MAGIX,1,CHILD,0)),"^",1)
. . S KT("IMAGE",CHILDIX)=""
. . S UID=$P($G(^MAG(2005,CHILDIX,"SERIESUID")),"^",1) ; series instance UID
. . S:UID'="" KT("SERIES",UID)=""
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVD010 4093 printed Sep 23, 2025@19:46 Page 2
MAGVD010 ;WOIFO/BT,NST,MLH,PML,PMK - Delete Study By Accession Number - display outputs ; Feb 15, 2022@10:24:32
+1 ;;3.0;IMAGING;**118,231,305**;Mar 19, 2002;Build 3
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | 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 ;;
+17 QUIT
+18 ;
STYSERKT(KT,SUBARY) ; count all the studies & series referenced by a subarray node
+1 if SUBARY=""
QUIT
+2 NEW STYARY
+3 ; process matching image indices
Begin DoDot:1
+4 NEW MAGIX,STYIX
+5 SET MAGIX=0
FOR
SET MAGIX=$ORDER(@SUBARY@(MAGIX))
if 'MAGIX
QUIT
Begin DoDot:2
+6 SET STYIX=@SUBARY@(MAGIX)
+7 ; old or new structure?
+8 ; old
IF STYIX=""
DO OLD(MAGIX,.KT)
QUIT
+9 ; new
IF STYIX'=""
SET STYARY(STYIX)=""
QUIT
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 ; do counts from new structure
Begin DoDot:1
+13 SET STYIX=""
FOR
SET STYIX=$ORDER(STYARY(STYIX))
if 'STYIX
QUIT
DO NEW(STYIX,.KT)
+14 QUIT
End DoDot:1
+15 ; do counts from old structure
Begin DoDot:1
+16 NEW STYUID,SERUID,MAGIX
+17 SET STYUID=""
FOR KT=0:1
SET STYUID=$ORDER(KT("STUDY",STYUID))
if STYUID=""
QUIT
+18 SET KT("STUDY")=$GET(KT("STUDY"))+KT
+19 SET SERUID=""
FOR KT=0:1
SET SERUID=$ORDER(KT("SERIES",SERUID))
if SERUID=""
QUIT
+20 SET KT("SERIES")=$GET(KT("SERIES"))+KT
+21 SET MAGIX=""
FOR KT=0:1
SET MAGIX=$ORDER(KT("IMAGE",MAGIX))
if MAGIX=""
QUIT
+22 SET KT("IMAGE")=$GET(KT("IMAGE"))+KT
+23 QUIT
End DoDot:1
+24 QUIT
NEW(STYIX,KT) ; new structure - can build counts directly from structure
+1 if 'STYIX
QUIT
+2 ; the PROBLEM6n functions were added in P305 - PMK 12/01/2021
+3 NEW SERIX
+4 SET KT("STUDY")=$GET(KT("STUDY"))+1
+5 SET SERIX=""
+6 FOR
SET SERIX=$ORDER(^MAGV(2005.63,"C",STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:1
+7 ; if the series is not available, don't count it - quit
IF $$PROBLEM63^MAGDSTA8(SERIX)
QUIT
+8 NEW SOPIX
+9 ; If Series deleted don't count - quit
+10 ; Q:$G(^MAGV(2005.63,SERIX,9))'="A"
+11 SET KT("SERIES")=$GET(KT("SERIES"))+1
+12 SET SOPIX=""
+13 FOR
SET SOPIX=$ORDER(^MAGV(2005.64,"C",SERIX,SOPIX))
if 'SOPIX
QUIT
Begin DoDot:2
+14 ; If SOP deleted don't count - quit
+15 ; Q:$G(^MAGV(2005.64,SOPIX,11))'="A"
+16 ; if the sop instance is not available, don't count it - quit"
IF $$PROBLEM64^MAGDSTA8(SOPIX)
QUIT
+17 NEW IMAGEIX
+18 SET IMAGEIX=""
+19 FOR
SET IMAGEIX=$ORDER(^MAGV(2005.65,"C",SOPIX,IMAGEIX))
if 'IMAGEIX
QUIT
Begin DoDot:3
+20 ; if the original image is not available, don't count it - quit
IF $$PROBLEM65^MAGDSTA8(IMAGEIX)
QUIT
+21 SET KT("IMAGE")=$GET(KT("IMAGE"))+1
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 QUIT
OLD(MAGIX,KT) ; old structure - must build counts from instances
+1 if '$GET(MAGIX)
QUIT
+2 ; deleted study - P231 PMK 12.09/2021
IF '$DATA(^MAG(2005,MAGIX))
SET KT("DELETED")=""
QUIT
+3 NEW PARENT,UID,CHILD,CHILDIX
+4 ; child
IF '$DATA(^MAG(2005,MAGIX,1))
Begin DoDot:1
+5 SET KT("IMAGE",MAGIX)=""
+6 ; series instance UID
SET UID=$PIECE($GET(^MAG(2005,MAGIX,"SERIESUID")),"^",1)
+7 if UID'=""
SET KT("SERIES",UID)=""
+8 ; P231 PMK 4/3/2020
SET PARENT=$PIECE($GET(^MAG(2005,MAGIX,0)),"^",10)
if PARENT=""
QUIT
+9 ; study instance UID
SET UID=$PIECE($GET(^MAG(2005,PARENT,"PACS")),"^",1)
+10 if UID'=""
SET KT("STUDY",UID)=""
+11 QUIT
End DoDot:1
QUIT
+12 ; parent
IF $DATA(^MAG(2005,MAGIX,1))
Begin DoDot:1
+13 SET UID=$PIECE($GET(^MAG(2005,MAGIX,"PACS")),"^",1)
+14 ; study instance UID
if UID'=""
SET KT("STUDY",UID)=""
+15 SET CHILD=0
+16 FOR
SET CHILD=$ORDER(^MAG(2005,MAGIX,1,CHILD))
if 'CHILD
QUIT
Begin DoDot:2
+17 SET CHILDIX=$PIECE($GET(^MAG(2005,MAGIX,1,CHILD,0)),"^",1)
+18 SET KT("IMAGE",CHILDIX)=""
+19 ; series instance UID
SET UID=$PIECE($GET(^MAG(2005,CHILDIX,"SERIESUID")),"^",1)
+20 if UID'=""
SET KT("SERIES",UID)=""
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
QUIT
+23 QUIT
