- RCEXINAD ;ALB/MAF - Exempt int/admin for Katrina victims from 9/1/05 - patch install;3 Oct 05
- ;;4.5;Accounts Receivable;**237,241**;Mar 20, 1995
- ;;
- ;
- START ;
- N ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF,RCDFN,DATEEND,RCDEB,X
- ; 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
- . . . Q:$P($G(^RCD(340,+RCDEB,0)),"^",8) ; already exempted
- . . . S ^TMP("RCINTADM",$J,RCDFN,BILLDA)=""
- . . . Q
- I '$D(^TMP("RCINTADM",$J)) 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)
- 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[HRCEXINAD 5041 printed Feb 18, 2025@23:13:13 Page 2
- RCEXINAD ;ALB/MAF - Exempt int/admin for Katrina victims from 9/1/05 - patch install;3 Oct 05
- +1 ;;4.5;Accounts Receivable;**237,241**;Mar 20, 1995
- +2 ;;
- +3 ;
- START ;
- +1 NEW ADMIN,BILLDA,DATE,INTEREST,PRINBAL,TRANDA,TRANTYPE,VALUE,RCNOHSIF,RCDFN,DATEEND,RCDEB,X
- +2 ; needs datebeg, dateend
- +3 ; total is total by category
- +4 ;
- +5 ;
- +6 ; no HSIF (disabled)
- SET RCNOHSIF=$$NOHSIF^RCRJRCO()
- +7 ;
- +8 KILL ^TMP("RCINTADM",$JOB)
- +9 FOR TRANTYPE=13
- Begin DoDot:1
- +10 SET DATE=3050901-1
- SET DATEEND=9999999
- +11 FOR
- SET DATE=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE))
- if 'DATE!(DATE>DATEEND)
- QUIT
- Begin DoDot:2
- +12 SET TRANDA=0
- +13 FOR
- SET TRANDA=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE,TRANDA))
- if 'TRANDA
- QUIT
- Begin DoDot:3
- +14 SET BILLDA=+$PIECE($GET(^PRCA(433,TRANDA,0)),"^",2)
- IF 'BILLDA
- QUIT
- +15 ; bill not linked to a site
- +16 IF '$PIECE($GET(^PRCA(430,BILLDA,0)),"^",12)
- QUIT
- +17 SET RCDEB=$PIECE($GET(^PRCA(430,BILLDA,0)),"^",9)
- if '+RCDEB
- QUIT
- Begin DoDot:4
- +18 SET RCDFN=0
- +19 if $PIECE($GET(^RCD(340,+RCDEB,0)),"^",1)'["DPT"
- QUIT
- +20 SET RCDFN=+$PIECE($GET(^RCD(340,+RCDEB,0)),"^",1)
- +21 QUIT
- End DoDot:4
- if '+RCDFN
- QUIT
- +22 ;Check if emergency response victim
- +23 IF $$EMERES^PRCAUTL(+RCDFN)']""
- QUIT
- +24 ; already exempted
- if $PIECE($GET(^RCD(340,+RCDEB,0)),"^",8)
- QUIT
- +25 SET ^TMP("RCINTADM",$JOB,RCDFN,BILLDA)=""
- +26 QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 IF '$DATA(^TMP("RCINTADM",$JOB))
- QUIT
- +28 NEW BILLDA,RCDFN,PAYDAT
- +29 SET (RCDFN,BILLDA)=0
- SET PAYDAT=3050901
- +30 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)
- +31 QUIT
- +32 ;
- +33 ;
- 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