Routine: MAGVD010

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.                     |

 ;; +---------------------------------------------------------------+

;;

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVD010   4093     printed  Apr 23, 2025@18:24:18                                                                                                                                                                                                    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

MAGVD010.m