1 | RCEXINAD ;ALB/MAF - Exempt int/admin for Katrina victims from 9/1/05 - patch install;3 Oct 05
|
---|
2 | ;;4.5;Accounts Receivable;**237,241**;Mar 20, 1995
|
---|
3 | ;;
|
---|
4 | ;
|
---|
5 | START ;
|
---|
6 | N ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF,RCDFN,DATEEND,RCDEB,X
|
---|
7 | ; needs datebeg, dateend
|
---|
8 | ; total is total by category
|
---|
9 | ;
|
---|
10 | ;
|
---|
11 | S RCNOHSIF=$$NOHSIF^RCRJRCO() ; no HSIF (disabled)
|
---|
12 | ;
|
---|
13 | K ^TMP("RCINTADM",$J)
|
---|
14 | F TRANTYPE=13 D
|
---|
15 | . S DATE=3050901-1,DATEEND=9999999
|
---|
16 | . F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
|
---|
17 | . . S TRANDA=0
|
---|
18 | . . F S TRANDA=$O(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA)) Q:'TRANDA D
|
---|
19 | . . . S BILLDA=+$P($G(^PRCA(433,TRANDA,0)),"^",2) I 'BILLDA Q
|
---|
20 | . . . ; bill not linked to a site
|
---|
21 | . . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
|
---|
22 | . . . S RCDEB=$P($G(^PRCA(430,BILLDA,0)),"^",9) Q:'+RCDEB D Q:'+RCDFN
|
---|
23 | . . . . S RCDFN=0
|
---|
24 | . . . . Q:$P($G(^RCD(340,+RCDEB,0)),"^",1)'["DPT"
|
---|
25 | . . . . S RCDFN=+$P($G(^RCD(340,+RCDEB,0)),"^",1)
|
---|
26 | . . . . Q
|
---|
27 | . . . ;Check if emergency response victim
|
---|
28 | . . . I $$EMERES^PRCAUTL(+RCDFN)']"" Q
|
---|
29 | . . . Q:$P($G(^RCD(340,+RCDEB,0)),"^",8) ; already exempted
|
---|
30 | . . . S ^TMP("RCINTADM",$J,RCDFN,BILLDA)=""
|
---|
31 | . . . Q
|
---|
32 | I '$D(^TMP("RCINTADM",$J)) Q
|
---|
33 | N BILLDA,RCDFN,PAYDAT
|
---|
34 | S (RCDFN,BILLDA)=0,PAYDAT=3050901
|
---|
35 | F S RCDFN=$O(^TMP("RCINTADM",$J,RCDFN)) Q:RCDFN']"" F S BILLDA=$O(^TMP("RCINTADM",$J,RCDFN,BILLDA)) Q:BILLDA']"" D EXEMPT(BILLDA,PAYDAT)
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | ;
|
---|
39 | EXEMPT(RCBILLDA,RCPAYDAT) ; exempt interest/admin/penalty charges
|
---|
40 | ; added after the payment date
|
---|
41 | N ADMIN,BILLBAL,COMMENT,INTEREST,PENALTY,RCDATE,RCEXTRAN,RCFLAG,RCLIST,RCTRANDA,TRANDA,DATE,RCEND,RCEXEM
|
---|
42 | ;
|
---|
43 | S BILLBAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
|
---|
44 | ; no interest or admin to exempt
|
---|
45 | I ($P(BILLBAL,"^",2)+$P(BILLBAL,"^",3))=0 Q
|
---|
46 | ; loop thru transactions after payment date and look for
|
---|
47 | ; interest/admin charge transactions to exempt
|
---|
48 | S RCDATE=RCPAYDAT-.1
|
---|
49 | ;set an end date so that no transactions beyond the emergency response end date are exempted
|
---|
50 | S X=$P($G(^RC(342,1,30)),"^",2)
|
---|
51 | S RCEND=$S('X:DT,DT<X:DT,1:X)
|
---|
52 | F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE!(RCDATE>RCEND) D
|
---|
53 | . S RCTRANDA=0
|
---|
54 | . F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
|
---|
55 | . . I RCLIST(RCDATE,RCTRANDA)'["INTEREST/ADM. CHARGE" Q
|
---|
56 | . . ; interest/admin/penalty charge added after payment date
|
---|
57 | . . ; exempt the charge
|
---|
58 | . . ;
|
---|
59 | . . ; check to see if charge is already exempted
|
---|
60 | . . ; the charge would be on the same date
|
---|
61 | . . ; for example:
|
---|
62 | . . ; rclist(3000424,2742117)=INTEREST/ADM. CHARGE^^ .68^ .45^0^0
|
---|
63 | . . ; rclist(3000424,2750151)=EXEMPT INT/ADM. COST^^-.68^-.45^0^0
|
---|
64 | . . S RCFLAG=0
|
---|
65 | . . S TRANDA=RCTRANDA,DATE=RCDATE-.1
|
---|
66 | . . F S DATE=$O(RCLIST(DATE)) Q:'DATE!(RCFLAG) F S TRANDA=$O(RCLIST(DATE,TRANDA)) Q:'TRANDA!(RCFLAG) D I RCFLAG Q
|
---|
67 | . . . I RCLIST(DATE,TRANDA)'["EXEMPT INT/ADM. COST" Q
|
---|
68 | . . . ;skip exemption if it has already been matched with another interest charge
|
---|
69 | . . . Q:$D(RCEXEM(TRANDA))
|
---|
70 | . . . ; compare interest values (p3) and admin (p4)
|
---|
71 | . . . I +$P(RCLIST(RCDATE,RCTRANDA),"^",3)'=-$P(RCLIST(DATE,TRANDA),"^",3) Q
|
---|
72 | . . . I +$P(RCLIST(RCDATE,RCTRANDA),"^",4)'=-$P(RCLIST(DATE,TRANDA),"^",4) Q
|
---|
73 | . . . ; transaction already exempted; save transaction as one already matched
|
---|
74 | . . . S RCFLAG=1,RCEXEM(TRANDA)=""
|
---|
75 | . . I $G(RCFLAG) Q
|
---|
76 | . . ;
|
---|
77 | . . S INTEREST=$P(RCLIST(RCDATE,RCTRANDA),"^",3)
|
---|
78 | . . S ADMIN=$P(RCLIST(RCDATE,RCTRANDA),"^",4)
|
---|
79 | . . I 'INTEREST,'ADMIN Q
|
---|
80 | . . ;
|
---|
81 | . . ; check to make sure the amount being exempted does not
|
---|
82 | . . ; exceed the balance of the bill
|
---|
83 | . . I INTEREST>$P(BILLBAL,"^",2) Q
|
---|
84 | . . I ADMIN>$P(BILLBAL,"^",3) Q
|
---|
85 | . . ;
|
---|
86 | . . ; get the penalty charge from the transaction. this charge is computed in the
|
---|
87 | . . ; admin value, so subtract it from admin
|
---|
88 | . . S PENALTY=$P($G(^PRCA(433,RCTRANDA,2)),"^",9)
|
---|
89 | . . I PENALTY S ADMIN=ADMIN-PENALTY S:ADMIN<0 ADMIN=0
|
---|
90 | . . ;
|
---|
91 | . . ; add the exempt transaction to file 433 with the date
|
---|
92 | . . ; equal to the date the int/admin charge created
|
---|
93 | . . S COMMENT(1)="Auto exemption of "_RCTRANDA_", charges applied "_$S(RCDATE=RCPAYDAT:"on ",1:"after ")_$$FORMATDT^RCBECHGA(RCPAYDAT)_" for Hurricane Katrina victims."
|
---|
94 | . . ; make sure the time is entered for date processed in file 433 1;9
|
---|
95 | . . ; if not, it will show as being out of balance on patient statement
|
---|
96 | . . ; this was added for patch 162.
|
---|
97 | . . ;
|
---|
98 | . . ; patch 165 removed the process date passed so the current date
|
---|
99 | . . ; and time would be used. this will prevent statements from
|
---|
100 | . . ; being out of balance.
|
---|
101 | . . ;N %,%H,%I,PROCDATE
|
---|
102 | . . ;D NOW^%DTC S PROCDATE=$P(RCDATE,".")_"."_$P(%,".",2)
|
---|
103 | . . S RCEXTRAN=$$EXEMPT^RCBEUTR2(RCBILLDA,INTEREST_"^"_ADMIN_"^"_PENALTY,.COMMENT,0)
|
---|
104 | Q
|
---|