MAGVRS61.m

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 ---MAGVRS61   11628     printed  Mar 13, 2025@21:15:21                                                                                                                                                                                                   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