IBAECO ;ALB/BGA - LONG TERM CARE OUTPATIENT TRACKER ;16-OCT-01
;;2.0;INTEGRATED BILLING;**164,171,176,188,312,454**;21-MAR-94;Build 4
;;Per VHA DIRECTIVE 10-93-142, this routine should not be modified.
;
; Comment- This routine is invoked via the appointment driver ^IBAMTS
; This program checks for check outs and determines if
; the person checking out is ELIGIBLE for Long Term Care
; and determines if the encounter was related to LTC.
; If the episode of care is related to LTC and the patient
; is eligible to receive care and is compliant with all
; the LTC business rules than the entry is added to
; the LTC transaction file #351.8.
;
; Determine if this encounter has a status of checked out
EN N IBEVT,IBEV0,DFN,IBSDHDL,IBORG,IBOE,IBLTCST,IBCL,IBDT,IBST,IBM
N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
S IBSDHDL=0
;
; === ON/OFF Switch by date if before 11/15/06 software will not run
; === IBALTC=0 the Encounter is not LTC Billable pass to MT Module
; === IBALTC=1 Encounter is LTC Billable do NOT Pass to MTC
;
S IBALTC=0
;I DT<$$STDATE^IBAECU1() Q ;quit if today<effective date
F S IBSDHDL=$O(^TMP("SDEVT",$J,IBSDHDL)) Q:'IBSDHDL D
. S IBORG=0 F S IBORG=$O(^TMP("SDEVT",$J,IBSDHDL,IBORG)) Q:'IBORG D
. . S IBOE=0 F S IBOE=$O(^TMP("SDEVT",$J,IBSDHDL,IBORG,"SDOE",IBOE)) Q:'IBOE S IBEVT=$G(^(IBOE,0,"AFTER")),IBEV0=$G(^("BEFORE")) D
. . . ;
. . . Q:$P(IBEVT,U,6) ; do not evaluate sibling encounters
. . . Q:$P(IBEVT,U,12)=8 ; do not evaluate inpatient encounters
. . . ;
. . . ; set variables
. . . S DFN=$P(IBEVT,U,2),IBDT=$S(+IBEVT:+IBEVT,1:+IBEV0),IBST=$P(IBEVT,U,3)
. . . Q:IBDT<$$STDATE^IBAECU1
. . . Q:'DFN!('IBDT)
. . . ;
. . . ; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date ;CCR-930
. . . I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
. . . ;
. . . ; stop code preset and LTC event?
. . . I 'IBST Q
. . . I '$$LTCSTOP^IBAECU(IBST) Q
. . . ;
. . . ; set flag to stop MT billing
. . . S IBALTC=1
. . . ;
. . . ; LTC patient check
. . . S IBLTCST=+$$LTCST^IBAECU(DFN,IBDT\1,1)
. . . ;
. . . ; are they exempt from non-institutional LTC because of CD status?
. . . I $$CDEXMPT^IBAECU(DFN,IBDT\1) Q
. . . ;
. . . ; no 1010EC on file
. . . I IBLTCST=0 D D XMNOEC^IBAECU(DFN,.IBDT,.IBM) Q
. . . . S IBM(1)="",IBM(2)=" Event Type: Outpatient Encounter"
. . . . S IBM(3)="",IBM(4)="Event Action: "_$S($P(IBEV0,"^",12)'=2&($P(IBEVT,"^",12)=2):"Checked Out",IBEVT&(IBEV0):"Edited",IBEV0:"Deleted",1:"Added")
. . . . S IBM(5)="",IBM(6)=" Location: "_$S($P(IBEVT,"^",4):$P($G(^SC(+$P(IBEVT,"^",4),0)),"^"),$P(IBEVO,"^",4):$P($G(^SC(+$P(IBEVO,"^",4),0)),"^"),1:"")
. . . ;
. . . ; is this a back billing issue, if so, send message and quit
. . . I $$LASTMJ^IBAECU()>0,$$LASTMJ^IBAECU()>IBDT D D XMBACK^IBAECU(DFN,.IBM) Q
. . . . S IBM(1)="An Outpatient Encounter was "_$S(IBEVT&(IBEV0):"Edited",IBEV0:"Deleted",1:"Added")_"."
. . . . S IBM(2)="This may result in a Back Billing issue for LTC. You should review the"
. . . . S IBM(3)="patient's records for "_$$FMTE^XLFDT(IBDT)_" to ensure correct billing."
. . . . S IBM(4)="LTC Billing Clock and LTC charges may have to be manually adjusted."
. . . ;
. . . ; add LTC clock/update last event date (if not LTC exempt)
. . . I IBLTCST=2 S IBCL=$$CLOCK^IBAECU(DFN,IBDT\1)
. . . ;
;
Q
;
CALC ; used to calculate the outpatient charge
; variables needed DFN, IBLTCST, IBCHG, IBFR
; this will adjust IBCHG so the patient is not above their calculated
; copay cap for the month.
N IBTYP,IBT
;
; find all LTC charges and set flag to determine inpt or opt
; cap to be used.
D TOT^IBAECU
;
W !!," Calculated Monthly Copay Cap Type to be used: ",$S(IBTYP="I":"IN",1:"OUT"),"PATIENT"
W !," Calculated Monthly Copay Cap is: $ ",$FN($P(IBLTCST,"^",$S(IBTYP="I":3,1:5)),",",2)
W !," Total previously billed: $ ",$FN(IBT,",",2)
;
I IBCHG+IBT>$P(IBLTCST,"^",$S(IBTYP="I":3,1:5)) S IBCHG=$P(IBLTCST,"^",$S(IBTYP="I":3,1:5))-IBT
;
; check for negative $ amount cap
I $P(IBLTCST,"^",$S(IBTYP="I":3,1:5))<0 S IBCHG=0
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAECO 4305 printed Sep 23, 2025@19:42:17 Page 2
IBAECO ;ALB/BGA - LONG TERM CARE OUTPATIENT TRACKER ;16-OCT-01
+1 ;;2.0;INTEGRATED BILLING;**164,171,176,188,312,454**;21-MAR-94;Build 4
+2 ;;Per VHA DIRECTIVE 10-93-142, this routine should not be modified.
+3 ;
+4 ; Comment- This routine is invoked via the appointment driver ^IBAMTS
+5 ; This program checks for check outs and determines if
+6 ; the person checking out is ELIGIBLE for Long Term Care
+7 ; and determines if the encounter was related to LTC.
+8 ; If the episode of care is related to LTC and the patient
+9 ; is eligible to receive care and is compliant with all
+10 ; the LTC business rules than the entry is added to
+11 ; the LTC transaction file #351.8.
+12 ;
+13 ; Determine if this encounter has a status of checked out
EN NEW IBEVT,IBEV0,DFN,IBSDHDL,IBORG,IBOE,IBLTCST,IBCL,IBDT,IBST,IBM
+1 ;IB*2.0*312
NEW IBSWINFO
SET IBSWINFO=$$SWSTAT^IBBAPI()
+2 SET IBSDHDL=0
+3 ;
+4 ; === ON/OFF Switch by date if before 11/15/06 software will not run
+5 ; === IBALTC=0 the Encounter is not LTC Billable pass to MT Module
+6 ; === IBALTC=1 Encounter is LTC Billable do NOT Pass to MTC
+7 ;
+8 SET IBALTC=0
+9 ;I DT<$$STDATE^IBAECU1() Q ;quit if today<effective date
+10 FOR
SET IBSDHDL=$ORDER(^TMP("SDEVT",$JOB,IBSDHDL))
if 'IBSDHDL
QUIT
Begin DoDot:1
+11 SET IBORG=0
FOR
SET IBORG=$ORDER(^TMP("SDEVT",$JOB,IBSDHDL,IBORG))
if 'IBORG
QUIT
Begin DoDot:2
+12 SET IBOE=0
FOR
SET IBOE=$ORDER(^TMP("SDEVT",$JOB,IBSDHDL,IBORG,"SDOE",IBOE))
if 'IBOE
QUIT
SET IBEVT=$GET(^(IBOE,0,"AFTER"))
SET IBEV0=$GET(^("BEFORE"))
Begin DoDot:3
+13 ;
+14 ; do not evaluate sibling encounters
if $PIECE(IBEVT,U,6)
QUIT
+15 ; do not evaluate inpatient encounters
if $PIECE(IBEVT,U,12)=8
QUIT
+16 ;
+17 ; set variables
+18 SET DFN=$PIECE(IBEVT,U,2)
SET IBDT=$SELECT(+IBEVT:+IBEVT,1:+IBEV0)
SET IBST=$PIECE(IBEVT,U,3)
+19 if IBDT<$$STDATE^IBAECU1
QUIT
+20 if 'DFN!('IBDT)
QUIT
+21 ;
+22 ; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date ;CCR-930
+23 ;IB*2.0*312
IF +IBSWINFO
IF (IBDT+1)>$PIECE(IBSWINFO,"^",2)
QUIT
+24 ;
+25 ; stop code preset and LTC event?
+26 IF 'IBST
QUIT
+27 IF '$$LTCSTOP^IBAECU(IBST)
QUIT
+28 ;
+29 ; set flag to stop MT billing
+30 SET IBALTC=1
+31 ;
+32 ; LTC patient check
+33 SET IBLTCST=+$$LTCST^IBAECU(DFN,IBDT\1,1)
+34 ;
+35 ; are they exempt from non-institutional LTC because of CD status?
+36 IF $$CDEXMPT^IBAECU(DFN,IBDT\1)
QUIT
+37 ;
+38 ; no 1010EC on file
+39 IF IBLTCST=0
Begin DoDot:4
+40 SET IBM(1)=""
SET IBM(2)=" Event Type: Outpatient Encounter"
+41 SET IBM(3)=""
SET IBM(4)="Event Action: "_$SELECT($PIECE(IBEV0,"^",12)'=2&($PIECE(IBEVT,"^",12)=2):"Checked Out",IBEVT&(IBEV0):"Edited",IBEV0:"Deleted",1:"Added")
+42 SET IBM(5)=""
SET IBM(6)=" Location: "_$SELECT($PIECE(IBEVT,"^",4):$PIECE($GET(^SC(+$PIECE(IBEVT,"^",4),0)),"^"),$PIECE(IBEVO,"^",4):$PIECE($GET(^SC(+$PIECE(IBEVO,"^",4),0)),"^"),1:"")
End DoDot:4
DO XMNOEC^IBAECU(DFN,.IBDT,.IBM)
QUIT
+43 ;
+44 ; is this a back billing issue, if so, send message and quit
+45 IF $$LASTMJ^IBAECU()>0
IF $$LASTMJ^IBAECU()>IBDT
Begin DoDot:4
+46 SET IBM(1)="An Outpatient Encounter was "_$SELECT(IBEVT&(IBEV0):"Edited",IBEV0:"Deleted",1:"Added")_"."
+47 SET IBM(2)="This may result in a Back Billing issue for LTC. You should review the"
+48 SET IBM(3)="patient's records for "_$$FMTE^XLFDT(IBDT)_" to ensure correct billing."
+49 SET IBM(4)="LTC Billing Clock and LTC charges may have to be manually adjusted."
End DoDot:4
DO XMBACK^IBAECU(DFN,.IBM)
QUIT
+50 ;
+51 ; add LTC clock/update last event date (if not LTC exempt)
+52 IF IBLTCST=2
SET IBCL=$$CLOCK^IBAECU(DFN,IBDT\1)
+53 ;
End DoDot:3
End DoDot:2
End DoDot:1
+54 ;
+55 QUIT
+56 ;
CALC ; used to calculate the outpatient charge
+1 ; variables needed DFN, IBLTCST, IBCHG, IBFR
+2 ; this will adjust IBCHG so the patient is not above their calculated
+3 ; copay cap for the month.
+4 NEW IBTYP,IBT
+5 ;
+6 ; find all LTC charges and set flag to determine inpt or opt
+7 ; cap to be used.
+8 DO TOT^IBAECU
+9 ;
+10 WRITE !!," Calculated Monthly Copay Cap Type to be used: ",$SELECT(IBTYP="I":"IN",1:"OUT"),"PATIENT"
+11 WRITE !," Calculated Monthly Copay Cap is: $ ",$FNUMBER($PIECE(IBLTCST,"^",$SELECT(IBTYP="I":3,1:5)),",",2)
+12 WRITE !," Total previously billed: $ ",$FNUMBER(IBT,",",2)
+13 ;
+14 IF IBCHG+IBT>$PIECE(IBLTCST,"^",$SELECT(IBTYP="I":3,1:5))
SET IBCHG=$PIECE(IBLTCST,"^",$SELECT(IBTYP="I":3,1:5))-IBT
+15 ;
+16 ; check for negative $ amount cap
+17 IF $PIECE(IBLTCST,"^",$SELECT(IBTYP="I":3,1:5))<0
SET IBCHG=0
+18 ;
+19 QUIT
