| 1 | IBAXDR ;SF-IRMFO/JLI,REM - ROUTINE TO MERGE ENTRIES IN IB FILE FOR PATIENT MERGE ;3/9/98 13:35
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**94**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;;
|
|---|
| 5 | ;;
|
|---|
| 6 | EN(ARRAY) ; Entry point called with NAME of array containing from, and to entries.
|
|---|
| 7 | ;
|
|---|
| 8 | N XARRAY,IBDIC,FROMX,TO,FROMX1,TO1,FROM,FRX,TOX
|
|---|
| 9 | S XARRAY=$NA(^TMP($J,"IBDUMR1"))
|
|---|
| 10 | K @XARRAY
|
|---|
| 11 | S FROM=XARRAY
|
|---|
| 12 | S IBDIC=$G(^DIC(351.1,0,"GL"))
|
|---|
| 13 | I IBDIC="" Q
|
|---|
| 14 | F FROMX=0:0 S FROMX=$O(@ARRAY@(FROMX)) Q:FROMX'>0 D
|
|---|
| 15 | . S TO=$O(@ARRAY@(FROMX,0))
|
|---|
| 16 | . S FROMX1=$O(@(IBDIC_"""B"",FROMX,0)"))
|
|---|
| 17 | . S TO1=$O(@(IBDIC_"""B"",TO,0)"))
|
|---|
| 18 | . I TO1="",FROMX1="" Q
|
|---|
| 19 | . S TO1=$S(TO1>0:TO1,1:0),FROMX1=$S(FROMX1>0:FROMX1,1:0)
|
|---|
| 20 | . S FRX=$O(@ARRAY@(FROMX,TO,"")),TOX=$O(@ARRAY@(FROMX,TO,FRX,TOX))
|
|---|
| 21 | . S @XARRAY@(FROMX1,TO1,FRX,TOX)=""
|
|---|
| 22 | . I FROMX1=0 D Q
|
|---|
| 23 | . . D SAVEMERG^XDRMERGB(351.1,FROMX1,TO1)
|
|---|
| 24 | . . K @XARRAY@(FROMX1,TO1)
|
|---|
| 25 | . I TO1=0 D Q
|
|---|
| 26 | . . D SAVEMERG^XDRMERGB(351.1,FROMX1,TO1)
|
|---|
| 27 | . . K @XARRAY@(FROMX1,TO1)
|
|---|
| 28 | . . N IBDXXX
|
|---|
| 29 | . . S IBDXXX(351.1,(FROMX1_","),.01)=TO
|
|---|
| 30 | . . D UPDATE^DIE("","IBDXXX")
|
|---|
| 31 | I '$D(@XARRAY) Q
|
|---|
| 32 | D EN^XDRMERG(351.1,"XARRAY") ; NOW CONVERT ANY POINTERS TO THE MERGED ENTRIES
|
|---|
| 33 | S IBDIC=$G(^DIC(351.1,0,"GL"))
|
|---|
| 34 | I IBDIC'="" D
|
|---|
| 35 | . F FROMX=0:0 S FROMX=$O(@XARRAY@(FROMX)) Q:FROMX'>0 K @(IBDIC_FROMX_")")
|
|---|
| 36 | Q
|
|---|
