- 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
