source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAECO.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1IBAECO ;ALB/BGA - LONG TERM CARE OUTPATIENT TRACKER ;16-OCT-01
2 ;;2.0;INTEGRATED BILLING;**164,171,176,188,312**;21-MAR-94
3 ;;Per VHA DIRECTIVE 10-93-142, this routine should not be modified.
4 ;
5 ; Comment- This routine is invoked via the appointment driver ^IBAMTS
6 ; This program checks for check outs and determines if
7 ; the person checking out is ELIGIBLE for Long Term Care
8 ; and determines if the encounter was related to LTC.
9 ; If the episode of care is related to LTC and the patient
10 ; is eligible to receive care and is compliant with all
11 ; the LTC business rules than the entry is added to
12 ; the LTC transaction file #351.8.
13 ;
14 ; Determine if this encounter has a status of checked out
15EN N IBEVT,IBEV0,DFN,IBSDHDL,IBORG,IBOE,IBLTCST,IBCL,IBDT,IBST,IBM
16 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
17 S IBSDHDL=0
18 ;
19 ; === ON/OFF Switch by date if before 11/15/06 software will not run
20 ; === IBALTC=0 the Encounter is not LTC Billable pass to MT Module
21 ; === IBALTC=1 Encounter is LTC Billable do NOT Pass to MTC
22 ;
23 S IBALTC=0
24 ;I DT<$$STDATE^IBAECU1() Q ;quit if today<effective date
25 F S IBSDHDL=$O(^TMP("SDEVT",$J,IBSDHDL)) Q:'IBSDHDL D
26 . S IBORG=0 F S IBORG=$O(^TMP("SDEVT",$J,IBSDHDL,IBORG)) Q:'IBORG D
27 . . 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
28 . . . ;
29 . . . Q:$P(IBEVT,U,6) ; do not evaluate sibling encounters
30 . . . Q:$P(IBEVT,U,12)=8 ; do not evaluate inpatient encounters
31 . . . ;
32 . . . ; set variables
33 . . . S DFN=$P(IBEVT,U,2),IBDT=$S(+IBEVT:+IBEVT,1:+IBEV0),IBST=$P(IBEVT,U,3)
34 . . . Q:IBDT<$$STDATE^IBAECU1
35 . . . Q:'DFN!('IBDT)
36 . . . ;
37 . . . ; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date ;CCR-930
38 . . . I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
39 . . . ;
40 . . . ; stop code preset and LTC event?
41 . . . I 'IBST Q
42 . . . I '$$LTCSTOP^IBAECU(IBST) Q
43 . . . ;
44 . . . ; set flag to stop MT billing
45 . . . S IBALTC=1
46 . . . ;
47 . . . ; LTC patient check
48 . . . S IBLTCST=+$$LTCST^IBAECU(DFN,IBDT\1,1)
49 . . . ;
50 . . . ; no 1010EC on file
51 . . . I IBLTCST=0 D D XMNOEC^IBAECU(DFN,.IBDT,.IBM) Q
52 . . . . S IBM(1)="",IBM(2)=" Event Type: Outpatient Encounter"
53 . . . . 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")
54 . . . . 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:"")
55 . . . ;
56 . . . ; is this a back billing issue, if so, send message and quit
57 . . . I $$LASTMJ^IBAECU()>0,$$LASTMJ^IBAECU()>IBDT D D XMBACK^IBAECU(DFN,.IBM) Q
58 . . . . S IBM(1)="An Outpatient Encounter was "_$S(IBEVT&(IBEV0):"Edited",IBEV0:"Deleted",1:"Added")_"."
59 . . . . S IBM(2)="This may result in a Back Billing issue for LTC. You should review the"
60 . . . . S IBM(3)="patient's records for "_$$FMTE^XLFDT(IBDT)_" to ensure correct billing."
61 . . . . S IBM(4)="LTC Billing Clock and LTC charges may have to be manually adjusted."
62 . . . ;
63 . . . ; add LTC clock/update last event date (if not LTC exempt)
64 . . . I IBLTCST=2 S IBCL=$$CLOCK^IBAECU(DFN,IBDT\1)
65 . . . ;
66 ;
67 Q
68 ;
69CALC ; used to calculate the outpatient charge
70 ; variables needed DFN, IBLTCST, IBCHG, IBFR
71 ; this will adjust IBCHG so the patient is not above their calculated
72 ; copay cap for the month.
73 N IBTYP,IBT
74 ;
75 ; find all LTC charges and set flag to determine inpt or opt
76 ; cap to be used.
77 D TOT^IBAECU
78 ;
79 W !!," Calculated Monthly Copay Cap Type to be used: ",$S(IBTYP="I":"IN",1:"OUT"),"PATIENT"
80 W !," Calculated Monthly Copay Cap is: $ ",$FN($P(IBLTCST,"^",$S(IBTYP="I":3,1:5)),",",2)
81 W !," Total previously billed: $ ",$FN(IBT,",",2)
82 ;
83 I IBCHG+IBT>$P(IBLTCST,"^",$S(IBTYP="I":3,1:5)) S IBCHG=$P(IBLTCST,"^",$S(IBTYP="I":3,1:5))-IBT
84 ;
85 ; check for negative $ amount cap
86 I $P(IBLTCST,"^",$S(IBTYP="I":3,1:5))<0 S IBCHG=0
87 ;
88 Q
Note: See TracBrowser for help on using the repository browser.