IBAECO.m

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 ---IBAECO   4305     printed  Feb 18, 2025@23:32:28                                                                                                                                                                                                      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