| 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
 | 
|---|