| 1 | IBCU83 ;ALB/ARH - THIRD PARTY BILLING UTILITES (BILL-CT) ; 3/10/96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**48,347**;21-MAR-94;Build 24
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | IFNTRN(IBIFN,ARRAY,ARR2) ; find CT records for events on a bill: sched adm, inpt adm, outpt vsts, rx refills, prosthetics
|
|---|
| 6 | ; sets ARRAY=COUNT, ARRAY(IBTRN)=EV TYPE, if bill passed in defined
|
|---|
| 7 | ; ARR2(DATE,TRN)=TRN (based on IBCC1 and IBJTU5)
|
|---|
| 8 | ;
|
|---|
| 9 | N IBI,IBX,IBD0,DFN,IBTYP,IBTRN,IBDT,IBBDT,IBEDT,IBRX,IBRXN,IBPR,IBPRN,IBBILL,IBN K ARRAY,ARR2
|
|---|
| 10 | S ARRAY=0,IBD0=$G(^DGCR(399,+$G(IBIFN),0)) I IBD0="" G IFNQ
|
|---|
| 11 | S DFN=$P(IBD0,U,2)
|
|---|
| 12 | ;
|
|---|
| 13 | ; -- directly linked through 356.399 (not always correct)
|
|---|
| 14 | ;S IBI=0 F S IBI=$O(^IBT(356.399,"C",IBIFN,IBI)) Q:'IBI S IBX=+$G(^IBT(356.399,IBI,0)) I +IBX S ARRAY(+IBX)=""
|
|---|
| 15 | ;
|
|---|
| 16 | SCH ; -- scheduled admissions (all on event date of inpatient bills)
|
|---|
| 17 | S IBTYP=5,IBDT=$P(IBD0,U,3),IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 18 | F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 19 | . S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 20 | .. S ARRAY(IBTRN)=IBTYP,ARR2(IBBDT,IBTRN)=IBTRN
|
|---|
| 21 | ;
|
|---|
| 22 | INPT ; -- inpt admission (matches event date and episode date, does not check patient admission movement or PTF)
|
|---|
| 23 | S IBTYP=1,IBDT=$P(IBD0,U,3),IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 24 | F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 25 | . S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 26 | .. S IBBILL=$P(^IBT(356,IBTRN,0),U,11) I +IBBILL,IBBILL'=IBIFN Q
|
|---|
| 27 | .. S ARRAY(IBTRN)=IBTYP,ARR2(IBBDT,IBTRN)=IBTRN
|
|---|
| 28 | ;
|
|---|
| 29 | OPT ; -- outpatient visits (all CT visits on bills's opt visit dates)
|
|---|
| 30 | S IBTYP=2,IBDT=0 F S IBDT=$O(^DGCR(399,IBIFN,"OP",IBDT)) Q:'IBDT D
|
|---|
| 31 | . S IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 32 | . F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 33 | .. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 34 | ... S ARRAY(IBTRN)=IBTYP,ARR2(IBBDT,IBTRN)=IBTRN
|
|---|
| 35 | ;
|
|---|
| 36 | RX ; -- rx refills (matches rx's (52: (362.4,.05)=(356,.08)) for refill dates on bill)
|
|---|
| 37 | S IBTYP=4,IBI=0 F S IBI=$O(^IBA(362.4,"C",IBIFN,IBI)) Q:'IBI D
|
|---|
| 38 | . S IBRX=$G(^IBA(362.4,IBI,0)),IBDT=$P(IBRX,U,3),IBRXN=$P(IBRX,U,5)
|
|---|
| 39 | . I 'IBRXN S DIC=52,DIC(0)="BO",X=$P(IBRX,"^") D DIC^PSODI(52,.DIC,X) S IBRXN=+Y K DIC,X,Y Q:IBRXN=-1
|
|---|
| 40 | . S IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 41 | . F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 42 | .. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 43 | ... I $P($G(^IBT(356,IBTRN,0)),U,8)=IBRXN S ARRAY(IBTRN)=IBTYP,ARR2(IBBDT,IBTRN)=IBTRN
|
|---|
| 44 | ;
|
|---|
| 45 | PRO ; -- prosthetics (does not match delivery dates)
|
|---|
| 46 | S IBTYP=3,IBX="AIFN"_IBIFN,IBDT=0 F S IBDT=$O(^IBA(362.5,IBX,IBDT)) Q:'IBDT D
|
|---|
| 47 | . S IBI=0 F S IBI=$O(^IBA(362.5,IBX,IBDT,IBI)) Q:'IBI D
|
|---|
| 48 | .. S IBPR=$G(^IBA(362.5,IBI,0)),IBPRN=$P(IBPR,U,4) Q:'IBPRN
|
|---|
| 49 | .. S IBTRN=$O(^IBT(356,"APRO",IBPRN,0))
|
|---|
| 50 | .. I +IBTRN S ARRAY(IBTRN)=IBTYP,ARR2(IBDT,IBTRN)=IBTRN
|
|---|
| 51 | ;
|
|---|
| 52 | S IBI=0 F S IBI=$O(ARRAY(IBI)) Q:'IBI S ARRAY=ARRAY+1
|
|---|
| 53 | IFNQ Q
|
|---|
