- 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 Apr 23, 2025@18:24:21 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 ;
