RCYPO237 ;ALB/MAF - Post-init to cancel int/admin for Katrina victims from 9/1/05 - patch install;3 Oct 05
;;4.5;Accounts Receivable;**237**;Mar 20, 1995
;;
;
START ;
N ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF,RCDFN,DATEEND,RCDEB,X
D BMES^XPDUTL(">>>>>>> Exempting the interest and administrative charges calculated <<<<<<<")
D MES^XPDUTL(" for Katrina affected patients from 9/1/05 - Today. ")
D BMES^XPDUTL("The post-init RCYPO237, will exempt interest and administrative charges")
D MES^XPDUTL("accrued for affected veterans from 9/1/05 until the installation of this ")
D MES^XPDUTL("patch. For all Hurricane Katrina affected veterans, on every outstanding ")
D MES^XPDUTL("bill, the interest and administrative charges accrued from 9/1/05 until ")
D MES^XPDUTL("the installation of this patch will be exempted.")
; needs datebeg, dateend
; total is total by category
;
;
S RCNOHSIF=$$NOHSIF^RCRJRCO() ; no HSIF (disabled)
;
K ^TMP("RCINTADM",$J)
F TRANTYPE=13 D
. S DATE=3050901-1,DATEEND=9999999
. F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
. . S TRANDA=0
. . F S TRANDA=$O(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA)) Q:'TRANDA D
. . . S BILLDA=+$P($G(^PRCA(433,TRANDA,0)),"^",2) I 'BILLDA Q
. . . ; bill not linked to a site
. . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
. . . S RCDEB=$P($G(^PRCA(430,BILLDA,0)),"^",9) Q:'+RCDEB D Q:'+RCDFN
. . . . S RCDFN=0
. . . . Q:$P($G(^RCD(340,+RCDEB,0)),"^",1)'["DPT"
. . . . S RCDFN=+$P($G(^RCD(340,+RCDEB,0)),"^",1)
. . . . Q
. . . ;Check if emergency response victim
. . . I $$EMERES^PRCAUTL(+RCDFN)']"" Q
. . . S ^TMP("RCINTADM",$J,RCDFN,BILLDA)=""
. . . Q
I '$D(^TMP("RCINTADM",$J)) D BMES^XPDUTL("* There are no Katrina affected patients at this facility. No charges exempted.") Q
N BILLDA,RCDFN,PAYDAT
S (RCDFN,BILLDA)=0,PAYDAT=3050901
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)
D BMES^XPDUTL("Done")
Q
;
;
EXEMPT(RCBILLDA,RCPAYDAT) ; exempt interest/admin/penalty charges
; added after the payment date
N ADMIN,BILLBAL,COMMENT,INTEREST,PENALTY,RCDATE,RCEXTRAN,RCFLAG,RCLIST,RCTRANDA,TRANDA,DATE,RCEND,RCEXEM
;
S BILLBAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
; no interest or admin to exempt
I ($P(BILLBAL,"^",2)+$P(BILLBAL,"^",3))=0 Q
; loop thru transactions after payment date and look for
; interest/admin charge transactions to exempt
S RCDATE=RCPAYDAT-.1
;set an end date so that no transactions beyond the emergency response end date are exempted
S X=$P($G(^RC(342,1,30)),"^",2)
S RCEND=$S('X:DT,DT<X:DT,1:X)
F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE!(RCDATE>RCEND) D
. S RCTRANDA=0
. F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
. . I RCLIST(RCDATE,RCTRANDA)'["INTEREST/ADM. CHARGE" Q
. . ; interest/admin/penalty charge added after payment date
. . ; exempt the charge
. . ;
. . ; check to see if charge is already exempted
. . ; the charge would be on the same date
. . ; for example:
. . ; rclist(3000424,2742117)=INTEREST/ADM. CHARGE^^ .68^ .45^0^0
. . ; rclist(3000424,2750151)=EXEMPT INT/ADM. COST^^-.68^-.45^0^0
. . S RCFLAG=0
. . S TRANDA=RCTRANDA,DATE=RCDATE-.1
. . F S DATE=$O(RCLIST(DATE)) Q:'DATE!(RCFLAG) F S TRANDA=$O(RCLIST(DATE,TRANDA)) Q:'TRANDA!(RCFLAG) D I RCFLAG Q
. . . I RCLIST(DATE,TRANDA)'["EXEMPT INT/ADM. COST" Q
. . . ;skip exemption if it has already been matched with another interest charge
. . . Q:$D(RCEXEM(TRANDA))
. . . ; compare interest values (p3) and admin (p4)
. . . I +$P(RCLIST(RCDATE,RCTRANDA),"^",3)'=-$P(RCLIST(DATE,TRANDA),"^",3) Q
. . . I +$P(RCLIST(RCDATE,RCTRANDA),"^",4)'=-$P(RCLIST(DATE,TRANDA),"^",4) Q
. . . ; transaction already exempted; save transaction as one already matched
. . . S RCFLAG=1,RCEXEM(TRANDA)=""
. . I $G(RCFLAG) Q
. . ;
. . S INTEREST=$P(RCLIST(RCDATE,RCTRANDA),"^",3)
. . S ADMIN=$P(RCLIST(RCDATE,RCTRANDA),"^",4)
. . I 'INTEREST,'ADMIN Q
. . ;
. . ; check to make sure the amount being exempted does not
. . ; exceed the balance of the bill
. . I INTEREST>$P(BILLBAL,"^",2) Q
. . I ADMIN>$P(BILLBAL,"^",3) Q
. . ;
. . ; get the penalty charge from the transaction. this charge is computed in the
. . ; admin value, so subtract it from admin
. . S PENALTY=$P($G(^PRCA(433,RCTRANDA,2)),"^",9)
. . I PENALTY S ADMIN=ADMIN-PENALTY S:ADMIN<0 ADMIN=0
. . ;
. . ; add the exempt transaction to file 433 with the date
. . ; equal to the date the int/admin charge created
. . S COMMENT(1)="Auto exemption of "_RCTRANDA_", charges applied "_$S(RCDATE=RCPAYDAT:"on ",1:"after ")_$$FORMATDT^RCBECHGA(RCPAYDAT)_" for Hurricane Katrina victims."
. . ; make sure the time is entered for date processed in file 433 1;9
. . ; if not, it will show as being out of balance on patient statement
. . ; this was added for patch 162.
. . ;
. . ; patch 165 removed the process date passed so the current date
. . ; and time would be used. this will prevent statements from
. . ; being out of balance.
. . ;N %,%H,%I,PROCDATE
. . ;D NOW^%DTC S PROCDATE=$P(RCDATE,".")_"."_$P(%,".",2)
. . S RCEXTRAN=$$EXEMPT^RCBEUTR2(RCBILLDA,INTEREST_"^"_ADMIN_"^"_PENALTY,.COMMENT,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCYPO237 5716 printed Nov 22, 2024@17:00:13 Page 2
RCYPO237 ;ALB/MAF - Post-init to cancel int/admin for Katrina victims from 9/1/05 - patch install;3 Oct 05
+1 ;;4.5;Accounts Receivable;**237**;Mar 20, 1995
+2 ;;
+3 ;
START ;
+1 NEW ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF,RCDFN,DATEEND,RCDEB,X
+2 DO BMES^XPDUTL(">>>>>>> Exempting the interest and administrative charges calculated <<<<<<<")
+3 DO MES^XPDUTL(" for Katrina affected patients from 9/1/05 - Today. ")
+4 DO BMES^XPDUTL("The post-init RCYPO237, will exempt interest and administrative charges")
+5 DO MES^XPDUTL("accrued for affected veterans from 9/1/05 until the installation of this ")
+6 DO MES^XPDUTL("patch. For all Hurricane Katrina affected veterans, on every outstanding ")
+7 DO MES^XPDUTL("bill, the interest and administrative charges accrued from 9/1/05 until ")
+8 DO MES^XPDUTL("the installation of this patch will be exempted.")
+9 ; needs datebeg, dateend
+10 ; total is total by category
+11 ;
+12 ;
+13 ; no HSIF (disabled)
SET RCNOHSIF=$$NOHSIF^RCRJRCO()
+14 ;
+15 KILL ^TMP("RCINTADM",$JOB)
+16 FOR TRANTYPE=13
Begin DoDot:1
+17 SET DATE=3050901-1
SET DATEEND=9999999
+18 FOR
SET DATE=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE))
if 'DATE!(DATE>DATEEND)
QUIT
Begin DoDot:2
+19 SET TRANDA=0
+20 FOR
SET TRANDA=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:3
+21 SET BILLDA=+$PIECE($GET(^PRCA(433,TRANDA,0)),"^",2)
IF 'BILLDA
QUIT
+22 ; bill not linked to a site
+23 IF '$PIECE($GET(^PRCA(430,BILLDA,0)),"^",12)
QUIT
+24 SET RCDEB=$PIECE($GET(^PRCA(430,BILLDA,0)),"^",9)
if '+RCDEB
QUIT
Begin DoDot:4
+25 SET RCDFN=0
+26 if $PIECE($GET(^RCD(340,+RCDEB,0)),"^",1)'["DPT"
QUIT
+27 SET RCDFN=+$PIECE($GET(^RCD(340,+RCDEB,0)),"^",1)
+28 QUIT
End DoDot:4
if '+RCDFN
QUIT
+29 ;Check if emergency response victim
+30 IF $$EMERES^PRCAUTL(+RCDFN)']""
QUIT
+31 SET ^TMP("RCINTADM",$JOB,RCDFN,BILLDA)=""
+32 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF '$DATA(^TMP("RCINTADM",$JOB))
DO BMES^XPDUTL("* There are no Katrina affected patients at this facility. No charges exempted.")
QUIT
+34 NEW BILLDA,RCDFN,PAYDAT
+35 SET (RCDFN,BILLDA)=0
SET PAYDAT=3050901
+36 FOR
SET RCDFN=$ORDER(^TMP("RCINTADM",$JOB,RCDFN))
if RCDFN']""
QUIT
FOR
SET BILLDA=$ORDER(^TMP("RCINTADM",$JOB,RCDFN,BILLDA))
if BILLDA']""
QUIT
DO EXEMPT(BILLDA,PAYDAT)
+37 DO BMES^XPDUTL("Done")
+38 QUIT
+39 ;
+40 ;
EXEMPT(RCBILLDA,RCPAYDAT) ; exempt interest/admin/penalty charges
+1 ; added after the payment date
+2 NEW ADMIN,BILLBAL,COMMENT,INTEREST,PENALTY,RCDATE,RCEXTRAN,RCFLAG,RCLIST,RCTRANDA,TRANDA,DATE,RCEND,RCEXEM
+3 ;
+4 SET BILLBAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
+5 ; no interest or admin to exempt
+6 IF ($PIECE(BILLBAL,"^",2)+$PIECE(BILLBAL,"^",3))=0
QUIT
+7 ; loop thru transactions after payment date and look for
+8 ; interest/admin charge transactions to exempt
+9 SET RCDATE=RCPAYDAT-.1
+10 ;set an end date so that no transactions beyond the emergency response end date are exempted
+11 SET X=$PIECE($GET(^RC(342,1,30)),"^",2)
+12 SET RCEND=$SELECT('X:DT,DT<X:DT,1:X)
+13 FOR
SET RCDATE=$ORDER(RCLIST(RCDATE))
if 'RCDATE!(RCDATE>RCEND)
QUIT
Begin DoDot:1
+14 SET RCTRANDA=0
+15 FOR
SET RCTRANDA=$ORDER(RCLIST(RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+16 IF RCLIST(RCDATE,RCTRANDA)'["INTEREST/ADM. CHARGE"
QUIT
+17 ; interest/admin/penalty charge added after payment date
+18 ; exempt the charge
+19 ;
+20 ; check to see if charge is already exempted
+21 ; the charge would be on the same date
+22 ; for example:
+23 ; rclist(3000424,2742117)=INTEREST/ADM. CHARGE^^ .68^ .45^0^0
+24 ; rclist(3000424,2750151)=EXEMPT INT/ADM. COST^^-.68^-.45^0^0
+25 SET RCFLAG=0
+26 SET TRANDA=RCTRANDA
SET DATE=RCDATE-.1
+27 FOR
SET DATE=$ORDER(RCLIST(DATE))
if 'DATE!(RCFLAG)
QUIT
FOR
SET TRANDA=$ORDER(RCLIST(DATE,TRANDA))
if 'TRANDA!(RCFLAG)
QUIT
Begin DoDot:3
+28 IF RCLIST(DATE,TRANDA)'["EXEMPT INT/ADM. COST"
QUIT
+29 ;skip exemption if it has already been matched with another interest charge
+30 if $DATA(RCEXEM(TRANDA))
QUIT
+31 ; compare interest values (p3) and admin (p4)
+32 IF +$PIECE(RCLIST(RCDATE,RCTRANDA),"^",3)'=-$PIECE(RCLIST(DATE,TRANDA),"^",3)
QUIT
+33 IF +$PIECE(RCLIST(RCDATE,RCTRANDA),"^",4)'=-$PIECE(RCLIST(DATE,TRANDA),"^",4)
QUIT
+34 ; transaction already exempted; save transaction as one already matched
+35 SET RCFLAG=1
SET RCEXEM(TRANDA)=""
End DoDot:3
IF RCFLAG
QUIT
+36 IF $GET(RCFLAG)
QUIT
+37 ;
+38 SET INTEREST=$PIECE(RCLIST(RCDATE,RCTRANDA),"^",3)
+39 SET ADMIN=$PIECE(RCLIST(RCDATE,RCTRANDA),"^",4)
+40 IF 'INTEREST
IF 'ADMIN
QUIT
+41 ;
+42 ; check to make sure the amount being exempted does not
+43 ; exceed the balance of the bill
+44 IF INTEREST>$PIECE(BILLBAL,"^",2)
QUIT
+45 IF ADMIN>$PIECE(BILLBAL,"^",3)
QUIT
+46 ;
+47 ; get the penalty charge from the transaction. this charge is computed in the
+48 ; admin value, so subtract it from admin
+49 SET PENALTY=$PIECE($GET(^PRCA(433,RCTRANDA,2)),"^",9)
+50 IF PENALTY
SET ADMIN=ADMIN-PENALTY
if ADMIN<0
SET ADMIN=0
+51 ;
+52 ; add the exempt transaction to file 433 with the date
+53 ; equal to the date the int/admin charge created
+54 SET COMMENT(1)="Auto exemption of "_RCTRANDA_", charges applied "_$SELECT(RCDATE=RCPAYDAT:"on ",1:"after ")_$$FORMATDT^RCBECHGA(RCPAYDAT)_" for Hurricane Katrina victims."
+55 ; make sure the time is entered for date processed in file 433 1;9
+56 ; if not, it will show as being out of balance on patient statement
+57 ; this was added for patch 162.
+58 ;
+59 ; patch 165 removed the process date passed so the current date
+60 ; and time would be used. this will prevent statements from
+61 ; being out of balance.
+62 ;N %,%H,%I,PROCDATE
+63 ;D NOW^%DTC S PROCDATE=$P(RCDATE,".")_"."_$P(%,".",2)
+64 SET RCEXTRAN=$$EXEMPT^RCBEUTR2(RCBILLDA,INTEREST_"^"_ADMIN_"^"_PENALTY,.COMMENT,0)
End DoDot:2
End DoDot:1
+65 QUIT
