MAGVGUID ;WOIFO/RRB,DAC,JSJ - Duplicate DICOM Study, Series, & SOP Instance UID Checks ; Jul 14, 2021@10:02:27:59
;;3.0;IMAGING;**118,138,162,262,307**;Mar 19, 2002;Build 28
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Reference to ^RA(74 in ICR #1171
; Reference to ^RA(70 in ICR #1172
; Reference to GET1^DIQ in ICR #2056
Q
;
; check for duplicate SOP Instance UID
SOP(DFN,ACNUMB,STUDYUID,SERIESUID,SOPUID) ;
N MAGIEN ;--- ien of 2005 DICOM object
N DUPSOP ;--- -1 = Error, 1 = Duplicate UID, 2 = RESEND
;
; is there a DICOM object on file with this SOP Instance UID?
I '$O(^MAG(2005,"P",SOPUID,0)) Q 0 ; nope
;
; is the same DICOM object already on file?
; there might be multiples and we have to check each one
S MAGIEN=0,DUPSOP=0
F S MAGIEN=$O(^MAG(2005,"P",SOPUID,MAGIEN)) Q:MAGIEN="" D Q:DUPSOP
. S DUPSOP=$$SAMEIMG(MAGIEN,DFN,STUDYUID,SERIESUID)
. Q
S DUPSOP=$S(DUPSOP=0:2,1:DUPSOP)
Q DUPSOP
;
SAMEIMG(MAGIEN,DFN,STUDYUID,SERIESUID) ; check DFN and study & series UIDs
N MAG0 ;----- 0-node of file 2005
N MAGDFN ;--- DFN of designated image
N MAGGROUP ;- pointer to the image group
N MAGPTR,MAGACN
N OLDSTUDY,OLDSERIES ; UIDs of the original series or study
; check for defined arguments
Q:$G(MAGIEN)="" -1
Q:$G(DFN)="" -1
Q:$G(STUDYUID)="" -1
Q:$G(SERIESUID)="" -1
S MAG0=$G(^MAG(2005,MAGIEN,0)) Q:MAG0="" -1 ; no 0-node
S MAGDFN=$P(MAG0,"^",7) Q:DFN'=MAGDFN 1 ; different patient
S MAGGROUP=$P(MAG0,"^",10)
; P162 DAC - Accession Number Check producing duplicates instread of resends
S OLDSTUDY=$S(MAGGROUP:$P($G(^MAG(2005,MAGGROUP,"PACS")),"^",1),1:"")
I $L(OLDSTUDY),OLDSTUDY'=STUDYUID Q 1 ; different study instance UIDs
S OLDSERIES=$G(^MAG(2005,MAGIEN,"SERIESUID"))
I $L(OLDSERIES),OLDSERIES'=SERIESUID Q 1 ; different series instance UIDs
Q 0
;
; check for duplicate Series Instance UID
SERIES(DFN,ACNUMB,STUDYUID,SERIESUID) ;
N MAG0 ;----- 0-node of file 2005
N MAGACN ;--- accession number of 2005 DICOM object
N MAGIEN ;--- ien of 2005 DICOM object
N MAGIENG ;-- ien of 2005 DICOM object in group file (2005.04)
N MAGDFN ;--- DFN of designated image
N MAGGROUP ;- pointer to the image group
N MAGSTUID ;- study instance uid of 2005 DICOM object
N DUPSERIES
N I,X
;
; is there a DICOM object on file with this Series Instance UID?
I '$O(^MAG(2005,"SERIESUID",SERIESUID,0)) Q 0 ; nope
;
K ^TMP("MAG",$J,"SERIES UID")
;
; First pass - get the list of DICOM objects for this series
;
S MAGIEN=0
F S MAGIEN=$O(^MAG(2005,"SERIESUID",SERIESUID,MAGIEN)) Q:MAGIEN="" D
. S ^TMP("MAG",$J,"SERIES UID",MAGIEN)=""
. Q
;
; Second pass - for each DICOM object on file, do the following steps
; 1) look up the group and get DFN, ACNUMB, Study Instance UID
; 2) record this information for the first DICOM object in each group
; 3) skip other DICOM objects in same group - redundant information
;
S MAGIEN=0
F S MAGIEN=$O(^TMP("MAG",$J,"SERIES UID",MAGIEN)) Q:'MAGIEN S X=^(MAGIEN) D
. Q:X?1"SKIP".E ; skip DICOM objects in groups that were already processed
. S MAG0=$G(^MAG(2005,MAGIEN,0)) Q:MAG0=""
. S MAGDFN=$P(MAG0,"^",7),MAGGROUP=$P(MAG0,"^",10)
. S MAGSTUID=$P($G(^MAG(2005,MAGGROUP,"PACS")),"^",1)
. ; P262 DAC - Added 2nd ACNUMB parameter
. S MAGACN=$$GETACN(MAGIEN,ACNUMB)
. S X=MAGDFN_"^"_MAGACN_"^"_MAGSTUID
. S ^TMP("MAG",$J,"SERIES UID",MAGIEN)=X
. ; go through the object group file (2005.04) and remove redundancies
. S I=0 F S I=$O(^MAG(2005,MAGGROUP,1,I)) Q:'I S X=^(I,0) D
. . S MAGIENG=$P(X,"^",1) Q:MAGIENG=MAGIEN ; keep first object
. . I $D(^TMP("MAG",$J,"SERIES UID",MAGIENG)) S ^(MAGIENG)="SKIP-"_MAGIEN
. . Q
. Q
;
; Third pass - check remaining entries in ^TMP for duplicates
;
S MAGIEN="",DUPSERIES=0
F S MAGIEN=$O(^TMP("MAG",$J,"SERIES UID",MAGIEN)) Q:MAGIEN="" D Q:DUPSERIES
. S X=^TMP("MAG",$J,"SERIES UID",MAGIEN)
. Q:X["SKIP"
. S MAGDFN=$P(X,"^",1),MAGACN=$P(X,"^",2),MAGSTUID=$P(X,"^",3)
. S DUPSERIES=1
. I DFN=MAGDFN,ACNUMB=MAGACN,STUDYUID=MAGSTUID S DUPSERIES=0
. Q
;
Q DUPSERIES
;
; check for duplicate Study Instance UID
STUDY(DFN,ACNUMB,STUDYUID) ;
N HIT ;------ switch
N MAGIEN ;--- ien of 2005 DICOM object
;
; is there a DICOM object on file with this Study Instance UID?
I '$O(^MAG(2005,"P",STUDYUID,0)) Q 0 ; nope
;
; is the same DICOM object already on file?
; there might be multiples and we have to check each one
S (HIT,MAGIEN)=0
F S MAGIEN=$O(^MAG(2005,"P",STUDYUID,MAGIEN)) Q:MAGIEN="" D Q:HIT
. S HIT=$$SAMESTDY(MAGIEN,DFN,ACNUMB)
. Q
;
Q HIT
;
SAMESTDY(MAGIEN,DFN,ACNUMB) ;
N MAG0 ; 0-node and 2-node of file 2005
N MAGDFN ; DFN of designated image
S MAG0=$G(^MAG(2005,MAGIEN,0)) Q:MAG0="" -1 ; no 0-node
S MAGDFN=$P(MAG0,"^",7) Q:DFN'=MAGDFN 1 ; different patient
; P262 - Added 2nd ACNUMB parameter
I ACNUMB'=$$GETACN(MAGIEN,ACNUMB) Q 1 ; different accession
Q 0
;
GETACN(MAGIEN,ACNUMB) ; P262 DAC - Added 2nd ACNUMB parameter - return the accession number of a study
N ACNUMBVAH ; VA HIS accession number
N DATETIME ; Accession DateTime
N MAG2 ; 2-node of file 2005
N RARPT0 ; 0-node of ^RARPT
N RADPT0 ; 0-node of ^RADPT
N REVDT ;
N ROOT,POINTER ; parent data file root and pointer
S MAG2=$G(^MAG(2005,MAGIEN,2)) Q:MAG2="" "" ; no 2-node
S ROOT=$P(MAG2,"^",6),POINTER=$P(MAG2,"^",7)
S ACNUMBVAH="" ; P262 DAC - Predfine as null
I ROOT=74 D
. S RARPT0=$G(^RARPT(POINTER,0)),DATETIME=$P(RARPT0,"^",3)
. S REVDT=9999999.9999-DATETIME
. ; P262 DAC - Added IDX to loop through multiple file entries for the same date/time
. N IDX S IDX=""
. F D I ($G(ACNUMB)=$G(ACNUMBVAH))!(IDX="") Q
. . S IDX=$O(^RADPT(DFN,"DT",REVDT,"P",IDX))
. . Q:IDX=""
. . S RADPT0=$G(^RADPT(DFN,"DT",REVDT,"P",IDX,0))
. . S ACNUMBVAH=$P(RADPT0,"^",31)
. . I ACNUMBVAH="" S ACNUMBVAH=$P(RARPT0,"^",1)
. . ; if mismatch check accession cross reference for OTHER CASE# ;P307
. . I (ACNUMBVAH'=ACNUMB),$D(^RARPT(POINTER,1,"B",ACNUMB)) S ACNUMBVAH=ACNUMB ; acc found as OTHER CASE#, set the return value ;P307
. . Q
. Q
E I ROOT=8925 S ACNUMBVAH=$$GMRCACN^MAGDFCNV(+$$GET1^DIQ(8925,POINTER,1405,"I"))
E I ROOT=2006.5839 S ACNUMBVAH=$$GMRCACN^MAGDFCNV(POINTER)
E S ACNUMBVAH=""
Q ACNUMBVAH
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVGUID 7325 printed Nov 22, 2024@17:19:53 Page 2
MAGVGUID ;WOIFO/RRB,DAC,JSJ - Duplicate DICOM Study, Series, & SOP Instance UID Checks ; Jul 14, 2021@10:02:27:59
+1 ;;3.0;IMAGING;**118,138,162,262,307**;Mar 19, 2002;Build 28
+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 ;
+18 ; Reference to ^RA(74 in ICR #1171
+19 ; Reference to ^RA(70 in ICR #1172
+20 ; Reference to GET1^DIQ in ICR #2056
+21 QUIT
+22 ;
+23 ; check for duplicate SOP Instance UID
SOP(DFN,ACNUMB,STUDYUID,SERIESUID,SOPUID) ;
+1 ;--- ien of 2005 DICOM object
NEW MAGIEN
+2 ;--- -1 = Error, 1 = Duplicate UID, 2 = RESEND
NEW DUPSOP
+3 ;
+4 ; is there a DICOM object on file with this SOP Instance UID?
+5 ; nope
IF '$ORDER(^MAG(2005,"P",SOPUID,0))
QUIT 0
+6 ;
+7 ; is the same DICOM object already on file?
+8 ; there might be multiples and we have to check each one
+9 SET MAGIEN=0
SET DUPSOP=0
+10 FOR
SET MAGIEN=$ORDER(^MAG(2005,"P",SOPUID,MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:1
+11 SET DUPSOP=$$SAMEIMG(MAGIEN,DFN,STUDYUID,SERIESUID)
+12 QUIT
End DoDot:1
if DUPSOP
QUIT
+13 SET DUPSOP=$SELECT(DUPSOP=0:2,1:DUPSOP)
+14 QUIT DUPSOP
+15 ;
SAMEIMG(MAGIEN,DFN,STUDYUID,SERIESUID) ; check DFN and study & series UIDs
+1 ;----- 0-node of file 2005
NEW MAG0
+2 ;--- DFN of designated image
NEW MAGDFN
+3 ;- pointer to the image group
NEW MAGGROUP
+4 NEW MAGPTR,MAGACN
+5 ; UIDs of the original series or study
NEW OLDSTUDY,OLDSERIES
+6 ; check for defined arguments
+7 if $GET(MAGIEN)=""
QUIT -1
+8 if $GET(DFN)=""
QUIT -1
+9 if $GET(STUDYUID)=""
QUIT -1
+10 if $GET(SERIESUID)=""
QUIT -1
+11 ; no 0-node
SET MAG0=$GET(^MAG(2005,MAGIEN,0))
if MAG0=""
QUIT -1
+12 ; different patient
SET MAGDFN=$PIECE(MAG0,"^",7)
if DFN'=MAGDFN
QUIT 1
+13 SET MAGGROUP=$PIECE(MAG0,"^",10)
+14 ; P162 DAC - Accession Number Check producing duplicates instread of resends
+15 SET OLDSTUDY=$SELECT(MAGGROUP:$PIECE($GET(^MAG(2005,MAGGROUP,"PACS")),"^",1),1:"")
+16 ; different study instance UIDs
IF $LENGTH(OLDSTUDY)
IF OLDSTUDY'=STUDYUID
QUIT 1
+17 SET OLDSERIES=$GET(^MAG(2005,MAGIEN,"SERIESUID"))
+18 ; different series instance UIDs
IF $LENGTH(OLDSERIES)
IF OLDSERIES'=SERIESUID
QUIT 1
+19 QUIT 0
+20 ;
+21 ; check for duplicate Series Instance UID
SERIES(DFN,ACNUMB,STUDYUID,SERIESUID) ;
+1 ;----- 0-node of file 2005
NEW MAG0
+2 ;--- accession number of 2005 DICOM object
NEW MAGACN
+3 ;--- ien of 2005 DICOM object
NEW MAGIEN
+4 ;-- ien of 2005 DICOM object in group file (2005.04)
NEW MAGIENG
+5 ;--- DFN of designated image
NEW MAGDFN
+6 ;- pointer to the image group
NEW MAGGROUP
+7 ;- study instance uid of 2005 DICOM object
NEW MAGSTUID
+8 NEW DUPSERIES
+9 NEW I,X
+10 ;
+11 ; is there a DICOM object on file with this Series Instance UID?
+12 ; nope
IF '$ORDER(^MAG(2005,"SERIESUID",SERIESUID,0))
QUIT 0
+13 ;
+14 KILL ^TMP("MAG",$JOB,"SERIES UID")
+15 ;
+16 ; First pass - get the list of DICOM objects for this series
+17 ;
+18 SET MAGIEN=0
+19 FOR
SET MAGIEN=$ORDER(^MAG(2005,"SERIESUID",SERIESUID,MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:1
+20 SET ^TMP("MAG",$JOB,"SERIES UID",MAGIEN)=""
+21 QUIT
End DoDot:1
+22 ;
+23 ; Second pass - for each DICOM object on file, do the following steps
+24 ; 1) look up the group and get DFN, ACNUMB, Study Instance UID
+25 ; 2) record this information for the first DICOM object in each group
+26 ; 3) skip other DICOM objects in same group - redundant information
+27 ;
+28 SET MAGIEN=0
+29 FOR
SET MAGIEN=$ORDER(^TMP("MAG",$JOB,"SERIES UID",MAGIEN))
if 'MAGIEN
QUIT
SET X=^(MAGIEN)
Begin DoDot:1
+30 ; skip DICOM objects in groups that were already processed
if X?1"SKIP".E
QUIT
+31 SET MAG0=$GET(^MAG(2005,MAGIEN,0))
if MAG0=""
QUIT
+32 SET MAGDFN=$PIECE(MAG0,"^",7)
SET MAGGROUP=$PIECE(MAG0,"^",10)
+33 SET MAGSTUID=$PIECE($GET(^MAG(2005,MAGGROUP,"PACS")),"^",1)
+34 ; P262 DAC - Added 2nd ACNUMB parameter
+35 SET MAGACN=$$GETACN(MAGIEN,ACNUMB)
+36 SET X=MAGDFN_"^"_MAGACN_"^"_MAGSTUID
+37 SET ^TMP("MAG",$JOB,"SERIES UID",MAGIEN)=X
+38 ; go through the object group file (2005.04) and remove redundancies
+39 SET I=0
FOR
SET I=$ORDER(^MAG(2005,MAGGROUP,1,I))
if 'I
QUIT
SET X=^(I,0)
Begin DoDot:2
+40 ; keep first object
SET MAGIENG=$PIECE(X,"^",1)
if MAGIENG=MAGIEN
QUIT
+41 IF $DATA(^TMP("MAG",$JOB,"SERIES UID",MAGIENG))
SET ^(MAGIENG)="SKIP-"_MAGIEN
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
+44 ;
+45 ; Third pass - check remaining entries in ^TMP for duplicates
+46 ;
+47 SET MAGIEN=""
SET DUPSERIES=0
+48 FOR
SET MAGIEN=$ORDER(^TMP("MAG",$JOB,"SERIES UID",MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:1
+49 SET X=^TMP("MAG",$JOB,"SERIES UID",MAGIEN)
+50 if X["SKIP"
QUIT
+51 SET MAGDFN=$PIECE(X,"^",1)
SET MAGACN=$PIECE(X,"^",2)
SET MAGSTUID=$PIECE(X,"^",3)
+52 SET DUPSERIES=1
+53 IF DFN=MAGDFN
IF ACNUMB=MAGACN
IF STUDYUID=MAGSTUID
SET DUPSERIES=0
+54 QUIT
End DoDot:1
if DUPSERIES
QUIT
+55 ;
+56 QUIT DUPSERIES
+57 ;
+58 ; check for duplicate Study Instance UID
STUDY(DFN,ACNUMB,STUDYUID) ;
+1 ;------ switch
NEW HIT
+2 ;--- ien of 2005 DICOM object
NEW MAGIEN
+3 ;
+4 ; is there a DICOM object on file with this Study Instance UID?
+5 ; nope
IF '$ORDER(^MAG(2005,"P",STUDYUID,0))
QUIT 0
+6 ;
+7 ; is the same DICOM object already on file?
+8 ; there might be multiples and we have to check each one
+9 SET (HIT,MAGIEN)=0
+10 FOR
SET MAGIEN=$ORDER(^MAG(2005,"P",STUDYUID,MAGIEN))
if MAGIEN=""
QUIT
Begin DoDot:1
+11 SET HIT=$$SAMESTDY(MAGIEN,DFN,ACNUMB)
+12 QUIT
End DoDot:1
if HIT
QUIT
+13 ;
+14 QUIT HIT
+15 ;
SAMESTDY(MAGIEN,DFN,ACNUMB) ;
+1 ; 0-node and 2-node of file 2005
NEW MAG0
+2 ; DFN of designated image
NEW MAGDFN
+3 ; no 0-node
SET MAG0=$GET(^MAG(2005,MAGIEN,0))
if MAG0=""
QUIT -1
+4 ; different patient
SET MAGDFN=$PIECE(MAG0,"^",7)
if DFN'=MAGDFN
QUIT 1
+5 ; P262 - Added 2nd ACNUMB parameter
+6 ; different accession
IF ACNUMB'=$$GETACN(MAGIEN,ACNUMB)
QUIT 1
+7 QUIT 0
+8 ;
GETACN(MAGIEN,ACNUMB) ; P262 DAC - Added 2nd ACNUMB parameter - return the accession number of a study
+1 ; VA HIS accession number
NEW ACNUMBVAH
+2 ; Accession DateTime
NEW DATETIME
+3 ; 2-node of file 2005
NEW MAG2
+4 ; 0-node of ^RARPT
NEW RARPT0
+5 ; 0-node of ^RADPT
NEW RADPT0
+6 ;
NEW REVDT
+7 ; parent data file root and pointer
NEW ROOT,POINTER
+8 ; no 2-node
SET MAG2=$GET(^MAG(2005,MAGIEN,2))
if MAG2=""
QUIT ""
+9 SET ROOT=$PIECE(MAG2,"^",6)
SET POINTER=$PIECE(MAG2,"^",7)
+10 ; P262 DAC - Predfine as null
SET ACNUMBVAH=""
+11 IF ROOT=74
Begin DoDot:1
+12 SET RARPT0=$GET(^RARPT(POINTER,0))
SET DATETIME=$PIECE(RARPT0,"^",3)
+13 SET REVDT=9999999.9999-DATETIME
+14 ; P262 DAC - Added IDX to loop through multiple file entries for the same date/time
+15 NEW IDX
SET IDX=""
+16 FOR
Begin DoDot:2
+17 SET IDX=$ORDER(^RADPT(DFN,"DT",REVDT,"P",IDX))
+18 if IDX=""
QUIT
+19 SET RADPT0=$GET(^RADPT(DFN,"DT",REVDT,"P",IDX,0))
+20 SET ACNUMBVAH=$PIECE(RADPT0,"^",31)
+21 IF ACNUMBVAH=""
SET ACNUMBVAH=$PIECE(RARPT0,"^",1)
+22 ; if mismatch check accession cross reference for OTHER CASE# ;P307
+23 ; acc found as OTHER CASE#, set the return value ;P307
IF (ACNUMBVAH'=ACNUMB)
IF $DATA(^RARPT(POINTER,1,"B",ACNUMB))
SET ACNUMBVAH=ACNUMB
+24 QUIT
End DoDot:2
IF ($GET(ACNUMB)=$GET(ACNUMBVAH))!(IDX="")
QUIT
+25 QUIT
End DoDot:1
+26 IF '$TEST
IF ROOT=8925
SET ACNUMBVAH=$$GMRCACN^MAGDFCNV(+$$GET1^DIQ(8925,POINTER,1405,"I"))
+27 IF '$TEST
IF ROOT=2006.5839
SET ACNUMBVAH=$$GMRCACN^MAGDFCNV(POINTER)
+28 IF '$TEST
SET ACNUMBVAH=""
+29 QUIT ACNUMBVAH
+30 ;
