MAGVIM09 ;WOIFO/DAC,BT,MAT,JSJ,RRM - Utilities for RPC calls for DICOM file processing ; Oct 04, 2022@19:19:13
;;3.0;IMAGING;**118,138,332,345**;Mar 19, 2002;Build 2
;; Per VA Directive 6402, 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. |
;; +---------------------------------------------------------------+
;;
Q
;
; +++++ Get a record from a WORK ITEM file (#2006.941) by IEN
;
; Input parameters
; ================
; ID = IEN in the file
; STARTCNT = starting line in OUT array
;
; Return Values
; =============
; OUT(STARTCNT)="WorkItemHeader"_delimited "`" fields values
; OUT(STARTCNT+1..n)=Message
; OUT(n+1..m)=Tags`TagName`TagValue
;
GETWI(OUT,ID,STOPTAG) ; Return Work Item record in OUT array
; OUT - array that holds the result
; ID - IEN of the Work Item
; STOPTAG - The last tag of a record to be returned (optional)
N FILE,IENS,MAGOUT,ERR,FLD,CNT,TAGS,I,AFLD,DATA
N SSEP,OSEP,STOP,TAGNAME,TAGVALUE
S SSEP=$$STATSEP^MAGVIM01,OSEP=$$OUTSEP^MAGVIM01
S FILE=2006.941
S IENS=ID_","
D GETS^DIQ(FILE,ID_",","*","IE","MAGOUT","ERR")
I $D(ERR) S OUT="-1"_SSEP_$G(ERR("DIERR",1,"TEXT",1)) Q
; Type of the return field values - internal, external, date
S AFLD(.01)="D" ; CREATED DATE/TIME
S AFLD(1)="E" ; TYPE
S AFLD(2)="E" ; SUBTYPE
S AFLD(3)="E" ; STATUS
S AFLD(4)="I" ; LOCATION
S AFLD(5)="E" ; PRIORITY
S AFLD(8)="IE" ; CREATING USER
S AFLD(9)="D" ; LAST UPDATED DATE/TIME
S AFLD(10)="IE" ; LAST UPDATING USER
S AFLD(14)="E" ; CREATING APPLICATION
S AFLD(15)="E" ; LAST UPDATING APPLICATION
S AFLD(16)="E" ; SC TRANSACTION ID
;
;Convert Institution IEN to Station Number
I $G(MAGOUT(FILE,IENS,4,"I")) D
. S MAGOUT(FILE,IENS,4,"I")=$$STA^XUAF4(MAGOUT(FILE,IENS,4,"I")) ;IA #2171 Get station number for an IEN
. Q
;
S CNT=OUT(0)+1
S FLD=0
S OUT(CNT)="WorkItemHeader"_SSEP_ID
F S FLD=$O(MAGOUT(FILE,IENS,FLD)) Q:FLD="" D
. Q:FLD=13 ; Word-processing field
. I AFLD(FLD)["D" S OUT(CNT)=OUT(CNT)_OSEP_$$FMTE^XLFDT(MAGOUT(FILE,IENS,FLD,"I"),5) ; Date fields
. I AFLD(FLD)["I" S OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"I")
. I AFLD(FLD)["E" S OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"E")
. Q
; Get Message
S I=0 F S I=$O(MAGOUT(FILE,IENS,13,I)) Q:I'>0 D
. S CNT=CNT+1,OUT(CNT)="Message"_SSEP_MAGOUT(FILE,IENS,13,I)
. Q
; Get Tags
S TAGS=2006.94111,I="",STOP=0
S I=0
F S I=$O(^MAGV(2006.941,ID,4,I)) Q:I="" D Q:STOP=1
. S DATA=$G(^MAGV(2006.941,ID,4,I,0))
. S TAGNAME=$P(DATA,U,1),TAGVALUE=$P(DATA,U,2)
. S CNT=CNT+1,OUT(CNT)="Tag"_SSEP_TAGNAME_OSEP_TAGVALUE
. I $G(STOPTAG)'="",STOPTAG=TAGNAME S STOP=1
S OUT(0)=CNT
Q
;
;P332 IMSTATUS moved from MAGVIM01 because routine size was exceeded
; RPC: MAGV IMPORT STATUS from MAGVIM01
IMSTATUS(OUT,UIDS) ; Get import status
N SSEP,STUDYLIST,SOPLIST,STUDYOUT,SOPOUT,I,CNT,STUDYUID,SERUID,SOPUID,ISEP,SOPIEN,SERIEN,STUDIEN,FOUNDUID
N ONFILESOP
S SSEP=$$OUTSEP^MAGVIM01,ISEP=$$INPUTSEP^MAGVIM01,I=0,CNT=0 ;P332 add routine to calls
I '$D(UIDS) S OUT(1)=-6_SSEP_"No UIDs provided" Q
F S I=$O(UIDS(I)) Q:I="" D
. S CNT=I,FOUNDUID="",ONFILESOP=0
. S STUDYUID=$P(UIDS(I),ISEP,1),SERUID=$P(UIDS(I),ISEP,2),SOPUID=$P(UIDS(I),ISEP,3)
. I $G(STUDYUID)="" S OUT(I+1)=-1_SSEP_"No study UID provided" Q
. I $G(SERUID)="" S OUT(I+1)=-2_SSEP_"No series UID provided" Q
. I $G(SOPUID)="" S OUT(I+1)=-3_SSEP_"No SOP UID provided" Q
. S OUT(I+1)=-1_SSEP_UIDS(I)_SSEP_"not on file"
. S STUDYLIST(1)=1,STUDYLIST(2)=STUDYUID
. S SOPLIST(1)=1,SOPLIST(2)=SOPUID
. ; Check ^MAG(2005) for import study status
. D CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
. I STUDYOUT(2)'="",(+STUDYOUT(2))'<0 D
. . D CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
. . I SOPOUT(2)'="",(+SOPOUT(2))'<0 D S CNT=I
. . . S OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
. . . S ONFILESOP=1
. . . Q
. . Q
. I $G(STUDYOUT(2))="",$G(ONFILESOP)<1 D SOPCHECK(.UIDS,I) Q:$G(ONFILESOP)
. S SOPOUT=""
. ; Check SOP original and UID
. I ('$D(^MAGV(2005.64,"B",SOPUID)))&('$D(^MAGV(2005.66,"B",SOPUID))) D SOPCHECK(.UIDS,I) Q
. S SOPIEN=$O(^MAGV(2005.64,"B",SOPUID,""),-1)
. ;if null try dup(replaced) UID
. I SOPIEN="" S SOPIEN=$$DUPUID(.UIDS,I,SOPUID,3) ;P332 Check for replacement
. Q:SOPIEN=""
. I $G(^MAGV(2005.64,SOPIEN,11))'="A" Q
. ; Check Series original and UID
. I ('$D(^MAGV(2005.63,"B",SERUID)))&('$D(^MAGV(2005.66,"B",SERUID))) D Q:$G(FOUNDUID)=""
. . I $G(SOPIEN)'="" S FOUNDUID=$$RECHKFLE(.UIDS,I,SOPUID,2)
. S SERIEN=$O(^MAGV(2005.63,"B",$S($G(FOUNDUID)'="":FOUNDUID,1:SERUID),""),-1)
. ;if null try dup(replaced) UID
. I SERIEN="" S SERIEN=$$DUPUID(.UIDS,I,SERUID,2) ;P332 Check for replacement
. Q:SERIEN=""
. I $G(^MAGV(2005.63,SERIEN,9))'="A" Q
. ; Check Study original and UID
. I ('$D(^MAGV(2005.62,"B",STUDYUID)))&('$D(^MAGV(2005.66,"B",STUDYUID))) D Q:$G(FOUNDUID)=""
. . I $G(SERIEN)'="" S FOUNDUID=$$RECHKFLE(.UIDS,I,SERUID,1)
. S STUDIEN=$O(^MAGV(2005.62,"B",$S($G(FOUNDUID)'="":FOUNDUID,1:STUDYUID),""),-1)
. ;if null try dup(replaced) UID
. I STUDIEN="" S STUDIEN=$$DUPUID(.UIDS,I,STUDYUID,1) ;P332 Check for replacement
. Q:STUDIEN=""
. I $P($G(^MAGV(2005.62,STUDIEN,5)),U,2)'="A" Q
. S OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
. I SOPIEN'="" S ONFILESOP=1
. Q
;
S OUT(1)=0_SSEP_CNT
Q
;
SOPCHECK(UIDS,I) ;
N MAG2005IEN,MAGPARENTIEN
S SOPUID=$P(UIDS(I),ISEP,3)
I $D(^MAG(2005,"P",SOPUID)) D
. D CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
. I SOPOUT(2)'="",(+SOPOUT(2))'<0 D
. . D CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
. . I SOPOUT(2)'="",(+SOPOUT(2))'<0 S OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
. . S ONFILESOP=1
Q
;
RECHKFLE(UIDS,I,UID,TYPE) ;
N FILE,NEWUID
I TYPE=1 S FILE=2005.63
I TYPE=2 S FILE=2005.64
I $D(^MAGV(FILE,"B",UID)) D
. S IEN=$O(^MAGV(FILE,"B",UID,""),-1)
. S IEN=$P(^MAGV(FILE,IEN,6),"^")
. I TYPE=1 D
. . S NEWUID=$P($G(^MAGV(2005.62,IEN,0)),"^")
. . ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
. I TYPE=2 D
. . S NEWUID=$P($G(^MAGV(2005.63,IEN,0)),"^")
. . ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
Q NEWUID
;
;Set replaced UID in UIDS array if found in 2005.66 duplicate file
DUPUID(UIDS,I,UID,TYPE) ;P332 added sub
; UIDS - Array of UIDs
; I - Current array element of UIDS being processed
; UID - Original UID of TYPE being checked for duplicate
; TYPE - UID type - 1-STUDY, 2-SERIES, 3-SOP
I UID=""!(TYPE="") Q ""
NEW IEN,FILE,REC0,RPLFND,RPLIEN
S FILE=$P("2005.62,2005.63,2005.64",",",TYPE)
S (IEN,RPLIEN,RPLFND)=""
;loop dup index from latest and quit if a match is found
F S RPLIEN=$O(^MAGV(2005.66,"B",UID,RPLIEN),-1) Q:(RPLIEN="")!RPLFND D
. S REC0=$G(^MAGV(2005.66,RPLIEN,0))
. I TYPE'=$P(REC0,U,5) Q ;UID type mismatch
. I UID'=$P(REC0,U) Q ;UID doesn't match orig in dup record
. ;verify dup UID is in file index and UID matches original UID in FILE
. S IEN=$O(^MAGV(FILE,"B",$P(REC0,U,2),""),-1) ;get IEN from file with replaced UID
. I IEN="" Q ;replaced UID not in FILE index
. I UID'=$P($G(^MAGV(FILE,IEN,0)),"^",2) Q ;original UID does not match
. S $P(UIDS(I),ISEP,TYPE)=$P(REC0,U,2) ;set replacement UID
. S RPLFND=1 ;quit loop
Q IEN ;return FILE IEN for replaced UID (or null if not found)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM09 8304 printed Oct 16, 2024@18:10:36 Page 2
MAGVIM09 ;WOIFO/DAC,BT,MAT,JSJ,RRM - Utilities for RPC calls for DICOM file processing ; Oct 04, 2022@19:19:13
+1 ;;3.0;IMAGING;**118,138,332,345**;Mar 19, 2002;Build 2
+2 ;; Per VA Directive 6402, 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 ;
+19 ; +++++ Get a record from a WORK ITEM file (#2006.941) by IEN
+20 ;
+21 ; Input parameters
+22 ; ================
+23 ; ID = IEN in the file
+24 ; STARTCNT = starting line in OUT array
+25 ;
+26 ; Return Values
+27 ; =============
+28 ; OUT(STARTCNT)="WorkItemHeader"_delimited "`" fields values
+29 ; OUT(STARTCNT+1..n)=Message
+30 ; OUT(n+1..m)=Tags`TagName`TagValue
+31 ;
GETWI(OUT,ID,STOPTAG) ; Return Work Item record in OUT array
+1 ; OUT - array that holds the result
+2 ; ID - IEN of the Work Item
+3 ; STOPTAG - The last tag of a record to be returned (optional)
+4 NEW FILE,IENS,MAGOUT,ERR,FLD,CNT,TAGS,I,AFLD,DATA
+5 NEW SSEP,OSEP,STOP,TAGNAME,TAGVALUE
+6 SET SSEP=$$STATSEP^MAGVIM01
SET OSEP=$$OUTSEP^MAGVIM01
+7 SET FILE=2006.941
+8 SET IENS=ID_","
+9 DO GETS^DIQ(FILE,ID_",","*","IE","MAGOUT","ERR")
+10 IF $DATA(ERR)
SET OUT="-1"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
QUIT
+11 ; Type of the return field values - internal, external, date
+12 ; CREATED DATE/TIME
SET AFLD(.01)="D"
+13 ; TYPE
SET AFLD(1)="E"
+14 ; SUBTYPE
SET AFLD(2)="E"
+15 ; STATUS
SET AFLD(3)="E"
+16 ; LOCATION
SET AFLD(4)="I"
+17 ; PRIORITY
SET AFLD(5)="E"
+18 ; CREATING USER
SET AFLD(8)="IE"
+19 ; LAST UPDATED DATE/TIME
SET AFLD(9)="D"
+20 ; LAST UPDATING USER
SET AFLD(10)="IE"
+21 ; CREATING APPLICATION
SET AFLD(14)="E"
+22 ; LAST UPDATING APPLICATION
SET AFLD(15)="E"
+23 ; SC TRANSACTION ID
SET AFLD(16)="E"
+24 ;
+25 ;Convert Institution IEN to Station Number
+26 IF $GET(MAGOUT(FILE,IENS,4,"I"))
Begin DoDot:1
+27 ;IA #2171 Get station number for an IEN
SET MAGOUT(FILE,IENS,4,"I")=$$STA^XUAF4(MAGOUT(FILE,IENS,4,"I"))
+28 QUIT
End DoDot:1
+29 ;
+30 SET CNT=OUT(0)+1
+31 SET FLD=0
+32 SET OUT(CNT)="WorkItemHeader"_SSEP_ID
+33 FOR
SET FLD=$ORDER(MAGOUT(FILE,IENS,FLD))
if FLD=""
QUIT
Begin DoDot:1
+34 ; Word-processing field
if FLD=13
QUIT
+35 ; Date fields
IF AFLD(FLD)["D"
SET OUT(CNT)=OUT(CNT)_OSEP_$$FMTE^XLFDT(MAGOUT(FILE,IENS,FLD,"I"),5)
+36 IF AFLD(FLD)["I"
SET OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"I")
+37 IF AFLD(FLD)["E"
SET OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"E")
+38 QUIT
End DoDot:1
+39 ; Get Message
+40 SET I=0
FOR
SET I=$ORDER(MAGOUT(FILE,IENS,13,I))
if I'>0
QUIT
Begin DoDot:1
+41 SET CNT=CNT+1
SET OUT(CNT)="Message"_SSEP_MAGOUT(FILE,IENS,13,I)
+42 QUIT
End DoDot:1
+43 ; Get Tags
+44 SET TAGS=2006.94111
SET I=""
SET STOP=0
+45 SET I=0
+46 FOR
SET I=$ORDER(^MAGV(2006.941,ID,4,I))
if I=""
QUIT
Begin DoDot:1
+47 SET DATA=$GET(^MAGV(2006.941,ID,4,I,0))
+48 SET TAGNAME=$PIECE(DATA,U,1)
SET TAGVALUE=$PIECE(DATA,U,2)
+49 SET CNT=CNT+1
SET OUT(CNT)="Tag"_SSEP_TAGNAME_OSEP_TAGVALUE
+50 IF $GET(STOPTAG)'=""
IF STOPTAG=TAGNAME
SET STOP=1
End DoDot:1
if STOP=1
QUIT
+51 SET OUT(0)=CNT
+52 QUIT
+53 ;
+54 ;P332 IMSTATUS moved from MAGVIM01 because routine size was exceeded
+55 ; RPC: MAGV IMPORT STATUS from MAGVIM01
IMSTATUS(OUT,UIDS) ; Get import status
+1 NEW SSEP,STUDYLIST,SOPLIST,STUDYOUT,SOPOUT,I,CNT,STUDYUID,SERUID,SOPUID,ISEP,SOPIEN,SERIEN,STUDIEN,FOUNDUID
+2 NEW ONFILESOP
+3 ;P332 add routine to calls
SET SSEP=$$OUTSEP^MAGVIM01
SET ISEP=$$INPUTSEP^MAGVIM01
SET I=0
SET CNT=0
+4 IF '$DATA(UIDS)
SET OUT(1)=-6_SSEP_"No UIDs provided"
QUIT
+5 FOR
SET I=$ORDER(UIDS(I))
if I=""
QUIT
Begin DoDot:1
+6 SET CNT=I
SET FOUNDUID=""
SET ONFILESOP=0
+7 SET STUDYUID=$PIECE(UIDS(I),ISEP,1)
SET SERUID=$PIECE(UIDS(I),ISEP,2)
SET SOPUID=$PIECE(UIDS(I),ISEP,3)
+8 IF $GET(STUDYUID)=""
SET OUT(I+1)=-1_SSEP_"No study UID provided"
QUIT
+9 IF $GET(SERUID)=""
SET OUT(I+1)=-2_SSEP_"No series UID provided"
QUIT
+10 IF $GET(SOPUID)=""
SET OUT(I+1)=-3_SSEP_"No SOP UID provided"
QUIT
+11 SET OUT(I+1)=-1_SSEP_UIDS(I)_SSEP_"not on file"
+12 SET STUDYLIST(1)=1
SET STUDYLIST(2)=STUDYUID
+13 SET SOPLIST(1)=1
SET SOPLIST(2)=SOPUID
+14 ; Check ^MAG(2005) for import study status
+15 DO CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
+16 IF STUDYOUT(2)'=""
IF (+STUDYOUT(2))'<0
Begin DoDot:2
+17 DO CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
+18 IF SOPOUT(2)'=""
IF (+SOPOUT(2))'<0
Begin DoDot:3
+19 SET OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
+20 SET ONFILESOP=1
+21 QUIT
End DoDot:3
SET CNT=I
+22 QUIT
End DoDot:2
+23 IF $GET(STUDYOUT(2))=""
IF $GET(ONFILESOP)<1
DO SOPCHECK(.UIDS,I)
if $GET(ONFILESOP)
QUIT
+24 SET SOPOUT=""
+25 ; Check SOP original and UID
+26 IF ('$DATA(^MAGV(2005.64,"B",SOPUID)))&('$DATA(^MAGV(2005.66,"B",SOPUID)))
DO SOPCHECK(.UIDS,I)
QUIT
+27 SET SOPIEN=$ORDER(^MAGV(2005.64,"B",SOPUID,""),-1)
+28 ;if null try dup(replaced) UID
+29 ;P332 Check for replacement
IF SOPIEN=""
SET SOPIEN=$$DUPUID(.UIDS,I,SOPUID,3)
+30 if SOPIEN=""
QUIT
+31 IF $GET(^MAGV(2005.64,SOPIEN,11))'="A"
QUIT
+32 ; Check Series original and UID
+33 IF ('$DATA(^MAGV(2005.63,"B",SERUID)))&('$DATA(^MAGV(2005.66,"B",SERUID)))
Begin DoDot:2
+34 IF $GET(SOPIEN)'=""
SET FOUNDUID=$$RECHKFLE(.UIDS,I,SOPUID,2)
End DoDot:2
if $GET(FOUNDUID)=""
QUIT
+35 SET SERIEN=$ORDER(^MAGV(2005.63,"B",$SELECT($GET(FOUNDUID)'="":FOUNDUID,1:SERUID),""),-1)
+36 ;if null try dup(replaced) UID
+37 ;P332 Check for replacement
IF SERIEN=""
SET SERIEN=$$DUPUID(.UIDS,I,SERUID,2)
+38 if SERIEN=""
QUIT
+39 IF $GET(^MAGV(2005.63,SERIEN,9))'="A"
QUIT
+40 ; Check Study original and UID
+41 IF ('$DATA(^MAGV(2005.62,"B",STUDYUID)))&('$DATA(^MAGV(2005.66,"B",STUDYUID)))
Begin DoDot:2
+42 IF $GET(SERIEN)'=""
SET FOUNDUID=$$RECHKFLE(.UIDS,I,SERUID,1)
End DoDot:2
if $GET(FOUNDUID)=""
QUIT
+43 SET STUDIEN=$ORDER(^MAGV(2005.62,"B",$SELECT($GET(FOUNDUID)'="":FOUNDUID,1:STUDYUID),""),-1)
+44 ;if null try dup(replaced) UID
+45 ;P332 Check for replacement
IF STUDIEN=""
SET STUDIEN=$$DUPUID(.UIDS,I,STUDYUID,1)
+46 if STUDIEN=""
QUIT
+47 IF $PIECE($GET(^MAGV(2005.62,STUDIEN,5)),U,2)'="A"
QUIT
+48 SET OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
+49 IF SOPIEN'=""
SET ONFILESOP=1
+50 QUIT
End DoDot:1
+51 ;
+52 SET OUT(1)=0_SSEP_CNT
+53 QUIT
+54 ;
SOPCHECK(UIDS,I) ;
+1 NEW MAG2005IEN,MAGPARENTIEN
+2 SET SOPUID=$PIECE(UIDS(I),ISEP,3)
+3 IF $DATA(^MAG(2005,"P",SOPUID))
Begin DoDot:1
+4 DO CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
+5 IF SOPOUT(2)'=""
IF (+SOPOUT(2))'<0
Begin DoDot:2
+6 DO CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
+7 IF SOPOUT(2)'=""
IF (+SOPOUT(2))'<0
SET OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
+8 SET ONFILESOP=1
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
RECHKFLE(UIDS,I,UID,TYPE) ;
+1 NEW FILE,NEWUID
+2 IF TYPE=1
SET FILE=2005.63
+3 IF TYPE=2
SET FILE=2005.64
+4 IF $DATA(^MAGV(FILE,"B",UID))
Begin DoDot:1
+5 SET IEN=$ORDER(^MAGV(FILE,"B",UID,""),-1)
+6 SET IEN=$PIECE(^MAGV(FILE,IEN,6),"^")
+7 IF TYPE=1
Begin DoDot:2
+8 SET NEWUID=$PIECE($GET(^MAGV(2005.62,IEN,0)),"^")
+9 ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
End DoDot:2
+10 IF TYPE=2
Begin DoDot:2
+11 SET NEWUID=$PIECE($GET(^MAGV(2005.63,IEN,0)),"^")
+12 ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
End DoDot:2
End DoDot:1
+13 QUIT NEWUID
+14 ;
+15 ;Set replaced UID in UIDS array if found in 2005.66 duplicate file
DUPUID(UIDS,I,UID,TYPE) ;P332 added sub
+1 ; UIDS - Array of UIDs
+2 ; I - Current array element of UIDS being processed
+3 ; UID - Original UID of TYPE being checked for duplicate
+4 ; TYPE - UID type - 1-STUDY, 2-SERIES, 3-SOP
+5 IF UID=""!(TYPE="")
QUIT ""
+6 NEW IEN,FILE,REC0,RPLFND,RPLIEN
+7 SET FILE=$PIECE("2005.62,2005.63,2005.64",",",TYPE)
+8 SET (IEN,RPLIEN,RPLFND)=""
+9 ;loop dup index from latest and quit if a match is found
+10 FOR
SET RPLIEN=$ORDER(^MAGV(2005.66,"B",UID,RPLIEN),-1)
if (RPLIEN="")!RPLFND
QUIT
Begin DoDot:1
+11 SET REC0=$GET(^MAGV(2005.66,RPLIEN,0))
+12 ;UID type mismatch
IF TYPE'=$PIECE(REC0,U,5)
QUIT
+13 ;UID doesn't match orig in dup record
IF UID'=$PIECE(REC0,U)
QUIT
+14 ;verify dup UID is in file index and UID matches original UID in FILE
+15 ;get IEN from file with replaced UID
SET IEN=$ORDER(^MAGV(FILE,"B",$PIECE(REC0,U,2),""),-1)
+16 ;replaced UID not in FILE index
IF IEN=""
QUIT
+17 ;original UID does not match
IF UID'=$PIECE($GET(^MAGV(FILE,IEN,0)),"^",2)
QUIT
+18 ;set replacement UID
SET $PIECE(UIDS(I),ISEP,TYPE)=$PIECE(REC0,U,2)
+19 ;quit loop
SET RPLFND=1
End DoDot:1
+20 ;return FILE IEN for replaced UID (or null if not found)
QUIT IEN
