| 1 | IBJTU5 ;ALB/ARH - TPI UTILITIES - BILLS/CLAIMS TRACKING ; 2/14/95
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | IFNTRN(IBIFN,ARRAY,ARR2) ; find CT records for events on a bill: inpt adm, outpt vsts, rx refills, prosthetics
|
|---|
| 6 | ; sets ARRAY=COUNT, ARRAY(IBTRN)="", if bill passed in defined
|
|---|
| 7 | ; ARR2(DATE_TRN)=TRN
|
|---|
| 8 | ;
|
|---|
| 9 | N IBI,IBX,IBY,IBD0,DFN,IBTYP,IBTRN,IBDT,IBBDT,IBEDT,IBRX,IBRXN,IBPR,IBPRN,IBPM,IBPTF 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 | ; -- scheduled admissions (all on event date of inpatient bills)
|
|---|
| 17 | S IBTYP=5 I $P(IBD0,U,5)<3 D
|
|---|
| 18 | . S IBDT=$P(IBD0,U,3),IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 19 | . F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 20 | .. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 21 | ... S ARRAY(IBTRN)="",IBY=IBBDT_"_"_IBTRN,ARR2(IBY)=IBTRN
|
|---|
| 22 | ;
|
|---|
| 23 | ; -- inpt admission (CT records on bill event date whose PM matches the bills PTF)
|
|---|
| 24 | S IBTYP=1 S IBPTF=+$P(IBD0,U,8) I +IBPTF D
|
|---|
| 25 | . S IBDT=$P(IBD0,U,3),IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 26 | . F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 27 | .. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 28 | ... S IBPM=+$P($G(^IBT(356,IBTRN,0)),U,5) I +IBPM,$D(^DGPM("APTF",IBPTF,IBPM)) D
|
|---|
| 29 | .... S ARRAY(IBTRN)="",IBY=IBBDT_"_"_IBTRN,ARR2(IBY)=IBTRN
|
|---|
| 30 | ;
|
|---|
| 31 | ; -- outpatient visits (all CT visits on bills's opt visit dates)
|
|---|
| 32 | S IBTYP=2,IBDT=0 F S IBDT=$O(^DGCR(399,IBIFN,"OP",IBDT)) Q:'IBDT D
|
|---|
| 33 | . S IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 34 | . F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 35 | .. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 36 | ... S ARRAY(IBTRN)="",IBY=IBBDT_"_"_IBTRN,ARR2(IBY)=IBTRN
|
|---|
| 37 | ;
|
|---|
| 38 | ; -- rx refills (matches rx's (52: (362.4,.05)=(356,.08)) for refill dates on bill)
|
|---|
| 39 | S IBTYP=4,IBI=0 F S IBI=$O(^IBA(362.4,"C",IBIFN,IBI)) Q:'IBI D
|
|---|
| 40 | . S IBRX=$G(^IBA(362.4,IBI,0)),IBDT=$P(IBRX,U,3),IBRXN=$P(IBRX,U,5) Q:'IBRXN
|
|---|
| 41 | . S IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 42 | . F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 43 | .. S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 44 | ... I $P($G(^IBT(356,IBTRN,0)),U,8)=IBRXN S ARRAY(IBTRN)="",IBY=IBBDT_"_"_IBTRN,ARR2(IBY)=IBTRN
|
|---|
| 45 | ;
|
|---|
| 46 | ; -- prosthetics (matches pd's (660: (362.5,.04)=(356,.09)) for delivery dates on bill)
|
|---|
| 47 | S IBTYP=3,IBX="AIFN"_IBIFN,IBDT=0 F S IBDT=$O(^IBA(362.5,IBX,IBDT)) Q:'IBDT D
|
|---|
| 48 | . S IBI=0 F S IBI=$O(^IBA(362.5,IBX,IBDT,IBI)) Q:'IBI D
|
|---|
| 49 | .. S IBPR=$G(^IBA(362.5,IBI,0)),IBPRN=$P(IBPR,U,4) Q:'IBPRN
|
|---|
| 50 | .. S IBBDT=$E(IBDT,1,7)-.00001,IBEDT=$E(IBDT,1,7)+.7
|
|---|
| 51 | .. F S IBBDT=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT)) Q:'IBBDT!(IBBDT>IBEDT) D
|
|---|
| 52 | ... S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTY",DFN,IBTYP,IBBDT,IBTRN)) Q:'IBTRN D
|
|---|
| 53 | .... I $P($G(^IBT(356,IBTRN,0)),U,9)=IBPRN S ARRAY(IBTRN)="",IBY=IBBDT_"_"_IBTRN,ARR2(IBY)=IBTRN
|
|---|
| 54 | ;
|
|---|
| 55 | S IBI=0 F S IBI=$O(ARRAY(IBI)) Q:'IBI S ARRAY=ARRAY+1
|
|---|
| 56 | IFNQ Q
|
|---|
