AUM15DU ;IHS/OIT/NKD - DUPLICATE ICD9 UTILITY 09/09/14 ;
;;15.0;TABLE MAINTENANCE;;SEP 09,2014;Build 1
;
Q
MAIN ; EP - FIND DUPLICATE ICD9 ENTRIES AND MERGE AS AN ARRAY
N ID
S ID=$NA(^XTMP("AUM",$$NOW^XLFDT))
D SEARCH(ID)
I $G(@ID@("COUNT")) D STAGE1(ID),STAGE2(ID),STAGE3(ID)
Q
SEARCH(ID) ; EP - SEARCH FOR DUPLICATES
N CNT,CNT2,RES
K @ID S @ID@("COUNT")=0
; CREATE LIST
S CNT=" " F S CNT=$O(^ICD9("AB",CNT)) Q:CNT']"" D
. S RES="",CNT2=0 F S CNT2=$O(^ICD9("AB",CNT,CNT2)) Q:'CNT2 S RES=RES_CNT2_U ; HIGH -> LOW
. I CNT["." S CNT2=0 F S CNT2=$O(^ICD9("AB",$TR(CNT,"."),CNT2)) Q:'CNT2 S RES=RES_CNT2_U ; ADD ANY MATCHES W/O . FORMAT
. S:$E(RES,$L(RES))=U RES=$E(RES,1,$L(RES)-1)
. Q:$L(RES,U)'>1
. S @ID@("COUNT")=+$G(@ID@("COUNT"))+1
. Q:ID["SCAN"
. S @ID@("DUP",$P(RES,U,2),$P(RES,U,1),$P(RES,U,2)_";ICD9(",$P(RES,U,1)_";ICD9(")=""
. S:CNT["." ^TMP("AUM",$J,"DUP",CNT)=$P(RES,U)
Q:ID["SCAN"
I '$G(@ID@("COUNT")) D RSLT^AUM15(" Searching for duplicates..."_$J("",3)_"No duplicates found!") Q
D RSLT^AUM15(" Searching for duplicates..."_$J("",3)_$G(@ID@("COUNT"))_" found: XDR REPOINTED ENTRY (#15.3)")
Q
STAGE1(ID) ; PRE-MERGE
N CNT
S @ID@("BPM")=$$GET^XPAR("PKG","BPM USE IHS LOGIC")
I $G(@ID@("BPM")) D CHG^XPAR("PKG","BPM USE IHS LOGIC",,0)
S @ID@("XDRM-BEFORE")=+$O(^XDRM("@"),-1)
S CNT=0 F S CNT=$O(^PXD(811.3,CNT)) Q:'CNT D
. Q:'$D(^PXD(811.3,CNT,80))
. Q:$G(^PXD(811.3,CNT,80,0))]""
. S ^PXD(811.3,CNT,80,0)="^811.31PA^^"
D RSLT^AUM15(" Pre-Merge Stage..."_$J("",12)_"Complete")
Q
STAGE2(ID) ; MERGE
N XDRTIME
S (@ID@("START"),XDRTIME)=$H
D RSLT^AUM15(" Merge started: "_$J("",15)_$$HTE^XLFDT($G(@ID@("START"))),1)
I $$VERSION^XPDUTL("ABM")=2.6 D MRGD2D($NA(@ID@("DUP")),9002274.3,"^ABMDCLM(","^ABMDCLM(")
I $$VERSION^XPDUTL("ABM")=2.6 D MRGD2D($NA(@ID@("DUP")),9002274.4,"^ABMDBILL(","^ABMDBILL(")
D EN^XDRMERG(80,$NA(@ID@("DUP")))
S @ID@("STOP")=$H
D RSLT^AUM15(" Merge completed: "_$J("",13)_$$HTE^XLFDT($G(@ID@("STOP"))))
D RSLT^AUM15(" Elapsed time: "_$J("",16)_$$HDIFF^XLFDT($G(@ID@("STOP")),$G(@ID@("START")),3))
Q
STAGE3(ID) ; POST-MERGE
N CNT,CNT2
I $G(@ID@("BPM")) D CHG^XPAR("PKG","BPM USE IHS LOGIC",,$G(@ID@("BPM")))
S @ID@("XDRM-AFTER")=+$O(^XDRM("@"),-1)
D RSLT^AUM15(" Post-Merge Stage..."_$J("",11)_"Complete",1)
S CNT=$G(@ID@("XDRM-BEFORE")),CNT2=$G(@ID@("XDRM-AFTER"))
I CNT2>CNT D RSLT^AUM15(" Details stored in MERGE IMAGES (#15.4): IEN "_(CNT+1)_"-"_CNT2)
Q
MRGD2D(FROM,FILEI,XVAL,XR) ; MERGE 3PB DUZ(2) AND DINUM ENTRIES - CODE BASE FROM DINUM^XDRMERG2
N IENOLD,IENNEW,XDUZO,XDUZ,XDA,XDA2,XVAL1,XPC
S XDUZO=DUZ(2)
S XDUZ=0 F S XDUZ=$O(@(XVAL_XDUZ_")")) Q:'XDUZ D ; LOOP THROUGH DUZ2 (XDUZ)
. S DUZ(2)=XDUZ,XDA=0 F S XDA=$O(@(XVAL_XDUZ_","_XDA_")")) Q:'XDA D ; LOOP THROUGH ENTRIES (XDA)
. . S XVAL1=XVAL_XDUZ_","_XDA_",5)" I $D(@XVAL1) D ;ADMITTING DIAGNOSIS (#.59)
. . . S IENOLD=$P($G(@XVAL1),U,9),IENNEW=$S(+IENOLD:$O(@FROM@(IENOLD,0)),1:0)
. . . I IENNEW S $P(@XVAL1,U,9)=IENNEW I FILEI=9002274.3 K @(XVAL_XDUZ_",""AINP"","_IENOLD_","_XDA_")") S @(XVAL_XDUZ_",""AINP"","_IENNEW_","_XDA_")")=""
. . S XVAL1=XVAL_XDUZ_","_XDA_",8)" I $D(@XVAL1) F XPC=12,19,20 D ;E-CODE (#.857-#.859)
. . . S IENOLD=$P($G(@XVAL1),U,XPC),IENNEW=$S(+IENOLD:$O(@FROM@(IENOLD,0)),1:0)
. . . S:IENNEW $P(@XVAL1,U,XPC)=IENNEW
. . S XVAL1=XVAL_XDUZ_","_XDA_",17,",XDA2=0 F S XDA2=$O(@(XVAL1_XDA2_")")) Q:'XDA2 D
. . . S IENOLD=$P($G(@(XVAL1_XDA2_",0)")),U,4),IENNEW=$S(+IENOLD:$O(@FROM@(IENOLD,0)),1:0) ;E-CODE (#.04)
. . . S:IENNEW $P(@(XVAL1_XDA2_",0)"),U,4)=IENNEW
. . . S IENOLD=XDA2,IENNEW=$O(@FROM@(XDA2,0)) Q:'IENNEW ;DINUM-ED SUBFILES
. . . I '$D(@(XVAL1_IENNEW_",0)")) D ^XBFMK S DIC=XVAL1,DIC(0)="L",X=IENNEW,DINUM=IENNEW D FILE^DICN
. . . D MERGEIT(XVAL1,IENOLD,IENNEW,FILEI+.0017,XDA_",")
S DUZ(2)=XDUZO
Q
MERGEIT(XDRDIC,IENFROM,IENTO,FILEI,XDRIENS) ; MERGE TWO ENTRIES IN FILE - CODE BASE FROM MERGEIT^XDRMERGB
N NODE,NODE1,NODE2,XDRXX,DIK,DA,I,Y,XFILNO,IENTOSTR,XDRZZ
N XDRAA ; DEBUG STATEMENT
;
S:+$G(FILEI)&(+$P(@(XDRDIC_"0)"),U,2)'=$G(FILEI)) $P(@(XDRDIC_"0)"),U,2)=$G(FILEI)_"P"
S XFILNO=+$P(@(XDRDIC_"0)"),U,2)
S IENTOSTR=IENTO_","_XDRIENS
;
S NODE=""
F D Q:NODE=""
. S NODE1=$O(@(XDRDIC_IENFROM_","""_NODE_""")"))
. I NODE1="" S NODE="" Q ; NOTHING MORE TO MOVE OVER
. S NODE2=$O(@(XDRDIC_IENTO_","""_NODE_""")"))
. I NODE2'="",NODE1]NODE2 S NODE=NODE2 Q ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
. S NODE=NODE1
. I $D(@(XDRDIC_IENFROM_","""_NODE_""")"))=1 D Q ; SINGLE NODE, MERGE DATA
. . I NODE2]NODE1!(NODE2="") D Q ; MISSING NODE, JUST MOVE IT OVER
. . . N XDRXX,FLD,N,J
. . . F N=0:0 S N=$O(^DD(XFILNO,"GL",NODE,N)) Q:N'>0 S FLD=$O(^(N,0)) I $O(^DD(XFILNO,FLD,1,0))>0 D
. . . . S X=0 F J=0:0 S J=$O(^DD(XFILNO,FLD,1,J)) Q:J'>0 I $O(^(J,0))>0 S X=1 Q
. . . . I X>0 D
. . . . . S XDRXX(XFILNO,IENTOSTR,FLD)=$P(@(XDRDIC_IENFROM_","""_NODE_""")"),U,N)
. . . K XDRAA I $D(XDRTESTK),$D(XDRXX) M XDRAA=XDRXX ; DEBUG STATEMENT
. . . K XDRZZ
. . . I $D(XDRXX) D FILE^DIE("","XDRXX","XDRZZ")
. . . I $D(XDRTESTK),$D(XDRZZ) S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ ; DEBUG STATMENT
. . . M @(XDRDIC_IENTO_","""_NODE_""")")=@(XDRDIC_IENFROM_","""_NODE_""")")
. . I $D(@(XDRDIC_IENTO_","""_NODE_""")"))>1 Q ; MISMATCH SO QUIT
. . N XDRXX,FLD
. . S X1=@(XDRDIC_IENFROM_","""_NODE_""")")
. . S (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
. . F I=1:1 Q:X1="" S X=$P(X1,U),X1=$P(X1,U,2,999) I X'="" D
. . . S Y=$P(X2,U,I)
. . . I Y="" D
. . . . S $P(X2,U,I)=X
. . . . S FLD=$O(^DD(XFILNO,"GL",NODE,I,0)) S JXFLD=FLD
. . . . I FLD>0,$O(^DD(XFILNO,FLD,1,0))>0 S XDRXX(XFILNO,IENTOSTR,FLD)=X
. . I X2'=X3 D
. . . I $D(XDRXX) D
. . . . K XDRAA I $D(XDRTESTK) M XDRAA=XDRXX ; DEBUG STATEMENT
. . . . K XDRZZ
. . . . N X2 D FILE^DIE("","XDRXX","XDRZZ")
. . . . I $D(XDRTESTK),$D(XDRZZ) S XDRTESTK=XDRTESTK+1 M ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ ; DEBUG STATMENT
. . . S @(XDRDIC_IENTO_","""_NODE_""")")=X2 ; SET MERGED DATA ON NODE
S XDRXX=$P(@(XDRDIC_IENFROM_",0)"),U)
K DA N DIU S DIU(0)=1 S DIK=XDRDIC,DA=IENFROM,DA(1)=$P(XDRIENS,",") D ^DIK ; KILL OFF MERGED FROM ENTRY
Q
AUM15DU ;IHS/OIT/NKD - DUPLICATE ICD9 UTILITY 09/09/14 ;
+1 ;;15.0;TABLE MAINTENANCE;;SEP 09,2014;Build 1
+2 ;
+3 QUIT
MAIN ; EP - FIND DUPLICATE ICD9 ENTRIES AND MERGE AS AN ARRAY
+1 NEW ID
+2 SET ID=$NAME(^XTMP("AUM",$$NOW^XLFDT))
+3 DO SEARCH(ID)
+4 IF $GET(@ID@("COUNT"))
DO STAGE1(ID)
DO STAGE2(ID)
DO STAGE3(ID)
+5 QUIT
SEARCH(ID) ; EP - SEARCH FOR DUPLICATES
+1 NEW CNT,CNT2,RES
+2 KILL @ID
SET @ID@("COUNT")=0
+3 ; CREATE LIST
+4 SET CNT=" "
FOR
SET CNT=$ORDER(^ICD9("AB",CNT))
IF CNT']""
QUIT
Begin DoDot:1
+5 ; HIGH -> LOW
SET RES=""
SET CNT2=0
FOR
SET CNT2=$ORDER(^ICD9("AB",CNT,CNT2))
IF 'CNT2
QUIT
SET RES=RES_CNT2_U
+6 ; ADD ANY MATCHES W/O . FORMAT
IF CNT["."
SET CNT2=0
FOR
SET CNT2=$ORDER(^ICD9("AB",$TRANSLATE(CNT,"."),CNT2))
IF 'CNT2
QUIT
SET RES=RES_CNT2_U
+7 IF $EXTRACT(RES,$LENGTH(RES))=U
SET RES=$EXTRACT(RES,1,$LENGTH(RES)-1)
+8 IF $LENGTH(RES,U)'>1
QUIT
+9 SET @ID@("COUNT")=+$GET(@ID@("COUNT"))+1
+10 IF ID["SCAN"
QUIT
+11 SET @ID@("DUP",$PIECE(RES,U,2),$PIECE(RES,U,1),$PIECE(RES,U,2)_";ICD9(",$PIECE(RES,U,1)_";ICD9(")=""
+12 IF CNT["."
SET ^TMP("AUM",$JOB,"DUP",CNT)=$PIECE(RES,U)
End DoDot:1
+13 IF ID["SCAN"
QUIT
+14 IF '$GET(@ID@("COUNT"))
DO RSLT^AUM15(" Searching for duplicates..."_$JUSTIFY("",3)_"No duplicates found!")
QUIT
+15 DO RSLT^AUM15(" Searching for duplicates..."_$JUSTIFY("",3)_$GET(@ID@("COUNT"))_" found: XDR REPOINTED ENTRY (#15.3)")
+16 QUIT
STAGE1(ID) ; PRE-MERGE
+1 NEW CNT
+2 SET @ID@("BPM")=$$GET^XPAR("PKG","BPM USE IHS LOGIC")
+3 IF $GET(@ID@("BPM"))
DO CHG^XPAR("PKG","BPM USE IHS LOGIC",,0)
+4 SET @ID@("XDRM-BEFORE")=+$ORDER(^XDRM("@"),-1)
+5 SET CNT=0
FOR
SET CNT=$ORDER(^PXD(811.3,CNT))
IF 'CNT
QUIT
Begin DoDot:1
+6 IF '$DATA(^PXD(811.3,CNT,80))
QUIT
+7 IF $GET(^PXD(811.3,CNT,80,0))]""
QUIT
+8 SET ^PXD(811.3,CNT,80,0)="^811.31PA^^"
End DoDot:1
+9 DO RSLT^AUM15(" Pre-Merge Stage..."_$JUSTIFY("",12)_"Complete")
+10 QUIT
STAGE2(ID) ; MERGE
+1 NEW XDRTIME
+2 SET (@ID@("START"),XDRTIME)=$HOROLOG
+3 DO RSLT^AUM15(" Merge started: "_$JUSTIFY("",15)_$$HTE^XLFDT($GET(@ID@("START"))),1)
+4 IF $$VERSION^XPDUTL("ABM")=2.6
DO MRGD2D($NAME(@ID@("DUP")),9002274.3,"^ABMDCLM(","^ABMDCLM(")
+5 IF $$VERSION^XPDUTL("ABM")=2.6
DO MRGD2D($NAME(@ID@("DUP")),9002274.4,"^ABMDBILL(","^ABMDBILL(")
+6 DO EN^XDRMERG(80,$NAME(@ID@("DUP")))
+7 SET @ID@("STOP")=$HOROLOG
+8 DO RSLT^AUM15(" Merge completed: "_$JUSTIFY("",13)_$$HTE^XLFDT($GET(@ID@("STOP"))))
+9 DO RSLT^AUM15(" Elapsed time: "_$JUSTIFY("",16)_$$HDIFF^XLFDT($GET(@ID@("STOP")),$GET(@ID@("START")),3))
+10 QUIT
STAGE3(ID) ; POST-MERGE
+1 NEW CNT,CNT2
+2 IF $GET(@ID@("BPM"))
DO CHG^XPAR("PKG","BPM USE IHS LOGIC",,$GET(@ID@("BPM")))
+3 SET @ID@("XDRM-AFTER")=+$ORDER(^XDRM("@"),-1)
+4 DO RSLT^AUM15(" Post-Merge Stage..."_$JUSTIFY("",11)_"Complete",1)
+5 SET CNT=$GET(@ID@("XDRM-BEFORE"))
SET CNT2=$GET(@ID@("XDRM-AFTER"))
+6 IF CNT2>CNT
DO RSLT^AUM15(" Details stored in MERGE IMAGES (#15.4): IEN "_(CNT+1)_"-"_CNT2)
+7 QUIT
MRGD2D(FROM,FILEI,XVAL,XR) ; MERGE 3PB DUZ(2) AND DINUM ENTRIES - CODE BASE FROM DINUM^XDRMERG2
+1 NEW IENOLD,IENNEW,XDUZO,XDUZ,XDA,XDA2,XVAL1,XPC
+2 SET XDUZO=DUZ(2)
+3 ; LOOP THROUGH DUZ2 (XDUZ)
SET XDUZ=0
FOR
SET XDUZ=$ORDER(@(XVAL_XDUZ_")"))
IF 'XDUZ
QUIT
Begin DoDot:1
+4 ; LOOP THROUGH ENTRIES (XDA)
SET DUZ(2)=XDUZ
SET XDA=0
FOR
SET XDA=$ORDER(@(XVAL_XDUZ_","_XDA_")"))
IF 'XDA
QUIT
Begin DoDot:2
+5 ;ADMITTING DIAGNOSIS (#.59)
SET XVAL1=XVAL_XDUZ_","_XDA_",5)"
IF $DATA(@XVAL1)
Begin DoDot:3
+6 SET IENOLD=$PIECE($GET(@XVAL1),U,9)
SET IENNEW=$SELECT(+IENOLD:$ORDER(@FROM@(IENOLD,0)),1:0)
+7 IF IENNEW
SET $PIECE(@XVAL1,U,9)=IENNEW
IF FILEI=9002274.3
KILL @(XVAL_XDUZ_",""AINP"","_IENOLD_","_XDA_")")
SET @(XVAL_XDUZ_",""AINP"","_IENNEW_","_XDA_")")=""
End DoDot:3
+8 ;E-CODE (#.857-#.859)
SET XVAL1=XVAL_XDUZ_","_XDA_",8)"
IF $DATA(@XVAL1)
FOR XPC=12,19,20
Begin DoDot:3
+9 SET IENOLD=$PIECE($GET(@XVAL1),U,XPC)
SET IENNEW=$SELECT(+IENOLD:$ORDER(@FROM@(IENOLD,0)),1:0)
+10 IF IENNEW
SET $PIECE(@XVAL1,U,XPC)=IENNEW
End DoDot:3
+11 SET XVAL1=XVAL_XDUZ_","_XDA_",17,"
SET XDA2=0
FOR
SET XDA2=$ORDER(@(XVAL1_XDA2_")"))
IF 'XDA2
QUIT
Begin DoDot:3
+12 ;E-CODE (#.04)
SET IENOLD=$PIECE($GET(@(XVAL1_XDA2_",0)")),U,4)
SET IENNEW=$SELECT(+IENOLD:$ORDER(@FROM@(IENOLD,0)),1:0)
+13 IF IENNEW
SET $PIECE(@(XVAL1_XDA2_",0)"),U,4)=IENNEW
+14 ;DINUM-ED SUBFILES
SET IENOLD=XDA2
SET IENNEW=$ORDER(@FROM@(XDA2,0))
IF 'IENNEW
QUIT
+15 IF '$DATA(@(XVAL1_IENNEW_",0)"))
DO ^XBFMK
SET DIC=XVAL1
SET DIC(0)="L"
SET X=IENNEW
SET DINUM=IENNEW
DO FILE^DICN
+16 DO MERGEIT(XVAL1,IENOLD,IENNEW,FILEI+.0017,XDA_",")
End DoDot:3
End DoDot:2
End DoDot:1
+17 SET DUZ(2)=XDUZO
+18 QUIT
MERGEIT(XDRDIC,IENFROM,IENTO,FILEI,XDRIENS) ; MERGE TWO ENTRIES IN FILE - CODE BASE FROM MERGEIT^XDRMERGB
+1 NEW NODE,NODE1,NODE2,XDRXX,DIK,DA,I,Y,XFILNO,IENTOSTR,XDRZZ
+2 ; DEBUG STATEMENT
NEW XDRAA
+3 ;
+4 IF +$GET(FILEI)&(+$PIECE(@(XDRDIC_"0)"),U,2)'=$GET(FILEI))
SET $PIECE(@(XDRDIC_"0)"),U,2)=$GET(FILEI)_"P"
+5 SET XFILNO=+$PIECE(@(XDRDIC_"0)"),U,2)
+6 SET IENTOSTR=IENTO_","_XDRIENS
+7 ;
+8 SET NODE=""
+9 FOR
Begin DoDot:1
+10 SET NODE1=$ORDER(@(XDRDIC_IENFROM_","""_NODE_""")"))
+11 ; NOTHING MORE TO MOVE OVER
IF NODE1=""
SET NODE=""
QUIT
+12 SET NODE2=$ORDER(@(XDRDIC_IENTO_","""_NODE_""")"))
+13 ; NODE ON TO, BUT NOT ON FROM - GO TO NEXT
IF NODE2'=""
IF NODE1]NODE2
SET NODE=NODE2
QUIT
+14 SET NODE=NODE1
+15 ; SINGLE NODE, MERGE DATA
IF $DATA(@(XDRDIC_IENFROM_","""_NODE_""")"))=1
Begin DoDot:2
+16 ; MISSING NODE, JUST MOVE IT OVER
IF NODE2]NODE1!(NODE2="")
Begin DoDot:3
+17 NEW XDRXX,FLD,N,J
+18 FOR N=0:0
SET N=$ORDER(^DD(XFILNO,"GL",NODE,N))
IF N'>0
QUIT
SET FLD=$ORDER(^(N,0))
IF $ORDER(^DD(XFILNO,FLD,1,0))>0
Begin DoDot:4
+19 SET X=0
FOR J=0:0
SET J=$ORDER(^DD(XFILNO,FLD,1,J))
IF J'>0
QUIT
IF $ORDER(^(J,0))>0
SET X=1
QUIT
+20 IF X>0
Begin DoDot:5
+21 SET XDRXX(XFILNO,IENTOSTR,FLD)=$PIECE(@(XDRDIC_IENFROM_","""_NODE_""")"),U,N)
End DoDot:5
End DoDot:4
+22 ; DEBUG STATEMENT
KILL XDRAA
IF $DATA(XDRTESTK)
IF $DATA(XDRXX)
MERGE XDRAA=XDRXX
+23 KILL XDRZZ
+24 IF $DATA(XDRXX)
DO FILE^DIE("","XDRXX","XDRZZ")
+25 ; DEBUG STATMENT
IF $DATA(XDRTESTK)
IF $DATA(XDRZZ)
SET XDRTESTK=XDRTESTK+1
MERGE ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ
+26 MERGE @(XDRDIC_IENTO_","""_NODE_""")")=@(XDRDIC_IENFROM_","""_NODE_""")")
End DoDot:3
QUIT
+27 ; MISMATCH SO QUIT
IF $DATA(@(XDRDIC_IENTO_","""_NODE_""")"))>1
QUIT
+28 NEW XDRXX,FLD
+29 SET X1=@(XDRDIC_IENFROM_","""_NODE_""")")
+30 SET (X2,X3)=@(XDRDIC_IENTO_","""_NODE_""")")
+31 FOR I=1:1
IF X1=""
QUIT
SET X=$PIECE(X1,U)
SET X1=$PIECE(X1,U,2,999)
IF X'=""
Begin DoDot:3
+32 SET Y=$PIECE(X2,U,I)
+33 IF Y=""
Begin DoDot:4
+34 SET $PIECE(X2,U,I)=X
+35 SET FLD=$ORDER(^DD(XFILNO,"GL",NODE,I,0))
SET JXFLD=FLD
+36 IF FLD>0
IF $ORDER(^DD(XFILNO,FLD,1,0))>0
SET XDRXX(XFILNO,IENTOSTR,FLD)=X
End DoDot:4
End DoDot:3
+37 IF X2'=X3
Begin DoDot:3
+38 IF $DATA(XDRXX)
Begin DoDot:4
+39 ; DEBUG STATEMENT
KILL XDRAA
IF $DATA(XDRTESTK)
MERGE XDRAA=XDRXX
+40 KILL XDRZZ
+41 NEW X2
DO FILE^DIE("","XDRXX","XDRZZ")
+42 ; DEBUG STATMENT
IF $DATA(XDRTESTK)
IF $DATA(XDRZZ)
SET XDRTESTK=XDRTESTK+1
MERGE ^XTMP("XDRTESTK",$$NOW^XLFDT(),XDRTESTK,"XX")=XDRAA,^("ZZ")=XDRZZ
End DoDot:4
+43 ; SET MERGED DATA ON NODE
SET @(XDRDIC_IENTO_","""_NODE_""")")=X2
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
IF NODE=""
QUIT
+44 SET XDRXX=$PIECE(@(XDRDIC_IENFROM_",0)"),U)
+45 ; KILL OFF MERGED FROM ENTRY
KILL DA
NEW DIU
SET DIU(0)=1
SET DIK=XDRDIC
SET DA=IENFROM
SET DA(1)=$PIECE(XDRIENS,",")
DO ^DIK
+46 QUIT
