| 1 | IBAECI ;ALB/BGA-LONG TERM CARE INPATIENT TRACKER ; 09-OCT-01
 | 
|---|
| 2 |  ;;2.0;INTEGRATED BILLING;**164,171,176,198,188**;21-MAR-94
 | 
|---|
| 3 |  ;; Per VHA Directive 10-93-142, this routine should not be modified
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ; This routine is called from ^IBAMTD and tracks all patient movements
 | 
|---|
| 6 |  ; that are related to Long Term Care (LTC). If the Episode of care is
 | 
|---|
| 7 |  ; related to LTC the episode of care is stored in ^IBA(351.8 and will
 | 
|---|
| 8 |  ; be further screen when the Monthly Job is run and than Priced.
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 | EN ;  Main Entry Point
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  ; === When IBALTC=0 episode not LTC billable so passed to MTC Module
 | 
|---|
| 14 |  ;     IBALTC=1 episode is LTC Billable do NOT passed to MTC Module
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  S IBALTC=0
 | 
|---|
| 17 |  I $G(DGPMA)="",$G(DGPMP)="" Q
 | 
|---|
| 18 |  I DT<$$STDATE^IBAECU1() Q  ;quit if today<effective date
 | 
|---|
| 19 |  N IBCL,IBDT,IBDTA,IBLTCST,IBT,IBTS,IBX,IBY,IBZ,IBM,IBV,IBE
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  S IBV=$S($L($G(DGPMP)):"DGPMP",1:"DGPMA") D:+$G(@IBV)>0
 | 
|---|
| 22 |  . N IBDT S IBDT=+$G(@IBV)\1
 | 
|---|
| 23 |  . N VAIP S VAIP("D")=IBDT_.2359 D IN5^VADPT I $P($$TREATSP^IBAECU2($P($G(^DIC(45.7,+VAIP(8),0)),U,2)),"^",1)="L" D BACKBIL Q
 | 
|---|
| 24 |  . I +$G(VAIP(1))>0 S VAIP(1)=$$ORIGADM^IBAECN1(VAIP(1)) I $$ISLTC4DT^IBAECN1(DFN,+$G(VAIP(1)),IBDT_.2359)=1 D BACKBIL
 | 
|---|
| 25 |  ; is this related to LTC
 | 
|---|
| 26 |  S IBX=0 F  S IBX=$O(^UTILITY("DGPM",$J,6,IBX)) Q:IBX<1  F IBY="A","P" S IBTS=$P($G(^UTILITY("DGPM",$J,6,IBX,IBY)),"^",9) I IBTS,$$LTCSPEC^IBAECU(+$$FACSPEC^IBAECU(IBTS)) S IBALTC=1
 | 
|---|
| 27 |  I IBALTC=0 I $D(^UTILITY("DGPM",$J,3)) D
 | 
|---|
| 28 |  . N VAIN,VAINDT S VAINDT=+$G(@IBV)\1 D INP^VADPT I $P($$TREATSP^IBAECU2($P($G(^DIC(45.7,+VAIN(3),0)),U,2)),"^",1)="L" S IBALTC=1
 | 
|---|
| 29 |  I 'IBALTC Q
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  ; get the earliest date of care for this movement
 | 
|---|
| 32 |  S IBDT=+DGPMA
 | 
|---|
| 33 |  I DGPMP,(DGPMP<DGPMA!('IBDT)) S IBDT=+DGPMP S IBT=0 F  S IBT=$O(^UTILITY($J,IBT)) Q:IBT<1  S IBX=DGPMDA-1 F  S IBX=$O(^UTILITY($J,IBT,IBX)) Q:IBX<1  F IBZ="A","P" S IBDTA=+$G(^UTILITY($J,IBT,IBX,IBZ)) I IBDTA<IBDT S IBDT=IBDTA
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  ; look up this patient's LTC status
 | 
|---|
| 36 |  S IBLTCST=+$$LTCST^IBAECU(DFN,IBDT\1,1)
 | 
|---|
| 37 |  ;
 | 
|---|
| 38 |  ; are they exempt from LTC care?
 | 
|---|
| 39 |  I IBLTCST=1 S IBALTC=1 Q
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  ; no 1010EC send message and quit
 | 
|---|
| 42 |  I IBLTCST=0 D  D XMNOEC^IBAECU(DFN,IBDT,.IBE) Q
 | 
|---|
| 43 |  . S IBV=$S($L($G(DGPMP)):"DGPMP",1:"DGPMA")
 | 
|---|
| 44 |  . S IBE(1)="",IBE(2)="  Event Type:  Inpatient Movement "_$S(IBV="DGPMP"&($G(DGPMA)):"Edited",IBV="DGPMP":"Deleted",1:"Added")
 | 
|---|
| 45 |  . S IBE(3)="",IBE(4)="Event Action:  "_$S($P(@IBV,"^",2)=1:"Admission",$P(@IBV,"^",2)=2:"Transfer",$P(@IBV,"^",2)=3:"Discharge",$P(@IBV,"^",2)=6:"Specialty Change",1:"")
 | 
|---|
| 46 |  . S IBE(5)="",IBE(6)="    Location:  " D
 | 
|---|
| 47 |  . . I $P(@IBV,"^",6) S IBE(6)=IBE(6)_$P($G(^DIC(42,+$P(@IBV,"^",6),0)),"^") Q
 | 
|---|
| 48 |  . . I $P(@IBV,"^",14),$P($G(^UTILITY("DGPM",$J,1,$P(@IBV,"^",14),"A")),"^",6) S IBE(6)=IBE(6)_$P($G(^DIC(42,+$P(^("A"),"^",6),0)),"^") Q
 | 
|---|
| 49 |  . . I $P(@IBV,"^",14),$P($G(^UTILITY("DGPM",$J,1,$P(@IBV,"^",14),"P")),"^",6) S IBE(6)=IBE(6)_$P($G(^DIC(42,+$P(^("P"),"^",6),0)),"^")
 | 
|---|
| 50 |  . . I $P(@IBV,"^",14),$P($G(^DGPM(+$P(@IBV,"^",14),0)),"^",6) S IBE(6)=IBE(6)_$P($G(^DIC(42,+$P(^(0),"^",6),0)),"^") Q
 | 
|---|
| 51 |  . . S IBE(6)=IBE(6)_"Unknown"
 | 
|---|
| 52 |  ;
 | 
|---|
| 53 |  D BACKBIL
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 |  ; flag LTC for current events
 | 
|---|
| 56 |  S IBCL=$$CLOCK^IBAECU(DFN,$S(IBDT<$$STDATE^IBAECU1:$$STDATE^IBAECU1,1:IBDT\1))
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 |  Q
 | 
|---|
| 59 |  ;
 | 
|---|
| 60 | BACKBIL ;called from EN
 | 
|---|
| 61 |  ; back billing issue? send message and quit
 | 
|---|
| 62 |  S IBV=$S($L($G(DGPMP)):"DGPMP",1:"DGPMA")
 | 
|---|
| 63 |  I $$LASTMJ^IBAECU()>0,$E(IBDT,1,5)<$E($$LASTMJ^IBAECU(),1,5) D  D XMBACK^IBAECU(DFN,.IBM) Q
 | 
|---|
| 64 |  . S IBM(1)="A(n) Added." I $D(IBV),$D(@IBV) D
 | 
|---|
| 65 |  . . S IBM(1)="A(n) "_$S($P(@IBV,"^",2)=1:"Admission",$P(@IBV,"^",2)=2:"Transfer",$P(@IBV,"^",2)=3:"Discharge",$P(@IBV,"^",2)=6:"Specialty Change",1:"")_" was "_$S(IBV="DGPMP"&($G(DGPMA)):"Edited",IBV="DGPMP":"Deleted",1:"Added")_"."
 | 
|---|
| 66 |  . S IBM(2)=" ",IBM(3)="This may result in a Back Billing issue for LTC.  You should review the"
 | 
|---|
| 67 |  . S IBM(4)="patient's records for "_$$FMTE^XLFDT(IBDT)_" to ensure correct billing."
 | 
|---|
| 68 |  . S IBM(5)="LTC Billing Clock and LTC charges may have to be manually adjusted."
 | 
|---|
| 69 |  Q
 | 
|---|
| 70 |  ;
 | 
|---|
| 71 | CALC ; tag for completion of manual adding of inpt charges
 | 
|---|
| 72 |  ; requires DFN, IBCHG, IBEVDA, IBTO
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 |  N IBT,IBTYP,IBLOS,IBZ
 | 
|---|
| 75 |  ;
 | 
|---|
| 76 |  ; get the LOS
 | 
|---|
| 77 |  S IBZ=^IB(+IBEVDA,0),IBLOS=$$LOS^IBCU64($S($$BILDATE^IBAECN1>$P(IBZ,"^",17):$$BILDATE^IBAECN1,1:$P(IBZ,"^",17)),$$LASTDT^IBAECU(IBTO),2,$P($P(IBZ,"^",4),":",2))
 | 
|---|
| 78 |  ;
 | 
|---|
| 79 |  ; update the status
 | 
|---|
| 80 |  S IBLTCST=$$LTCST^IBAECU(DFN,IBTO,IBLOS) I IBLTCST<2 W !!,"  This patient is not LTC billable on the date." S IBY=-1 Q
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 |  ; find the total amount already billed for mo
 | 
|---|
| 83 |  D TOT^IBAECU
 | 
|---|
| 84 |  ;
 | 
|---|
| 85 |  W !!,"  Calculated Monthly Copay Cap Type to be used: INPATIENT ",$S(IBLOS<181:"< 181",1:"> 180")," days."
 | 
|---|
| 86 |  W !,"               Calculated Monthly Copay Cap is: $ ",$FN($P(IBLTCST,"^",$S(IBLOS<181:3,1:4)),",",2)
 | 
|---|
| 87 |  W !,"                       Total previously billed: $ ",$FN(IBT,",",2)
 | 
|---|
| 88 |  ;
 | 
|---|
| 89 |  I IBCHG+IBT>$P(IBLTCST,"^",$S(IBLOS<181:3,1:4)) S IBCHG=$P(IBLTCST,"^",$S(IBLOS<181:3,1:4))-IBT
 | 
|---|
| 90 |  ;
 | 
|---|
| 91 |  ; check for negative $ amount cap
 | 
|---|
| 92 |  I $P(IBLTCST,"^",$S(IBLOS<181:3,1:4))<0 S IBCHG=0
 | 
|---|
| 93 |  ;
 | 
|---|
| 94 |  Q
 | 
|---|