IBAUTL4 ;ALB/CPM-MEANS TEST BILLING UTILITIES (CON'T.) ;10-OCT-91
 ;;2.0;INTEGRATED BILLING;**45,153,171,176,179,183,202**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
EN ; Calculate inpatient co-pay, per diem charges for a date range
 ;  Input:  DFN, IBBDT, IBEDT, IBCLDA, IBEVDA, IBY, IBAFY
 ;          IBCLCT/IBCLDAY/IBCLDOL (if IBCLDA'=0)
 F IBDATE=IBBDT:1:IBEDT S %H=IBDATE D YMD^%DTC S IBDT=X D CALC Q:IBY<1
 Q
 ;
CALC ; Find charges for one day
 N IBGMT,IBGMTR,IBGMTEFD ;GMT Status,GMT Related flag,GMT Effective Date
 S (IBEVNEW,IBEVOLD,IBGMT,IBGMTR)=0
 ; - is LTC?
 I IBDT'<$$STDATE^IBAECU1() S VAIP("D")=IBDT_.2359 D IN5^VADPT I $P($$TREATSP^IBAECU2($P($G(^DIC(45.7,+VAIP(8),0)),U,2)),"^",1)="L"!($$ASIHORG^IBAECN1(DFN,+$G(IBEVDA),IBDT)=1) D  G CALCQ
 . I '$D(IBSITE) N IBSITE,IBFAC D SITE^IBAUTL
 . D CANCVIS^IBAECU5(DFN,IBDT) ;cancel OPT charges for this date
 . Q:$$CLOCK^IBAECU(DFN,IBDT)  ; - increment clock
 I IBCLDA S IBCLCT=IBCLCT+1 I IBCLCT>365 S IBWHER=2 D PASS^IBAUTL5:IBEVDA,CLOCKCL^IBAUTL3:IBY>0 G:IBY<1 CALCQ
 ; - Means Test billable?
 I '$$BIL^DGMTUB(DFN,IBDT+.2359) G:'IBCLDA CALCQ S IBWHER=3 D PASS^IBAUTL5:IBEVDA,CLOCKCL^IBAUTL3:IBY>0 G CALCQ
 ; - GMT Status?
 S IBGMT=$$ISGMTPT^IBAGMT(DFN,IBDT+.2359)
 S IBGMTEFD=$$GMTEFD^IBAGMT() ; GMT Effective Date
 ; - on leave?
 S VAIP("D")=IBDT_.2359 D IN5^VADPT S IBBS=$$SECT^IBAUTL5(+VAIP(8)),IBSL="405:"_VAIP(1)
 I 'VAIP(10) D  G CALCQ
 . I IBBS,'IBCLDA S IBCLDT=IBDT,IBWHER=7 D CLADD^IBAUTL3 S (IBCLDAY,IBCLDOL)=0,IBCLCT=1
 . Q:'IBCLDA  S IBWHER=4 D PASS^IBAUTL5:IBEVDA,CLOCKCL^IBAUTL3:IBCLCT'<365&(IBY>0)
 ; - check billing status
 I 'IBBS S IBWHER=5 D:IBEVDA PASS^IBAUTL5,EVCLOS1^IBAUTL3:IBY>0 D  G CALCQ
 . S IBEVDA=0 Q:'IBCLDA!(IBY<1)  D:IBCLCT'<365 CLOCKCL^IBAUTL3
 S IBNH=$P($G(^DGCR(399.1,IBBS,0)),"^")["NURSING"
 I 'IBEVDA S IBEVDT=+VAIP(3)\1,IBWHER=6 D EVADD^IBAUTL3 G:IBY<1 CALCQ
 ; - will bill today--got a clock?
 I 'IBCLDA S IBCLDT=IBDT,IBWHER=7 D CLADD^IBAUTL3 G:IBY<1 CALCQ S (IBCLDAY,IBCLDOL)=0,IBCLCT=1
 ; - cancel any OPT charges
 D OPT^IBAMTD1(DFN,IBDT)
 ; - update clock, $$ if starting another 90-day period of care
 I IBCLDAY,'(IBCLDAY#90) D CLUPD^IBAUTL3 S:IBCLDAY'=360 IBCLDOL=0
 S IBCLDAY=IBCLDAY+1
 ; - process per diem
 G:IBDT<$$DIEM^IBAUTL5 COPAY ; date is prior to per diem billing date
 S IBX="P",IBWHER=8 D TYPE^IBAUTL2 G:IBY<1 CALCQ
 S IBGMTR=0 I IBGMT>0,IBDT'<IBGMTEFD,$$ISGMTTYP^IBAGMT(IBATYP) S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) ;GMT Charge Adjustment
 D CHFIND^IBAUTL2 S IBNOS=IBCHPDA,IBCHPDE=$P($G(^IB(+IBCHPDA,0)),"^",8),IBWHER=9
 ; - update or pass to A/R an incomplete per diem charge
 I IBCHPDA D  G:IBY<1 CALCQ
 . I (IBCHPDE["INPT"&(IBNH))!(IBCHPDE["NHC"&('IBNH)) D  Q
 ..  D FILER^IBAUTL5,EVCLOS1^IBAUTL3:IBY>0 Q:IBY<1
 ..  S IBEVDT=+VAIP(3)\1,IBEVOLD=IBEVDA,IBWHER=10
 ..  D EVADD^IBAUTL3 Q:IBY<1  S IBCHPDA=0,IBEVNEW=IBEVDA
 . S X1=IBDT,X2=IBCHTO D ^%DTC I X'=1 S IBWHER=11 D FILER^IBAUTL5 S IBCHPDA=0 Q
 . ; Split pre- and post- GMT Eff.Date charges, for GMT patients only
 . I IBGMT'=0,IBDT'<IBGMTEFD,$$ISGMTTYP^IBAGMT(IBATYP),IBCHTO<IBGMTEFD S IBWHER=11 D FILER^IBAUTL5 S IBCHPDA=0 Q
 . ; Split charges, if the patient just received or lost GMT Status
 . I (+$P($G(^IB(+IBCHPDA,0)),"^",21))'=IBGMTR S IBWHER=11 D FILER^IBAUTL5 S IBCHPDA=0 Q
 . S IBN=IBCHPDA D CHUPD^IBAUTL2
 I 'IBCHPDA S IBWHER=13 D CHADD^IBAUTL2 G:IBY<0 CALCQ S IBCHPDA=IBN
COPAY ; - process co-payment
 G:IBCLDAY>360!($$CONT^IBAUTL5(DFN)>IBDT) LAST ; last 5 days are grace days, or pt is continuous
 S IBMAX=IBMED
 I IBGMT>0,IBDT'<IBGMTEFD S IBMAX=$$REDUCE^IBAGMT(IBMAX) ;Adjust deductible for GMT patients
 I IBCLDAY>90,'IBNH S IBMAX=IBMAX/2
 G:IBCLDOL'<IBMAX LAST
 S IBWHER=14 D COPAY^IBAUTL2 G:IBY<1 CALCQ
 S IBGMTR=0 I IBGMT>0,IBDT'<IBGMTEFD S IBGMTR=1,IBCHG=$$REDUCE^IBAGMT(IBCHG) ;GMT Charge Adjustment
 S IBCHARG=IBMAX-IBCLDOL I IBCHG<IBCHARG S IBCHARG=IBCHG
 S IBCHG=IBCHARG S:IBCHG<0 IBCHG=0
 S IBCLDOL=IBCLDOL+IBCHG
 S:IBEVOLD IBEVDA=IBEVOLD S IBX="C" D CHFIND^IBAUTL2
 S IBNOS=IBCHCDA,IBCHCTY=$P($G(^IB(+IBCHCDA,0)),"^",3) S:IBEVNEW IBEVDA=IBEVNEW
 ; - update or pass to A/R an incomplete copay charge
 I IBCHCDA D  G:IBY<1 CALCQ
 . I IBCHCTY'=IBATYP S IBWHER=15 D FILER^IBAUTL5 S IBCHCDA=0 Q
 . S X1=IBDT,X2=IBCHTO D ^%DTC I X'=1 S IBWHER=16 D FILER^IBAUTL5 S IBCHCDA=0 Q
 . ; Split pre- and post- GMT Eff.Date charges
 . I IBGMT'=0,IBDT'<IBGMTEFD,IBCHTO<IBGMTEFD S IBWHER=16 D FILER^IBAUTL5 S IBCHPDA=0 Q
 . S IBN=IBCHCDA D CHUPD^IBAUTL2
 I 'IBCHCDA S IBWHER=18 D CHADD^IBAUTL2 G:IBY<1 CALCQ S IBCHCDA=IBN
 I IBCHCDA,IBCLDOL'<IBMAX S IBEVOLD=0,IBNOS=IBCHCDA,IBWHER=19 D FILER^IBAUTL5 G:IBY<1 CALCQ S IBCHCDA=0
LAST ; - handle last day of billing clock
 G:IBCLCT<365 CALCQ
 I $G(IBCHPDA) S IBNOS=IBCHPDA,IBWHER=20 D FILER^IBAUTL5 G:IBY<1 CALCQ S IBCHPDA=0
 I $G(IBCHCDA) S IBNOS=IBCHCDA,IBWHER=21 D FILER^IBAUTL5 G:IBY<1 CALCQ S IBCHCDA=0
 D CLOCKCL^IBAUTL3
CALCQ I $G(IBJOB)=2,'$G(DGQUIET) W "."
 Q