| 1 | LRXDRPT ;SF-IRMFO.SEA/JLI/DALISC/FHS - HANDLE MERGE OF ENTRIES IN FILE 63 RELATED TO PATIENT MERGE ;10/30/97 11:50
|
|---|
| 2 | ;;5.2;LAB SERVICE;**205**;Sep 27, 1994
|
|---|
| 3 | ;;
|
|---|
| 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).
|
|---|
| 6 | ;IEN are IENs from ^DPT( to be merged
|
|---|
| 7 | ;example LRX(IEN_FROM,IEN_TO,"IEN_FROM;DPT(",IEN_TO;DPT(")=""
|
|---|
| 8 | N LRFROMX,LRTO,LRRAY1,LRFROMXA,LRTOA,LRZZZ,LRFRX,LRTOX,FROM
|
|---|
| 9 | S LRRAY1=$NA(^TMP($J,"LRMERG1"))
|
|---|
| 10 | K @LRRAY1
|
|---|
| 11 | S FROM=LRRAY1
|
|---|
| 12 | F LRFROMX=0:0 S LRFROMX=$O(@LRRAY@(LRFROMX)) Q:LRFROMX'>0 D
|
|---|
| 13 | . S LRFROMXA=+$G(^DPT(LRFROMX,"LR"))
|
|---|
| 14 | . I LRFROMXA,$S($P($G(^LR(LRFROMXA,0)),U,2)'=2:1,$P($G(^(0)),U,3)'=LRFROMX:1,1:0) D Q
|
|---|
| 15 | . . ;W !,"Pointer between ^LR("_LRFROMXA_") and ^DPT("_LRFROMX_",LR) don't match."
|
|---|
| 16 | . . ;W !!?10,"Laboratory Patient merge terminated",!
|
|---|
| 17 | . . K @LRRAY@(LRFROMX)
|
|---|
| 18 | . S LRTO=$O(@LRRAY@(LRFROMX,0))
|
|---|
| 19 | . S LRTOA=+$G(^DPT(LRTO,"LR"))
|
|---|
| 20 | . I LRTOA,$S($P($G(^LR(LRTOA,0)),U,2)'=2:1,$P($G(^(0)),U,3)'=LRTO:1,1:0) D Q
|
|---|
| 21 | . . ;W !,"Pointer between ^LR("_LRTOA_",0) and ^DPT("_LRTO_",""LR"") don't match"
|
|---|
| 22 | . . K @LRRAY@(LRFROMX,LRTO)
|
|---|
| 23 | . I LRFROMXA'="",LRFROMXA=LRTOA Q ; ALREADY MERGED
|
|---|
| 24 | . S LRFROMXA=$S(LRFROMXA>0:LRFROMXA,1:0),LRTOA=$S(LRTOA>0:LRTOA,1:0)
|
|---|
| 25 | . S LRFRX=$O(@LRRAY@(LRFROMX,LRTO,"")),LRTOX=$O(@LRRAY@(LRFROMX,LRTO,LRFRX,""))
|
|---|
| 26 | . S @LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)=LRFROMX
|
|---|
| 27 | . I LRFROMXA=0 D Q
|
|---|
| 28 | . . I LRTOA>0 D SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
|
|---|
| 29 | . . K @LRRAY1@(LRFROMXA,LRTOA)
|
|---|
| 30 | . I LRTOA=0 D Q
|
|---|
| 31 | . . D SAVEMERG^XDRMERGB(63,LRFROMXA,LRTOA)
|
|---|
| 32 | . . K @LRRAY1@(LRFROMXA,LRTOA)
|
|---|
| 33 | . . S ^DPT(LRTO,"LR")=LRFROMXA
|
|---|
| 34 | . . S LRZZZ(63,LRFROMXA_",",.03)=LRTO
|
|---|
| 35 | . . D UPDATE^DIE("","LRZZZ")
|
|---|
| 36 | I $D(@LRRAY1) D
|
|---|
| 37 | . S LRFROMXA="" F S LRFROMXA=$O(@LRRAY1@(LRFROMXA)) Q:LRFROMXA="" I $D(^LR(LRFROMXA,"T")) D
|
|---|
| 38 | . . S LRTOA=$O(@LRRAY1@(LRFROMXA,""))
|
|---|
| 39 | . . M ^LR(LRTOA,"T")=^LR(LRFROMXA,"T")
|
|---|
| 40 | . D EN^XDRMERG(63,LRRAY1)
|
|---|
| 41 | F LRFROMXA=0:0 S LRFROMXA=$O(@LRRAY1@(LRFROMXA)) Q:LRFROMXA'>0 D
|
|---|
| 42 | . S LRTOA=$O(@LRRAY1@(LRFROMXA,0))
|
|---|
| 43 | . S LRFRX=$O(@LRRAY1@(LRFROMXA,LRTOA,""))
|
|---|
| 44 | . S LRTOX=$O(@LRRAY1@(LRFROMXA,LRTOA,LRFRX,""))
|
|---|
| 45 | . S LRFROMX=@LRRAY1@(LRFROMXA,LRTOA,LRFRX,LRTOX)
|
|---|
| 46 | . S ^DPT(LRFROMX,"LR")=LRTOA
|
|---|
| 47 | . K ^LR(LRFROMXA)
|
|---|
| 48 | K @LRRAY1
|
|---|
| 49 | Q
|
|---|
