LRXDRPT ; IHS/DIR/AAB - SF-IRMFO.SEA/JLI/DALISC/FHS - HANDLE MERGE OF ENTRIES IN FILE 63 RELATED TO PATIENT MERGE 11:50 ; [ 10/30/97 ]
;;5.2;LR;**1006**;SEP 01, 1998
;
;;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
LRXDRPT ; IHS/DIR/AAB - SF-IRMFO.SEA/JLI/DALISC/FHS - HANDLE MERGE OF ENTRIES IN FILE 63 RELATED TO PATIENT MERGE 11:50 ; [ 10/30/97 ]
+1 ;;5.2;LR;**1006**;SEP 01, 1998
+2 ;
+3 ;;5.2;LAB SERVICE;**205**;Sep 27, 1994
+4 ;;
+5 ;;
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).
+1 ;IEN are IENs from ^DPT( to be merged
+2 ;example LRX(IEN_FROM,IEN_TO,"IEN_FROM;DPT(",IEN_TO;DPT(")=""
+3 NEW LRFROMX,LRTO,LRRAY1,LRFROMXA,LRTOA,LRZZZ,LRFRX,LRTOX,FROM
+4 SET LRRAY1=$NAME(^TMP($JOB,"LRMERG1"))
+5 KILL @LRRAY1
+6 SET FROM=LRRAY1
+7 FOR LRFROMX=0:0
SET LRFROMX=$ORDER(@LRRAY@(LRFROMX))
IF LRFROMX'>0
QUIT
Begin DoDot:1
+8 SET LRFROMXA=+$GET(^DPT(LRFROMX,"LR"))
+9 IF LRFROMXA
IF $SELECT($PIECE($GET(^LR(LRFROMXA,0)),U,2)'=2:1,$PIECE($GET(^(0)),U,3)'=LRFROMX:1,1:0)
Begin DoDot:2
+10 ;W !,"Pointer between ^LR("_LRFROMXA_") and ^DPT("_LRFROMX_",LR) don't match."
+11 ;W !!?10,"Laboratory Patient merge terminated",!
+12 KILL @LRRAY@(LRFROMX)
End DoDot:2
QUIT
+13 SET LRTO=$ORDER(@LRRAY@(LRFROMX,0))
+14 SET LRTOA=+$GET(^DPT(LRTO,"LR"))
+15 IF LRTOA
IF $SELECT($PIECE($GET(^LR(LRTOA,0)),U,2)'=2:1,$PIECE($GET(^(0)),U,3)'=LRTO:1,1:0)
Begin DoDot:2
+16 ;W !,"Pointer between ^LR("_LRTOA_",0) and ^DPT("_LRTO_",""LR"") don't match"
+17 KILL @LRRAY@(LRFROMX,LRTO)
End DoDot:2
QUIT
+18 ; ALREADY MERGED
IF LRFROMXA'=""
IF LRFROMXA=LRTOA
QUIT
+19 SET LRFROMXA=$SELECT(LRFROMXA>0:LRFROMXA,1:0)
SET LRTOA=$SELECT(LRTOA>0:LRTOA,1:0)
+20 SET LRFRX=$ORDER(@LRRAY@(LRFROMX,LRTO,""))
SET LRTOX=$ORDER(@LRRAY@(LRFROMX,LRTO,LRFRX,""))
+21 SET @LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)=LRFROMX
+22 IF LRFROMXA=0
Begin DoDot:2
+23 IF LRTOA>0
DO SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
+24 KILL @LRRAY1@(LRFROMXA,LRTOA)
End DoDot:2
QUIT
+25 IF LRTOA=0
Begin DoDot:2
+26 DO SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
+27 KILL @LRRAY1@(LRFROMXA,LRTOA)
+28 SET ^DPT(LRTO,"LR")=LRFROMXA
+29 SET LRZZZ(63,LRFROMXA_",",.03)=LRTO
+30 DO UPDATE^DIE("","LRZZZ")
End DoDot:2
QUIT
End DoDot:1
+31 IF $DATA(@LRRAY1)
Begin DoDot:1
+32 SET LRFROMXA=""
FOR
SET LRFROMXA=$ORDER(@LRRAY1@(LRFROMXA))
IF LRFROMXA=""
QUIT
IF $DATA(^LR(LRFROMXA,"T"))
Begin DoDot:2
+33 SET LRTOA=$ORDER(@LRRAY1@(LRFROMXA,""))
+34 MERGE ^LR(LRTOA,"T")=^LR(LRFROMXA,"T")
End DoDot:2
+35 DO EN^XDRMERG(63,LRRAY1)
End DoDot:1
+36 FOR LRFROMXA=0:0
SET LRFROMXA=$ORDER(@LRRAY1@(LRFROMXA))
IF LRFROMXA'>0
QUIT
Begin DoDot:1
+37 SET LRTOA=$ORDER(@LRRAY1@(LRFROMXA,0))
+38 SET LRFRX=$ORDER(@LRRAY1@(LRFROMXA,LRTOA,""))
+39 SET LRTOX=$ORDER(@LRRAY1@(LRFROMXA,LRTOA,LRFRX,""))
+40 SET LRFROMX=@LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)
+41 SET ^DPT(LRFROMX,"LR")=LRTOA
+42 KILL ^LR(LRFROMXA)
End DoDot:1
+43 KILL @LRRAY1
+44 QUIT
