PSBXMRG ;ROUTINE TO MERGE ENTRIES IN BCMA MED LOG FILE FOR PATIENT MERGE ;Mar 2004
 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;Reference to EN^XDRMERG is supported by DBIA #2365
 ;Reference to SAVEMERG^XDRMERGB is supported by DBIA #2338
 ;
EN(ARRAY) ; Entry point called with NAME of array containing from, and to entries.
 ;
 N XARRAY,IBDIC,FROMX,TO,FROMX1,TO1,FROM,FRX,TOX
 S XARRAY=$NA(^TMP("PSB",$J))
 K @XARRAY
 S FROM=XARRAY
 S IBDIC=$G(^DIC(53.79,0,"GL"))
 I IBDIC="" Q
 F FROMX=0:0 S FROMX=$O(@ARRAY@(FROMX)) Q:FROMX'>0  D
 . S TO=$O(@ARRAY@(FROMX,0))
 . S FROMX1=$O(@(IBDIC_"""B"",FROMX,0)"))
 . S TO1=$O(@(IBDIC_"""B"",TO,0)"))
 . I TO1="",FROMX1="" Q
 . S TO1=$S(TO1>0:TO1,1:0),FROMX1=$S(FROMX1>0:FROMX1,1:0)
 . S FRX=$O(@ARRAY@(FROMX,TO,"")),TOX=$O(@ARRAY@(FROMX,TO,FRX,TOX))
 . S @XARRAY@(FROMX1,TO1,FRX,TOX)=""
 . I FROMX1=0 D  Q
 . . D SAVEMERG^XDRMERGB(53.79,FROMX1,TO1)
 . . K @XARRAY@(FROMX1,TO1)
 . I TO1=0 D  Q
 . . D SAVEMERG^XDRMERGB(53.79,FROMX1,TO1)
 . . K @XARRAY@(FROMX1,TO1)
 . . N IBDXXX
 . . S IBDXXX(53.79,(FROMX1_","),.01)=TO
 . . D UPDATE^DIE("","IBDXXX")
 I '$D(@XARRAY) Q
 D EN^XDRMERG(53.79,"XARRAY") ; NOW CONVERT ANY POINTERS TO THE MERGED ENTRIES
 S IBDIC=$G(^DIC(53.79,0,"GL"))
 I IBDIC'="" D
 . F FROMX=0:0 S FROMX=$O(@XARRAY@(FROMX)) Q:FROMX'>0  K @(IBDIC_FROMX_")")
 Q