| 1 | IBCD5 ;ALB/ARH - AUTOMATED BILLER (INPT DT RANGE) ;8/6/93
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**14,31,106,51,137**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; DBIA REFERENCE TO ^DGPM("ATID1") = DBIA419
|
|---|
| 5 | ;
|
|---|
| 6 | ;continuation of IBCD1
|
|---|
| 7 | INP ;Inpatient Admissions (IBTRN,IBTYP,IBDFN,IBEVDT)
|
|---|
| 8 | ;get statement from and to dates based on previous non-final bills or event date and billing cycle, check that range is within admit-discharge, not previously billed, and BC + DD is not greater than current date, PTF status
|
|---|
| 9 | ;^TMP("IBC1",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
|
|---|
| 10 | ;
|
|---|
| 11 | S IBX=$P($G(^IBT(356,IBTRN,0)),U,5),IBAD=$$AD^IBCU64(IBX),IBDIS=+$P(IBAD,U,2)\1 I 'IBAD!('$P(IBAD,U,4)) D G INPQ
|
|---|
| 12 | . I 'IBAD D TERR(IBTRN,0,"Patient Admission Movement Data not found.")
|
|---|
| 13 | . D TERR(IBTRN,0,"Admission movement missing PTF number.")
|
|---|
| 14 | ;
|
|---|
| 15 | S IBX=$G(^DGPT(+$P(IBAD,U,4),0)) I 'IBX D TERR(IBTRN,0,"PTF record for Admission movement was not found.") G INPQ
|
|---|
| 16 | I '$P(IBX,U,6)!(+$P(IBPAR7,U,3)>+$P(IBX,U,6)) G INPQ ; check PTF status, PTF record must be at least closed or status entered by site before and auto bill can be created
|
|---|
| 17 | ;
|
|---|
| 18 | ; find latest bill dates for record, if a final bill or a non reimb. ins bill exit
|
|---|
| 19 | S IBLBDT=$$BILLED^IBCU3($P(IBAD,U,4)) I +IBLBDT,('$P(IBLBDT,U,2)!($P(IBLBDT,U,3)'=8)) D G INPQ
|
|---|
| 20 | . S IBX=$P($G(^DGCR(399,+IBLBDT,0)),U,1)
|
|---|
| 21 | . I '$P(IBLBDT,U,2) D TBILL(IBTRN,+IBLBDT),TERR(IBTRN,0,"Event already has a final bill ("_IBX_").")
|
|---|
| 22 | . I $P(IBLBDT,U,3)'=8 S IBX=$P($G(^DGCR(399.3,+$P(IBLBDT,U,3),0)),U,1) D TERR(IBTRN,0,"May not be Reimbursable Ins.: A "_IBX_" bill already exists for this event.")
|
|---|
| 23 | ;
|
|---|
| 24 | ; begin calculation of bill dates, begin date based on end of last bill, otherwise event date (admission dt)
|
|---|
| 25 | S IBSTDT=$P(IBLBDT,U,2)\1,IBTF=3 I +IBSTDT S IBSTDT=$$FMADD^XLFDT(+IBSTDT,1)
|
|---|
| 26 | I 'IBSTDT S IBSTDT=IBEVDT\1,IBTF=2
|
|---|
| 27 | S $P(IBSTDT,U,2)=$$BCDT^IBCU8(+IBSTDT,IBTYP) ; end date based on pre^defined length of bill cycle
|
|---|
| 28 | ;
|
|---|
| 29 | ; force date range to within admit-discharge dates
|
|---|
| 30 | S:+IBSTDT<+IBAD $P(IBSTDT,U,1)=+IBAD\1 I +IBDIS,$P(IBSTDT,U,2)>+IBDIS S $P(IBSTDT,U,2)=+IBDIS
|
|---|
| 31 | I $P(IBSTDT,U,2)=IBDIS S IBTF=4 I +IBSTDT=(+IBAD\1) S IBTF=1
|
|---|
| 32 | ;
|
|---|
| 33 | I IBTF=4,+IBSTDT=+$P(IBSTDT,U,2) D TEABD(IBTRN,0),TERR(IBTRN,0,"Interim - Last bill not created: Only day not already billed is the discharge date, which is not billable.") G INPQ
|
|---|
| 34 | ;
|
|---|
| 35 | S IBX=$$DUPCHKI^IBCU64(+IBSTDT,$P(IBSTDT,U,2),$P(IBAD,U,4),0,0) I +IBX D TEABD(IBTRN,0),TERR(IBTRN,0,$P(IBX,U,2)) G INPQ
|
|---|
| 36 | S IBX=$$EABD^IBCU81(IBTYP,$P(IBSTDT,U,2)) I +IBX>DT D TEABD(IBTRN,+IBX) G INPQ
|
|---|
| 37 | S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=IBTF
|
|---|
| 38 | INPQ K IBSTDT,IBAD,IBLBDT,IBDIS,IBX,IBTF
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | INPT ;
|
|---|
| 42 | N PTF,IBDTS
|
|---|
| 43 | S IBADMT=$P(IBTRND,U,5),IBAD=$$AD^IBCU64(IBADMT),IB(.03)=+IBAD,IB(.05)=1
|
|---|
| 44 | ;check ptf movements for service connected care, see enddis^ibca0
|
|---|
| 45 | S IB(.08)=$P(IBAD,U,4),PTF=IB(.08)
|
|---|
| 46 | ;S IB(.04)=1,IBX=$P($G(^DIC(45.7,+$P(IBAD,U,5),0)),U,2) I $P($G(^DIC(42.4,+IBX,0)),U,3)="NH" S IB(.04)=2 ; treating specialty NHCU
|
|---|
| 47 | S IB(.04)=1 N VAIN,VAINDT,VAERR S VAINDT=+IBAD D INP^VADPT I +VAIN(3),$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+VAIN(3),0)),U,2),0)),U,3)="NH" S IB(.04)=2 ; treating specialty NHCU
|
|---|
| 48 | ; Attending physician
|
|---|
| 49 | I $G(VAIN(11)) S IB("PRV",.02)=+VAIN(11)_";VA(200,",IB("PRV",.01)=4
|
|---|
| 50 | S IBDISDT=$P(IBAD,U,2) ; discharge date
|
|---|
| 51 | S IB(151)=+IBSTDT,IB(152)=$P(IBSTDT,U,2)
|
|---|
| 52 | S IBIDS(.08)=IB(.08) D SPEC^IBCU4 S IB(161)=$G(IBIDS(161)) K IBIDS ; discharge bedsection
|
|---|
| 53 | I +IBDISDT,'IB(161) D TERR(IBTRN,IBIFN,"Non-Billable Discharge Bedsection.")
|
|---|
| 54 | S IB(165)=$$LOS^IBCU64(IB(151),IB(152),IB(.06),IBADMT) I IB(165)'>0 D TERR(IBTRN,IBIFN,"No billable Days.")
|
|---|
| 55 | ;
|
|---|
| 56 | S DFN=IBDFN,IB(217)=$$NONCOV^IBCU64(IB(151),IB(152),IBADMT,.IBDTS),IB(216)=+IB(165)
|
|---|
| 57 | I IB(217) D ;Stuff occurrence span codes (74) for dates of leave/pass
|
|---|
| 58 | . N IBOC,IBC,IBD,IBX
|
|---|
| 59 | . S (IBOC,IBC)=0
|
|---|
| 60 | . F S IBOC=$O(^DGCR(399.1,"C1",74,IBOC)) Q:'IBOC I $P($G(^DGCR(399.1,IBOC,0)),U,10) S IB("OC")=IBOC Q ;Get ien for occ span code 74
|
|---|
| 61 | . Q:'IBOC
|
|---|
| 62 | . S IBX=0 F S IBX=$O(IBDTS(IBX)) Q:'IBX S IBD=$G(IBDTS(IBX)) I $P(IBD,U,3)>0 D
|
|---|
| 63 | .. S IBC=IBC+1,IB("OC",IBC,.02)=$P(IBD,U),IB("OC",IBC,.04)=$P(IBD,U,2)
|
|---|
| 64 | S IB(.09)=9 D IDX^IBCD4(+IB(.08),+IB(151),+IB(152)) I $D(IBMSG)>2 D
|
|---|
| 65 | . S IBX=0 F S IBX=$O(IBMSG(IBX)) Q:'IBX D TERR(IBTRN,IBIFN,IBMSG(IBX))
|
|---|
| 66 | I +$$BILLRATE^IBCRU3(+$G(IB(.07)),IB(.05),IB(.03),"RC") S IB(.27)=1 ; reasonable charges institutional bill
|
|---|
| 67 | ; Calculate coinsurance days if MEDICARE
|
|---|
| 68 | I $$MCRPT^IBCEU2(IBIFN,IBADMT) D ; GET # MCR CO-INSURANCE DAYS
|
|---|
| 69 | . N IBI,IBTOT,DGPMCA,IBPTF,IBD1,IBD2,IBTYPA,IBTYP
|
|---|
| 70 | .; SNF coinsurance is from days 21-100, non SNF is 61-90 per benefit pd
|
|---|
| 71 | .; Benefit period starts on admission to a hospital or SNF and ends
|
|---|
| 72 | .; when 60 consecutive days have elapsed as an outpatient
|
|---|
| 73 | .; COUNT THE # OF DAYS IN ALL THE ADMISSIONS FROM THIS DISCHARGE OR
|
|---|
| 74 | .; (if none) FROM 60 DAYS AGO THRU THE ADMISSION DATE BEING BILLED
|
|---|
| 75 | . S IBTYPA=$S(IB(.04)'=2:"HOS",1:"SNF")
|
|---|
| 76 | . S IBTOT=IB(165)
|
|---|
| 77 | . S IBI=$$INV(IBADMT),IBD1=IBADMT\1
|
|---|
| 78 | . F S IBI=$O(^DGPM("ATID1",IBDFN,IBI)) Q:'IBI!(IBTOT>$S(IBTYPA="HOS":90,1:100)) S DGPMCA=0 F S DGPMCA=$O(^DGPM("ATID1",IBDFN,IBI,DGPMCA)) Q:'DGPMCA D
|
|---|
| 79 | .. S IBPTF=+$P($G(^DGPM(DGPMCA,0)),U,16),IBD2=$G(^DGPT(IBPTF,70))\1
|
|---|
| 80 | .. Q:'IBD2
|
|---|
| 81 | .. I $$FMDIFF^XLFDT(IBD2,IBD1,1)>60 Q ; at least 60 days out of hosp
|
|---|
| 82 | .. S IBTYP=$S($P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(^DGPM(DGPMCA,0),U,9),0)),U,2),0)),U,3)'="NH":"HOS",1:"SNF")
|
|---|
| 83 | .. I IBTYP=IBTYPA S IBTOT=IBTOT+$$LOS^IBCU64(IBPTF,$$INV(IBI),IBD2,"",DGPMCA) ;Only tally the same type of care (HOS/SNF) for the benefit pd
|
|---|
| 84 | .. S IBD1=$$INV(IBI)\1
|
|---|
| 85 | .; IF TOTAL # OF PREVIOUS DAYS + TOTAL # DAYS IN THIS ADMISSION
|
|---|
| 86 | .; EXCEEDS MCR LIMITS, WE HAVE CO-INSURANCE DAYS
|
|---|
| 87 | .; CALCULATE THE DAYS BY SUBTRACTING 60/20 FROM THE TOTAL # OF DAYS OR
|
|---|
| 88 | .; 90/100, WHICHEVER IS LESS, STORE THIS # IN FIELD #221
|
|---|
| 89 | . I IBTYPA="HOS" S:IBTOT>60 IB(221)=$S(IBTOT<90:IBTOT-60,1:30)
|
|---|
| 90 | . I IBTYPA="SNF" S:IBTOT>20 IB(221)=$S(IBTOT<100:IBTOT-20,1:80)
|
|---|
| 91 | INPTE K IBADMT,IBADMTD,IBDISDT,IBLBDT,IBSCM,IBM,IBAD,IBX
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
|
|---|
| 95 | S IBDT=+$G(IBDT),^TMP("IBEABD",$J,TRN,+IBDT)=""
|
|---|
| 96 | Q
|
|---|
| 97 | TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
|
|---|
| 98 | N X S TRN=+$G(TRN),IFN=+$G(IFN),X=+$G(^TMP("IBCE",$J,DT,TRN,IFN))+1
|
|---|
| 99 | S ^TMP("IBCE",$J,DT,TRN,IFN,X)=$G(ER),^TMP("IBCE",$J,DT,TRN,IFN)=X
|
|---|
| 100 | Q
|
|---|
| 101 | TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
|
|---|
| 102 | I '$D(^IBT(356,+$G(TRN),0))!('$D(^DGCR(399,+$G(IFN),0))) Q
|
|---|
| 103 | S ^TMP("IBILL",$J,TRN,IFN)=""
|
|---|
| 104 | Q
|
|---|
| 105 | INV(X) ; Returns inverted date in X
|
|---|
| 106 | Q (9999999.9999999-X)
|
|---|
| 107 | ;
|
|---|
