LRXDRPT ;SF-IRMFO.SEA/JLI/DALISC/FHS - HANDLE MERGE OF ENTRIES IN FILE 63 RELATED TO PATIENT MERGE ;10/30/97  11:50
 ;;5.2;LAB SERVICE;**205**;Sep 27, 1994
 ;;
 ;;
EN(LRRAY) ; Entry point for merging.  Array is the NAME of array in which the FROM IEN and the TO IEN are indicated, as @LRRAY@(LRFROMX,LRTO).
 ;IEN are IENs from ^DPT( to be merged
 ;example LRX(IEN_FROM,IEN_TO,"IEN_FROM;DPT(",IEN_TO;DPT(")=""
 N LRFROMX,LRTO,LRRAY1,LRFROMXA,LRTOA,LRZZZ,LRFRX,LRTOX,FROM
 S LRRAY1=$NA(^TMP($J,"LRMERG1"))
 K @LRRAY1
 S FROM=LRRAY1
 F LRFROMX=0:0 S LRFROMX=$O(@LRRAY@(LRFROMX)) Q:LRFROMX'>0  D
 . S LRFROMXA=+$G(^DPT(LRFROMX,"LR"))
 . I LRFROMXA,$S($P($G(^LR(LRFROMXA,0)),U,2)'=2:1,$P($G(^(0)),U,3)'=LRFROMX:1,1:0) D  Q
 . . ;W !,"Pointer between ^LR("_LRFROMXA_") and ^DPT("_LRFROMX_",LR) don't match."
 . . ;W !!?10,"Laboratory Patient merge terminated",!
 . . K @LRRAY@(LRFROMX)
 . S LRTO=$O(@LRRAY@(LRFROMX,0))
 . S LRTOA=+$G(^DPT(LRTO,"LR"))
 . I LRTOA,$S($P($G(^LR(LRTOA,0)),U,2)'=2:1,$P($G(^(0)),U,3)'=LRTO:1,1:0) D  Q
 . . ;W !,"Pointer between ^LR("_LRTOA_",0) and ^DPT("_LRTO_",""LR"") don't match"
 . . K @LRRAY@(LRFROMX,LRTO)
 . I LRFROMXA'="",LRFROMXA=LRTOA Q  ; ALREADY MERGED
 . S LRFROMXA=$S(LRFROMXA>0:LRFROMXA,1:0),LRTOA=$S(LRTOA>0:LRTOA,1:0)
 . S LRFRX=$O(@LRRAY@(LRFROMX,LRTO,"")),LRTOX=$O(@LRRAY@(LRFROMX,LRTO,LRFRX,""))
 . S @LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)=LRFROMX
 . I LRFROMXA=0 D  Q
 . . I LRTOA>0 D SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
 . . K @LRRAY1@(LRFROMXA,LRTOA)
 . I LRTOA=0 D  Q
 . . D SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
 . . K @LRRAY1@(LRFROMXA,LRTOA)
 . . S ^DPT(LRTO,"LR")=LRFROMXA
 . . S LRZZZ(63,LRFROMXA_",",.03)=LRTO
 . . D UPDATE^DIE("","LRZZZ")
 I $D(@LRRAY1) D
 . S LRFROMXA="" F  S LRFROMXA=$O(@LRRAY1@(LRFROMXA)) Q:LRFROMXA=""  I $D(^LR(LRFROMXA,"T")) D
 . . S LRTOA=$O(@LRRAY1@(LRFROMXA,""))
 . . M ^LR(LRTOA,"T")=^LR(LRFROMXA,"T")
 . D EN^XDRMERG(63,LRRAY1)
 F LRFROMXA=0:0 S LRFROMXA=$O(@LRRAY1@(LRFROMXA)) Q:LRFROMXA'>0  D
 . S LRTOA=$O(@LRRAY1@(LRFROMXA,0))
 . S LRFRX=$O(@LRRAY1@(LRFROMXA,LRTOA,""))
 . S LRTOX=$O(@LRRAY1@(LRFROMXA,LRTOA,LRFRX,""))
 . S LRFROMX=@LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)
 . S ^DPT(LRFROMX,"LR")=LRTOA
 . K ^LR(LRFROMXA)
 K @LRRAY1
 Q