source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCYPO237.m@ 1693

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

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