MAGVRS61 ;WOIFO/DAC,JSJ - RPC calls for DICOM file processing ; 20 Nov 2015 11:20 AM
;;3.0;IMAGING;**118,162,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 GET1^DIQ in ICR #2056
;
Q
DUPUID(OUT,ACCESSION,DFN,TYPE,UID,STUDUID,SERUID) ; Check for duplicate UIDs in the new structure
; OUT - Duplicate message output
; ACCESSION - Accession # ; DFN - Patient DFN
; TYPE - Type of UID check - "STUDY", "SERIES", or "SOP"
; UID - Unique Identifier
; if accession number does not match then it's a duplicate UID
; OUT:
;
; -1 - Exception with error message
;
; 0 - Not a duplicate UID - Non duplicates are either have no entries in the 2005.6x files
; or they match on UID, DFN, Accession, and parent UIDs
; 1 - Duplicate UID - Duplicates have an entry in a 2005.6x file, but does not match
; on UID, DFN, Accession, and/or parent UID
; 2 - Record exist - A record exists with a matching DFN, Accession, Study UID, Series UID,
; and SOP UID already
N SOPOUT,SOPLINK
I TYPE'="STUDY",TYPE'="SERIES",TYPE'="SOP" S OUT="-1~TYPE is not Study, Series, or SOP" Q
S OUT=0
; If the UID and the accession are already being used and the UID is not linked to the
; procedure REF with the same accession then the UID is a duplicate
I TYPE="STUDY",$D(^MAGV(2005.62,"B",UID)) D
. I $$LINKED(ACCESSION,DFN,UID,"STUDY") Q
. S OUT=1
. Q
I TYPE="SERIES",$D(^MAGV(2005.63,"B",UID)) D
. I $$LINKED(ACCESSION,DFN,UID,"SERIES",STUDUID) Q
. S OUT=1
. Q
I TYPE="SOP",$D(^MAGV(2005.64,"B",UID)) D
. S SOPLINK=$$LINKED(ACCESSION,DFN,UID,"SOP",STUDUID,SERUID)
. I SOPLINK=2 S OUT=0 Q
. I SOPLINK="NOT AOF" S OUT=0 Q ; P162 DAC - Check AOF before checking if duplicate
. I SOPLINK=1 S OUT=2 Q
. S OUT=1
. Q
Q OUT
DUPSTUD(DFN,ACCESSION,UID) ; Check for duplicate Study UID
S TYPE="STUDY"
I $G(ACCESSION)="" Q "-1~No accession number provided"
I $G(DFN)="" Q "-1~No patient DFN provided"
D DUPUID(.OUT,ACCESSION,DFN,TYPE,UID)
Q OUT
DUPSER(DFN,ACCESSION,STUDUID,UID) ; Check for duplicate Series UID
S TYPE="SERIES"
I $G(ACCESSION)="" Q "-1~No accession number provided"
I $G(DFN)="" Q "-1~No patient DFN provided"
D DUPUID(.OUT,ACCESSION,DFN,TYPE,UID,STUDUID)
Q OUT
DUPSOP(DFN,ACCESSION,STUDUID,SERUID,UID) ; Check for duplicate SOP UID
S TYPE="SOP"
I $G(ACCESSION)="" Q "-1~No accession number provided"
I $G(DFN)="" Q "-1~No patient DFN provided"
D DUPUID(.OUT,ACCESSION,DFN,TYPE,UID,STUDUID,SERUID)
Q OUT
LINKED(ACCESSION,DFN,UID,UIDTYPE,STUDUIDA,SERUIDA) ; Check if duplicate UID is linked to the same procedure, patient, and parent Study, Series, SOP IENS
N LINK,IEN,PROCIEN,STUDYIEN,SERIESIEN,SOPIEN,PROCCASE,PRIEN,PRDFN,STATUS,STUDUIDB,SOPUIDB,PATPROC,SERUIDB,AOF,STUDUIDO ;P307 add STUDDUI0 (original study UID)
S LINK=0
I UIDTYPE="STUDY" D
. ; Check if the Study IEN is linked to the procedure IEN with the Accession #
. S STUDYIEN=""
. F S STUDYIEN=$O(^MAGV(2005.62,"B",UID,STUDYIEN)) Q:STUDYIEN="" D Q:STATUS="A"
. . S STATUS=$P($G(^MAGV(2005.62,STUDYIEN,5)),U,2)
. . Q:STATUS="I"
. . S PATPROC=$G(^MAGV(2005.62,STUDYIEN,6))
. . S PROCIEN=$P(PATPROC,U,1)
. . S PRIEN=$P(PATPROC,U,3)
. . Q
. Q
I UIDTYPE="SERIES" D
. ; Check if the Series IEN is linked to the procedure IEN with the Accession #
. S SERIESIEN=""
. F S SERIESIEN=$O(^MAGV(2005.63,"B",UID,SERIESIEN)) Q:SERIESIEN="" D Q:STATUS="A"
. . S STATUS=$G(^MAGV(2005.63,SERIESIEN,9))
. . Q:STATUS="I"
. . S STUDYIEN=$P($G(^MAGV(2005.63,SERIESIEN,6)),U,1)
. . S STUDUIDB=$P($G(^MAGV(2005.62,STUDYIEN,0)),U,1)
. . S PATPROC=$G(^MAGV(2005.62,STUDYIEN,6))
. . S PROCIEN=$P(PATPROC,U,1)
. . S PRIEN=$P(PATPROC,U,3)
. . Q
. Q
I UIDTYPE="SOP" D
. ; Check if the SOP IEN is linked to the procedure IEN with the Accession #
. S SOPIEN=""
. F S SOPIEN=$O(^MAGV(2005.64,"B",UID,SOPIEN)) Q:SOPIEN="" D Q:STATUS="A"
. . S STATUS=$G(^MAGV(2005.64,SOPIEN,11))
. . Q:STATUS="I"
. . S AOF=$P($G(^MAGV(2005.64,SOPIEN,6)),U,2)
. . S SERIESIEN=$P($G(^MAGV(2005.64,SOPIEN,6)),U,1)
. . S SERUIDB=$P($G(^MAGV(2005.63,SERIESIEN,0)),U,1)
. . S STUDYIEN=$P($G(^MAGV(2005.63,SERIESIEN,6)),U,1)
. . S STUDUIDB=$P($G(^MAGV(2005.62,STUDYIEN,0)),U,1)
. . S PATPROC=$G(^MAGV(2005.62,STUDYIEN,6))
. . S PROCIEN=$P(PATPROC,U,1)
. . S PRIEN=$P(PATPROC,U,3)
. . Q
. Q
I $G(PROCIEN)="" Q LINK ; Not linked to a procedure ref
I $G(PRIEN)="" Q LINK ; Not linked to a procedure ref
S PROCCASE=$P(^MAGV(2005.61,PROCIEN,0),U,1)
S PRDFN=$P($G(^MAGV(2005.6,PRIEN,0)),U,1)
S STUDUIDO=$P($G(^MAGV(2005.62,STUDYIEN,0)),U,2) ;P307 get original study UID
I (STUDUIDO]""),(STUDUIDA'=STUDUIDB) S STUDUIDB=STUDUIDO ;P307 replace study UID with original study UID for compare
I PRDFN=DFN,ACCESSION=PROCCASE S LINK=1
I UIDTYPE="SERIES",LINK,STUDUIDA'=STUDUIDB S LINK=0 ;P307 use UIDTYPE passed rather than TYPE that falls through
I UIDTYPE="SOP",LINK,((STUDUIDA'=STUDUIDB)!(SERUIDA'=SERUIDB)) S LINK=0 ;P307 use UIDTYPE
I LINK=1,UIDTYPE="SOP",AOF'=1 S LINK="NOT AOF" Q LINK ;P307 use UIDTYPE
I $G(STATUS)="I" Q 2 ; P162 DAC - Check Status after AOF check. No accessible record found.
Q LINK
LOGDUP(ORIGUID,NEWUID,ACCESSION,DFN,TYPE,STUDYUID,SERUID) ; Log duplicate UIDs
N FDA,FILE,ONEWUID,SOCTYPE
S ONEWUID=NEWUID ; Store original generated NEWUID with postfix
I TYPE="SERIES",STUDYUID="" S NEWUID="-1~No Study UID provided" Q
I TYPE="SOP",STUDYUID="" S NEWUID="-1~No Study UID provided" Q
I TYPE="SOP",SERUID="" S NEWUID="-1~No Series UID provided" Q
L +^MAGV(2005.66,"C",ONEWUID):1E9 ; Lock generated UID
I TYPE="STUDY" S SOCTYPE=1
I TYPE="SERIES" S SOCTYPE=2
I TYPE="SOP" S SOCTYPE=3
S FILE=2005.66
D LOGLOOK(.NEWUID)
S FDA(FILE,"+1,",.01)=ORIGUID
S FDA(FILE,"+1,",2)=NEWUID
S FDA(FILE,"+1,",3)=ACCESSION
S FDA(FILE,"+1,",4)=DFN
S FDA(FILE,"+1,",5)=SOCTYPE
I $G(STUDYUID)'="" S FDA(FILE,"+1,",6)=STUDYUID
I $G(SERUID)'="" S FDA(FILE,"+1,",7)=SERUID
D UPDATE^DIE("","FDA")
L -^MAGV(2005.66,"C",ONEWUID) ; Unlock original generated UID
I NEWUID'=ONEWUID L -^MAGV(2005.66,"C",NEWUID) ; Unlock new generated UID with postfix
K FDA
Q
LOGLOOK(NEWUID) ; Look for UID in duplicate log and generate a new UID if there is a duplicate
N POSTFIX
I '$$UIDCHECK(NEWUID) F POSTFIX=1:1 Q:$$UIDCHECK(NEWUID_"."_POSTFIX)
I $G(POSTFIX)'="" D
. S NEWUID=NEWUID_"."_POSTFIX
. L +^MAGV(2005.66,"C",NEWUID):1E9
. Q
Q
UIDCHECK(POSTUID) ; Check if newly generated UID exists in UID database indexes
; If UID is found return 0, if UID is not found return 1
N UNIQUE
S UNIQUE=1
D ; Check file indexes for UID
. ; Check for duplicate in new UID log
. I $D(^MAGV(2005.66,"C",POSTUID)) S UNIQUE=0 Q
. ; Check for duplicate Study and SOP in 2005
. I $D(^MAG(2005,"P",POSTUID)) S UNIQUE=0 Q
. ; Check for duplicate Series in 2005
. I $D(^MAG(2005,"SERIESUID",POSTUID)) S UNIQUE=0 Q
. ; Check for duplicate Study in 2005.62
. I $D(^MAGV(2005.62,"B",POSTUID)) S UNIQUE=0 Q
. ; Check for duplicate Series in 2005.63
. I $D(^MAGV(2005.63,"B",POSTUID)) S UNIQUE=0 Q
. ; Check for duplicate SOP in 2005.64
. I $D(^MAGV(2005.64,"B",POSTUID)) S UNIQUE=0 Q
. Q
Q UNIQUE
UIDLOOK(UID,DFN,ACC,TYPE,STUDYUID,SERUID) ; Look to see if Original UID exists and if entry matches DFN and ACC provided. If so, return New UID. Otherwise, 0.
N OUT,IEN,ENTRY,ENTRY2,STYPE
S OUT=0
I (UID="")!($G(DFN)="")!($G(ACC)="")!($G(TYPE)="") Q OUT
I '$D(^MAGV(2005.66,"B",UID)) Q OUT
I TYPE="SERIES",$G(STUDYUID)="" Q OUT
I TYPE="SOP",($G(SERUID)="")!($G(STUDYUID)="") Q OUT
I TYPE="SERIES" I '$D(^MAGV(2005.66,"D",UID,$G(STUDYUID))) Q OUT
I TYPE="SOP" I '$D(^MAGV(2005.66,"E",UID,$G(SERUID))) Q OUT
S IEN=""
F S IEN=$O(^MAGV(2005.66,"B",UID,IEN)) Q:(IEN="")!(OUT'=0) D
. S ENTRY=$G(^MAGV(2005.66,IEN,0))
. S ENTRY2=$G(^MAGV(2005.66,IEN,1))
. S STYPE=$P($$GET1^DIQ(2005.66,IEN,5)," ",1)
. I DFN=$P(ENTRY,U,4),ACC=$P(ENTRY,U,3),TYPE=STYPE D
. . I TYPE="STUDY",$G(UID)=$P(ENTRY,U,1) S OUT=$P(ENTRY,U,2) Q
. . I TYPE="SERIES",$G(STUDYUID)=$P(ENTRY2,U,1),$G(UID)=$P(ENTRY,U,1) S OUT=$P(ENTRY,U,2) Q
. . I TYPE="SOP",$G(STUDYUID)=$P(ENTRY2,U,1),$G(SERUID)=$P(ENTRY2,U,2),$G(UID)=$P(ENTRY,U,1) S OUT=$P(ENTRY,U,2) Q
Q OUT
DELLOG(OUT,IEN,FILE) ; Remove inactivated entries from the duplicate log
N DUPIEN,PIEN,ACC,DFN,SOPUID,SERUID,STUDUID,TYPE,ERR,UID,PATIEN,SSEP,PROCIEN,PATID,DUPDATA1,DUPDATA2
N DUPACC,DUPPATID,DSERUID,IENS,FDA,DSTDUID,STUDDATA,DELETE
;
S OUT="0"
S SSEP=$$STATSEP^MAGVRS41
I (FILE'=2005.64)&(FILE'=2005.63)&(FILE'=2005.62) S OUT="-1"_SSEP_"Invalid file number" Q
I IEN="" S OUT="-7"_SSEP_"No IEN provided" Q
I FILE=2005.64 D
. S (SOPUID,UID)=$P($G(^MAGV(2005.64,IEN,0)),U,1)
. S IEN=$P($G(^MAGV(2005.64,IEN,6)),U,1)
. Q
I IEN="" S OUT="-8"_SSEP_"No Parent Record" Q
I FILE>=2005.63 D
. I FILE=2005.64 S SERUID=$P($G(^MAGV(2005.63,IEN,0)),U,2)
. I FILE=2005.63 S SERUID=$P($G(^MAGV(2005.63,IEN,0)),U,1)
. I '$D(UID) S UID=SERUID
. S IEN=$P($G(^MAGV(2005.63,IEN,6)),U,1)
. Q
I IEN="" S OUT="-8"_SSEP_"No Parent Record" Q
I FILE>=2005.62 D
. I FILE=2005.62 S STUDUID=$P($G(^MAGV(2005.62,IEN,0)),U,1)
. I FILE'=2005.62 S STUDUID=$P($G(^MAGV(2005.62,IEN,0)),U,2)
. I '$D(UID) S UID=STUDUID
. S STUDDATA=$G(^MAGV(2005.62,IEN,6))
. S PATIEN=$P(STUDDATA,U,3)
. S PROCIEN=$P(STUDDATA,U,1)
. I (PROCIEN="")!(PATIEN="") Q
. S ACC=$P($G(^MAGV(2005.61,PROCIEN,0)),U,1)
. S PATID=$P($G(^MAGV(2005.6,PATIEN,0)),U,1)
. Q
I PATIEN="" S OUT="-9"_SSEP_"No Patient Record" Q
I PROCIEN="" S OUT="-10"_SSEP_"No Procedure Record" Q
S DUPIEN=""
F DUPIEN=$O(^MAGV(2005.66,"C",UID,DUPIEN)) Q:DUPIEN="" D
. S DUPDATA1=$G(^MAGV(2005.66,DUPIEN,0))
. S DUPDATA2=$G(^MAGV(2005.66,DUPIEN,1))
. S DUPACC=$P(DUPDATA1,U,3),DUPPATID=$P(DUPDATA1,U,4)
. S DSTDUID=$P(DUPDATA2,U,1),DSERUID=$P(DUPDATA2,U,2)
. S DELETE=0
. I FILE=2005.64,ACC=DUPACC,PATID=DUPPATID,((STUDUID=DSTDUID)!('DSTDUID)),(($G(SERUID)=DSERUID)!('DSERUID)) S DELETE=1 ; SOP Check
. I FILE=2005.63,ACC=DUPACC,PATID=DUPPATID,((STUDUID=DSTDUID)!('DSTDUID)) S DELETE=1 ; Series Check
. I FILE=2005.62,ACC=DUPACC,PATID=DUPPATID S DELETE=1 ; Study Check
. I DELETE D
. . ; Delete matching duplicate entries
. . S IENS=DUPIEN_","
. . S FDA(2005.66,IENS,.01)="@"
. . D FILE^DIE("","FDA","ERR")
. . S OUT="0"
. . I $D(ERR("DIERR")) S OUT="-11"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
. . Q
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRS61 11628 printed Apr 09, 2024@21:10:27 Page 2
MAGVRS61 ;WOIFO/DAC,JSJ - RPC calls for DICOM file processing ; 20 Nov 2015 11:20 AM
+1 ;;3.0;IMAGING;**118,162,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 GET1^DIQ in ICR #2056
+19 ;
+20 QUIT
DUPUID(OUT,ACCESSION,DFN,TYPE,UID,STUDUID,SERUID) ; Check for duplicate UIDs in the new structure
+1 ; OUT - Duplicate message output
+2 ; ACCESSION - Accession # ; DFN - Patient DFN
+3 ; TYPE - Type of UID check - "STUDY", "SERIES", or "SOP"
+4 ; UID - Unique Identifier
+5 ; if accession number does not match then it's a duplicate UID
+6 ; OUT:
+7 ;
+8 ; -1 - Exception with error message
+9 ;
+10 ; 0 - Not a duplicate UID - Non duplicates are either have no entries in the 2005.6x files
+11 ; or they match on UID, DFN, Accession, and parent UIDs
+12 ; 1 - Duplicate UID - Duplicates have an entry in a 2005.6x file, but does not match
+13 ; on UID, DFN, Accession, and/or parent UID
+14 ; 2 - Record exist - A record exists with a matching DFN, Accession, Study UID, Series UID,
+15 ; and SOP UID already
+16 NEW SOPOUT,SOPLINK
+17 IF TYPE'="STUDY"
IF TYPE'="SERIES"
IF TYPE'="SOP"
SET OUT="-1~TYPE is not Study, Series, or SOP"
QUIT
+18 SET OUT=0
+19 ; If the UID and the accession are already being used and the UID is not linked to the
+20 ; procedure REF with the same accession then the UID is a duplicate
+21 IF TYPE="STUDY"
IF $DATA(^MAGV(2005.62,"B",UID))
Begin DoDot:1
+22 IF $$LINKED(ACCESSION,DFN,UID,"STUDY")
QUIT
+23 SET OUT=1
+24 QUIT
End DoDot:1
+25 IF TYPE="SERIES"
IF $DATA(^MAGV(2005.63,"B",UID))
Begin DoDot:1
+26 IF $$LINKED(ACCESSION,DFN,UID,"SERIES",STUDUID)
QUIT
+27 SET OUT=1
+28 QUIT
End DoDot:1
+29 IF TYPE="SOP"
IF $DATA(^MAGV(2005.64,"B",UID))
Begin DoDot:1
+30 SET SOPLINK=$$LINKED(ACCESSION,DFN,UID,"SOP",STUDUID,SERUID)
+31 IF SOPLINK=2
SET OUT=0
QUIT
+32 ; P162 DAC - Check AOF before checking if duplicate
IF SOPLINK="NOT AOF"
SET OUT=0
QUIT
+33 IF SOPLINK=1
SET OUT=2
QUIT
+34 SET OUT=1
+35 QUIT
End DoDot:1
+36 QUIT OUT
DUPSTUD(DFN,ACCESSION,UID) ; Check for duplicate Study UID
+1 SET TYPE="STUDY"
+2 IF $GET(ACCESSION)=""
QUIT "-1~No accession number provided"
+3 IF $GET(DFN)=""
QUIT "-1~No patient DFN provided"
+4 DO DUPUID(.OUT,ACCESSION,DFN,TYPE,UID)
+5 QUIT OUT
DUPSER(DFN,ACCESSION,STUDUID,UID) ; Check for duplicate Series UID
+1 SET TYPE="SERIES"
+2 IF $GET(ACCESSION)=""
QUIT "-1~No accession number provided"
+3 IF $GET(DFN)=""
QUIT "-1~No patient DFN provided"
+4 DO DUPUID(.OUT,ACCESSION,DFN,TYPE,UID,STUDUID)
+5 QUIT OUT
DUPSOP(DFN,ACCESSION,STUDUID,SERUID,UID) ; Check for duplicate SOP UID
+1 SET TYPE="SOP"
+2 IF $GET(ACCESSION)=""
QUIT "-1~No accession number provided"
+3 IF $GET(DFN)=""
QUIT "-1~No patient DFN provided"
+4 DO DUPUID(.OUT,ACCESSION,DFN,TYPE,UID,STUDUID,SERUID)
+5 QUIT OUT
LINKED(ACCESSION,DFN,UID,UIDTYPE,STUDUIDA,SERUIDA) ; Check if duplicate UID is linked to the same procedure, patient, and parent Study, Series, SOP IENS
+1 ;P307 add STUDDUI0 (original study UID)
NEW LINK,IEN,PROCIEN,STUDYIEN,SERIESIEN,SOPIEN,PROCCASE,PRIEN,PRDFN,STATUS,STUDUIDB,SOPUIDB,PATPROC,SERUIDB,AOF,STUDUIDO
+2 SET LINK=0
+3 IF UIDTYPE="STUDY"
Begin DoDot:1
+4 ; Check if the Study IEN is linked to the procedure IEN with the Accession #
+5 SET STUDYIEN=""
+6 FOR
SET STUDYIEN=$ORDER(^MAGV(2005.62,"B",UID,STUDYIEN))
if STUDYIEN=""
QUIT
Begin DoDot:2
+7 SET STATUS=$PIECE($GET(^MAGV(2005.62,STUDYIEN,5)),U,2)
+8 if STATUS="I"
QUIT
+9 SET PATPROC=$GET(^MAGV(2005.62,STUDYIEN,6))
+10 SET PROCIEN=$PIECE(PATPROC,U,1)
+11 SET PRIEN=$PIECE(PATPROC,U,3)
+12 QUIT
End DoDot:2
if STATUS="A"
QUIT
+13 QUIT
End DoDot:1
+14 IF UIDTYPE="SERIES"
Begin DoDot:1
+15 ; Check if the Series IEN is linked to the procedure IEN with the Accession #
+16 SET SERIESIEN=""
+17 FOR
SET SERIESIEN=$ORDER(^MAGV(2005.63,"B",UID,SERIESIEN))
if SERIESIEN=""
QUIT
Begin DoDot:2
+18 SET STATUS=$GET(^MAGV(2005.63,SERIESIEN,9))
+19 if STATUS="I"
QUIT
+20 SET STUDYIEN=$PIECE($GET(^MAGV(2005.63,SERIESIEN,6)),U,1)
+21 SET STUDUIDB=$PIECE($GET(^MAGV(2005.62,STUDYIEN,0)),U,1)
+22 SET PATPROC=$GET(^MAGV(2005.62,STUDYIEN,6))
+23 SET PROCIEN=$PIECE(PATPROC,U,1)
+24 SET PRIEN=$PIECE(PATPROC,U,3)
+25 QUIT
End DoDot:2
if STATUS="A"
QUIT
+26 QUIT
End DoDot:1
+27 IF UIDTYPE="SOP"
Begin DoDot:1
+28 ; Check if the SOP IEN is linked to the procedure IEN with the Accession #
+29 SET SOPIEN=""
+30 FOR
SET SOPIEN=$ORDER(^MAGV(2005.64,"B",UID,SOPIEN))
if SOPIEN=""
QUIT
Begin DoDot:2
+31 SET STATUS=$GET(^MAGV(2005.64,SOPIEN,11))
+32 if STATUS="I"
QUIT
+33 SET AOF=$PIECE($GET(^MAGV(2005.64,SOPIEN,6)),U,2)
+34 SET SERIESIEN=$PIECE($GET(^MAGV(2005.64,SOPIEN,6)),U,1)
+35 SET SERUIDB=$PIECE($GET(^MAGV(2005.63,SERIESIEN,0)),U,1)
+36 SET STUDYIEN=$PIECE($GET(^MAGV(2005.63,SERIESIEN,6)),U,1)
+37 SET STUDUIDB=$PIECE($GET(^MAGV(2005.62,STUDYIEN,0)),U,1)
+38 SET PATPROC=$GET(^MAGV(2005.62,STUDYIEN,6))
+39 SET PROCIEN=$PIECE(PATPROC,U,1)
+40 SET PRIEN=$PIECE(PATPROC,U,3)
+41 QUIT
End DoDot:2
if STATUS="A"
QUIT
+42 QUIT
End DoDot:1
+43 ; Not linked to a procedure ref
IF $GET(PROCIEN)=""
QUIT LINK
+44 ; Not linked to a procedure ref
IF $GET(PRIEN)=""
QUIT LINK
+45 SET PROCCASE=$PIECE(^MAGV(2005.61,PROCIEN,0),U,1)
+46 SET PRDFN=$PIECE($GET(^MAGV(2005.6,PRIEN,0)),U,1)
+47 ;P307 get original study UID
SET STUDUIDO=$PIECE($GET(^MAGV(2005.62,STUDYIEN,0)),U,2)
+48 ;P307 replace study UID with original study UID for compare
IF (STUDUIDO]"")
IF (STUDUIDA'=STUDUIDB)
SET STUDUIDB=STUDUIDO
+49 IF PRDFN=DFN
IF ACCESSION=PROCCASE
SET LINK=1
+50 ;P307 use UIDTYPE passed rather than TYPE that falls through
IF UIDTYPE="SERIES"
IF LINK
IF STUDUIDA'=STUDUIDB
SET LINK=0
+51 ;P307 use UIDTYPE
IF UIDTYPE="SOP"
IF LINK
IF ((STUDUIDA'=STUDUIDB)!(SERUIDA'=SERUIDB))
SET LINK=0
+52 ;P307 use UIDTYPE
IF LINK=1
IF UIDTYPE="SOP"
IF AOF'=1
SET LINK="NOT AOF"
QUIT LINK
+53 ; P162 DAC - Check Status after AOF check. No accessible record found.
IF $GET(STATUS)="I"
QUIT 2
+54 QUIT LINK
LOGDUP(ORIGUID,NEWUID,ACCESSION,DFN,TYPE,STUDYUID,SERUID) ; Log duplicate UIDs
+1 NEW FDA,FILE,ONEWUID,SOCTYPE
+2 ; Store original generated NEWUID with postfix
SET ONEWUID=NEWUID
+3 IF TYPE="SERIES"
IF STUDYUID=""
SET NEWUID="-1~No Study UID provided"
QUIT
+4 IF TYPE="SOP"
IF STUDYUID=""
SET NEWUID="-1~No Study UID provided"
QUIT
+5 IF TYPE="SOP"
IF SERUID=""
SET NEWUID="-1~No Series UID provided"
QUIT
+6 ; Lock generated UID
LOCK +^MAGV(2005.66,"C",ONEWUID):1E9
+7 IF TYPE="STUDY"
SET SOCTYPE=1
+8 IF TYPE="SERIES"
SET SOCTYPE=2
+9 IF TYPE="SOP"
SET SOCTYPE=3
+10 SET FILE=2005.66
+11 DO LOGLOOK(.NEWUID)
+12 SET FDA(FILE,"+1,",.01)=ORIGUID
+13 SET FDA(FILE,"+1,",2)=NEWUID
+14 SET FDA(FILE,"+1,",3)=ACCESSION
+15 SET FDA(FILE,"+1,",4)=DFN
+16 SET FDA(FILE,"+1,",5)=SOCTYPE
+17 IF $GET(STUDYUID)'=""
SET FDA(FILE,"+1,",6)=STUDYUID
+18 IF $GET(SERUID)'=""
SET FDA(FILE,"+1,",7)=SERUID
+19 DO UPDATE^DIE("","FDA")
+20 ; Unlock original generated UID
LOCK -^MAGV(2005.66,"C",ONEWUID)
+21 ; Unlock new generated UID with postfix
IF NEWUID'=ONEWUID
LOCK -^MAGV(2005.66,"C",NEWUID)
+22 KILL FDA
+23 QUIT
LOGLOOK(NEWUID) ; Look for UID in duplicate log and generate a new UID if there is a duplicate
+1 NEW POSTFIX
+2 IF '$$UIDCHECK(NEWUID)
FOR POSTFIX=1:1
if $$UIDCHECK(NEWUID_"."_POSTFIX)
QUIT
+3 IF $GET(POSTFIX)'=""
Begin DoDot:1
+4 SET NEWUID=NEWUID_"."_POSTFIX
+5 LOCK +^MAGV(2005.66,"C",NEWUID):1E9
+6 QUIT
End DoDot:1
+7 QUIT
UIDCHECK(POSTUID) ; Check if newly generated UID exists in UID database indexes
+1 ; If UID is found return 0, if UID is not found return 1
+2 NEW UNIQUE
+3 SET UNIQUE=1
+4 ; Check file indexes for UID
Begin DoDot:1
+5 ; Check for duplicate in new UID log
+6 IF $DATA(^MAGV(2005.66,"C",POSTUID))
SET UNIQUE=0
QUIT
+7 ; Check for duplicate Study and SOP in 2005
+8 IF $DATA(^MAG(2005,"P",POSTUID))
SET UNIQUE=0
QUIT
+9 ; Check for duplicate Series in 2005
+10 IF $DATA(^MAG(2005,"SERIESUID",POSTUID))
SET UNIQUE=0
QUIT
+11 ; Check for duplicate Study in 2005.62
+12 IF $DATA(^MAGV(2005.62,"B",POSTUID))
SET UNIQUE=0
QUIT
+13 ; Check for duplicate Series in 2005.63
+14 IF $DATA(^MAGV(2005.63,"B",POSTUID))
SET UNIQUE=0
QUIT
+15 ; Check for duplicate SOP in 2005.64
+16 IF $DATA(^MAGV(2005.64,"B",POSTUID))
SET UNIQUE=0
QUIT
+17 QUIT
End DoDot:1
+18 QUIT UNIQUE
UIDLOOK(UID,DFN,ACC,TYPE,STUDYUID,SERUID) ; Look to see if Original UID exists and if entry matches DFN and ACC provided. If so, return New UID. Otherwise, 0.
+1 NEW OUT,IEN,ENTRY,ENTRY2,STYPE
+2 SET OUT=0
+3 IF (UID="")!($GET(DFN)="")!($GET(ACC)="")!($GET(TYPE)="")
QUIT OUT
+4 IF '$DATA(^MAGV(2005.66,"B",UID))
QUIT OUT
+5 IF TYPE="SERIES"
IF $GET(STUDYUID)=""
QUIT OUT
+6 IF TYPE="SOP"
IF ($GET(SERUID)="")!($GET(STUDYUID)="")
QUIT OUT
+7 IF TYPE="SERIES"
IF '$DATA(^MAGV(2005.66,"D",UID,$GET(STUDYUID)))
QUIT OUT
+8 IF TYPE="SOP"
IF '$DATA(^MAGV(2005.66,"E",UID,$GET(SERUID)))
QUIT OUT
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^MAGV(2005.66,"B",UID,IEN))
if (IEN="")!(OUT'=0)
QUIT
Begin DoDot:1
+11 SET ENTRY=$GET(^MAGV(2005.66,IEN,0))
+12 SET ENTRY2=$GET(^MAGV(2005.66,IEN,1))
+13 SET STYPE=$PIECE($$GET1^DIQ(2005.66,IEN,5)," ",1)
+14 IF DFN=$PIECE(ENTRY,U,4)
IF ACC=$PIECE(ENTRY,U,3)
IF TYPE=STYPE
Begin DoDot:2
+15 IF TYPE="STUDY"
IF $GET(UID)=$PIECE(ENTRY,U,1)
SET OUT=$PIECE(ENTRY,U,2)
QUIT
+16 IF TYPE="SERIES"
IF $GET(STUDYUID)=$PIECE(ENTRY2,U,1)
IF $GET(UID)=$PIECE(ENTRY,U,1)
SET OUT=$PIECE(ENTRY,U,2)
QUIT
+17 IF TYPE="SOP"
IF $GET(STUDYUID)=$PIECE(ENTRY2,U,1)
IF $GET(SERUID)=$PIECE(ENTRY2,U,2)
IF $GET(UID)=$PIECE(ENTRY,U,1)
SET OUT=$PIECE(ENTRY,U,2)
QUIT
End DoDot:2
End DoDot:1
+18 QUIT OUT
DELLOG(OUT,IEN,FILE) ; Remove inactivated entries from the duplicate log
+1 NEW DUPIEN,PIEN,ACC,DFN,SOPUID,SERUID,STUDUID,TYPE,ERR,UID,PATIEN,SSEP,PROCIEN,PATID,DUPDATA1,DUPDATA2
+2 NEW DUPACC,DUPPATID,DSERUID,IENS,FDA,DSTDUID,STUDDATA,DELETE
+3 ;
+4 SET OUT="0"
+5 SET SSEP=$$STATSEP^MAGVRS41
+6 IF (FILE'=2005.64)&(FILE'=2005.63)&(FILE'=2005.62)
SET OUT="-1"_SSEP_"Invalid file number"
QUIT
+7 IF IEN=""
SET OUT="-7"_SSEP_"No IEN provided"
QUIT
+8 IF FILE=2005.64
Begin DoDot:1
+9 SET (SOPUID,UID)=$PIECE($GET(^MAGV(2005.64,IEN,0)),U,1)
+10 SET IEN=$PIECE($GET(^MAGV(2005.64,IEN,6)),U,1)
+11 QUIT
End DoDot:1
+12 IF IEN=""
SET OUT="-8"_SSEP_"No Parent Record"
QUIT
+13 IF FILE>=2005.63
Begin DoDot:1
+14 IF FILE=2005.64
SET SERUID=$PIECE($GET(^MAGV(2005.63,IEN,0)),U,2)
+15 IF FILE=2005.63
SET SERUID=$PIECE($GET(^MAGV(2005.63,IEN,0)),U,1)
+16 IF '$DATA(UID)
SET UID=SERUID
+17 SET IEN=$PIECE($GET(^MAGV(2005.63,IEN,6)),U,1)
+18 QUIT
End DoDot:1
+19 IF IEN=""
SET OUT="-8"_SSEP_"No Parent Record"
QUIT
+20 IF FILE>=2005.62
Begin DoDot:1
+21 IF FILE=2005.62
SET STUDUID=$PIECE($GET(^MAGV(2005.62,IEN,0)),U,1)
+22 IF FILE'=2005.62
SET STUDUID=$PIECE($GET(^MAGV(2005.62,IEN,0)),U,2)
+23 IF '$DATA(UID)
SET UID=STUDUID
+24 SET STUDDATA=$GET(^MAGV(2005.62,IEN,6))
+25 SET PATIEN=$PIECE(STUDDATA,U,3)
+26 SET PROCIEN=$PIECE(STUDDATA,U,1)
+27 IF (PROCIEN="")!(PATIEN="")
QUIT
+28 SET ACC=$PIECE($GET(^MAGV(2005.61,PROCIEN,0)),U,1)
+29 SET PATID=$PIECE($GET(^MAGV(2005.6,PATIEN,0)),U,1)
+30 QUIT
End DoDot:1
+31 IF PATIEN=""
SET OUT="-9"_SSEP_"No Patient Record"
QUIT
+32 IF PROCIEN=""
SET OUT="-10"_SSEP_"No Procedure Record"
QUIT
+33 SET DUPIEN=""
+34 FOR DUPIEN=$ORDER(^MAGV(2005.66,"C",UID,DUPIEN))
if DUPIEN=""
QUIT
Begin DoDot:1
+35 SET DUPDATA1=$GET(^MAGV(2005.66,DUPIEN,0))
+36 SET DUPDATA2=$GET(^MAGV(2005.66,DUPIEN,1))
+37 SET DUPACC=$PIECE(DUPDATA1,U,3)
SET DUPPATID=$PIECE(DUPDATA1,U,4)
+38 SET DSTDUID=$PIECE(DUPDATA2,U,1)
SET DSERUID=$PIECE(DUPDATA2,U,2)
+39 SET DELETE=0
+40 ; SOP Check
IF FILE=2005.64
IF ACC=DUPACC
IF PATID=DUPPATID
IF ((STUDUID=DSTDUID)!('DSTDUID))
IF (($GET(SERUID)=DSERUID)!('DSERUID))
SET DELETE=1
+41 ; Series Check
IF FILE=2005.63
IF ACC=DUPACC
IF PATID=DUPPATID
IF ((STUDUID=DSTDUID)!('DSTDUID))
SET DELETE=1
+42 ; Study Check
IF FILE=2005.62
IF ACC=DUPACC
IF PATID=DUPPATID
SET DELETE=1
+43 IF DELETE
Begin DoDot:2
+44 ; Delete matching duplicate entries
+45 SET IENS=DUPIEN_","
+46 SET FDA(2005.66,IENS,.01)="@"
+47 DO FILE^DIE("","FDA","ERR")
+48 SET OUT="0"
+49 IF $DATA(ERR("DIERR"))
SET OUT="-11"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
+52 QUIT
+53 ;
