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

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1IBAMTV ;ALB/CPM - BACK-BILLING SUPPORT FOR IVM ; 31-MAY-94
2 ;;2.0;INTEGRATED BILLING;**15,153**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Input: DFN -- Pointer to the patient in file #2
6 ; DGMTP -- Zeroth node of previous MT in file #408.31
7 ; DGMTA -- Zeroth node of verified MT in file #408.31
8 ;
9 ; - begin back-billing from the original completed date.
10 S IBSTART=$P(DGMTA,"^",7) G:'IBSTART!(IBSTART'<DT) END
11 S IBEND=$$FMADD^XLFDT(IBSTART\1,364)
12 S:IBEND'<DT IBEND=$$FMADD^XLFDT(DT,-1)
13 ;
14 ; - build array of episodes of care to be billed
15 D CARE^IBAMTV1
16 ;
17 ; - analyze the array and build charges
18 I $D(^TMP("IBAMTV",$J)) D BLD^IBAMTV2
19 ;
20 ; - send a message if any charges need to be reviewed
21 I '$D(^IB("AJ",DFN)) G END
22 ;
23 K IBT S IBPT=$$PT^IBEFUNC(DFN)
24 S XMSUB="BACK-BILLING OF MEANS TEST CHARGES"
25 S IBT(1)="A verified Means Test has just been received from the IVM Center."
26 S IBT(2)="Means Test charges have been back-billed for the following patient:"
27 S IBT(3)=" " S IBC=3
28 S IBDUZ=DUZ D PAT^IBAERR1
29 S IBC=IBC+1,IBT(IBC)=" "
30 S IBC=IBC+1,IBT(IBC)="Please note that these charges are on hold, pending a manual review before"
31 S IBC=IBC+1,IBT(IBC)="being passed to Accounts Receivable. Please use the option 'Release Charges"
32 S IBC=IBC+1,IBT(IBC)="Pending Review' to review the charges and pass them to Accounts Receivable."
33 D SEND^IBACVA2
34 ;
35END K IBDUZ,IBEND,IBSTART,^TMP("IBAMTV",$J)
36 Q
37 ;
38 ;
39CANC ; Cancel Means Test charges if an IVM-verified Means Test is deleted.
40 ; Input: DFN -- Pointer to the patient in file #2
41 ; DGMTP -- Zeroth node of previous MT in file #408.31
42 ; DGMTA -- Zeroth node of verified MT in file #408.31
43 ;
44 Q:'$$CHECK^IBECEAU
45 S IBCRES=+$O(^IBE(350.3,"B","MT STATUS CHANGED FROM YES",0))
46 S:'IBCRES IBCRES=22 S IBJOB=9,IBWHER=30,IBDUZ=DUZ,IBFOUND=0
47 S IBST=+DGMTA,IBEND=$$FMADD^XLFDT(IBST,364) S:IBEND>DT IBEND=DT
48 S IBZ="" F S IBZ=$O(^IB("AFDT",DFN,IBZ)) Q:'IBZ I -IBZ'>IBEND S IBZ1=0 F S IBZ1=$O(^IB("AFDT",DFN,IBZ,IBZ1)) Q:'IBZ1 D
49 .S IBDA=0 F S IBDA=$O(^IB("AF",IBZ1,IBDA)) Q:'IBDA D
50 ..Q:'$D(^IB(IBDA,0)) S IBX=^(0)
51 ..Q:$P(IBX,"^",8)["ADMISSION" ; skip event records
52 ..Q:$P(IBX,"^",9)'=IBDA ; look only at original actions
53 ..S (IBN,IBORIG)=$$LAST^IBECEAU(IBDA),IBND=$G(^IB(IBN,0)),IBND1=$G(^(1))
54 ..I IBN=IBDA&($P(IBX,"^",5)=10)!($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5)=2) Q ; already cancelled
55 ..I $P(IBND,"^",15)<IBST!($P(IBND,"^",14)>IBEND) Q ; out of range
56 ..Q:$$BIL^DGMTUB(DFN,$P(IBND,"^",14)) ; still Means Test billable
57 ..D CANCH^IBECEAU4(IBN,IBCRES)
58 ..S IBN=$$LAST^IBECEAU(IBDA),IBND=$G(^IB(IBN,0)),IBX=$G(^IB(IBORIG,0))
59 ..I IBN=IBDA&($P(IBX,"^",5)=10)!($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5)=2) S IBFOUND=1 D ADJCL
60 ;
61 I IBFOUND D CANBULL
62 K IBCRES,IBST,IBEND,IBZ,IBZ1,IBDA,IBX,IBN,IBND,IBND1,IBJOB,IBWHER,IBDUZ,IBFOUND,IBORIG
63 Q
64 ;
65CANBULL ; Generate the cancellation bulletin.
66 K IBT S IBPT=$$PT^IBEFUNC(DFN)
67 S XMSUB="CANCELLATION OF BACK-BILLED MEANS TEST CHARGES"
68 S IBT(1)="An IVM-verified Means Test was just deleted for the following patient:"
69 S IBT(2)=" " S IBC=2
70 S IBDUZ=DUZ D PAT^IBAERR1
71 S IBC=IBC+1,IBT(IBC)=" "
72 S IBC=IBC+1,IBT(IBC)="All back-billed Means Test charges for this patient were cancelled."
73 S IBC=IBC+1,IBT(IBC)="You should review this patient's Means Test billing history and billing"
74 S IBC=IBC+1,IBT(IBC)="clock for accuracy, starting on "_$$DAT1^IBOUTL(+DGMTA)_"."
75 D SEND^IBACVA2
76 K IBDUZ
77 Q
78 ;
79ADJCL ; Roll back the billing clock for cancelled charges.
80 ; Input: IBX -- Zeroth node of charge which has been cancelled.
81 ; DFN -- Pointer to the patient in file #2
82 ;
83 N IBCL,IBCLD,IBUN,IBCLDAY,IBCHG,IBCLP,IBAP
84 Q:$P(IBX,"^",8)["OPT COPAY" ; no adjustments needed for opt copays
85 S IBCL=$$OLDCL^IBAMTV2(DFN,$P(IBX,"^",14)) Q:'IBCL ; no clock
86 S IBCLD=$G(^IBE(351,IBCL,0)) Q:'IBCLD
87 ;
88 ; - handle per diem charges
89 I $P($G(^IBE(350.1,+$P(IBX,"^",3),0)),"^",11)=3 D
90 .S IBUN=$P(IBX,"^",6),IBCLDAY=$P(IBCLD,"^",9)
91 .S $P(^IBE(351,IBCL,0),"^",9)=$S(IBCLDAY>IBUN:IBCLDAY-IBUN,1:0) D UPD
92 ;
93 ; - handle inpt copay charges
94 I $P($G(^IBE(350.1,+$P(IBX,"^",3),0)),"^",11)=2 D
95 .S IBCHG=$P(IBX,"^",7) Q:'IBCHG
96 .F IBCLP=8:-1:5 S IBAP=$P(IBCLD,"^",IBCLP) D Q:'IBCHG
97 ..I IBCHG>IBAP S IBCHG=IBCHG-IBAP,$P(^IBE(351,IBCL,0),"^",IBCLP)=0 D UPD Q
98 ..S $P(^IBE(351,IBCL,0),"^",IBCLP)=IBAP-IBCHG,IBCHG=0 D UPD
99 ;
100 Q
101 ;
102UPD ; Update user and edit date on the Billing Clock.
103 D NOW^%DTC S $P(^IBE(351,IBCL,1),"^",3,4)=DUZ_"^"_%
104 Q
Note: See TracBrowser for help on using the repository browser.