RCBECHGS ;WISC/RFJ-add charges to an account or bill (top routine) ;1 Jun 00
;;4.5;Accounts Receivable;**153,237,301**;Mar 20, 1995;Build 144
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
FIRSTPTY ; add int/admin charges to all benefit debts
; this entry point is called from CCPC on the
; statement day
; variable rclasdat passed equal to statement date
;
N RCDEBTDA
K ^TMP("RCBECHGS REPORT",$J) ;used to generate mailman report
;
; check statement date
I +$E(RCLASDAT,6,7)'=+$P($G(^RC(342,1,0)),"^",11) Q
;
; lock the int/admin update to prevent two jobs from applying
; the charges at the same time
L +^RCD(340,"RCBECHGS")
;
S RCDEBTDA=0 F S RCDEBTDA=$O(^RCD(340,"AB","DPT(",RCDEBTDA)) Q:'RCDEBTDA D CHGACCT(RCDEBTDA,RCLASDAT)
;
; clear the lock
L -^RCD(340,"RCBECHGS")
;
; generate mailman report showing all charges added
D REPORT^RCBECHGU
;
K ^TMP("RCBECHGS REPORT",$J)
Q
;
;
NONBENE ; add int/adm/penalty charges to all non-benefit debts
; this includes vendor, employee, ex-employee.
; this is called by prcabj. it does not update first party
; debts since they work off a set statement day where as
; non-benefit debts could be any statement day.
;
N RCDEBTDA,RCLASDAT
K ^TMP("RCBECHGS REPORT",$J) ;used to generate mailman report
;
; lock the int/admin update to prevent two jobs from applying
; the charges at the same time
L +^RCD(340,"RCBECHGS")
;
; get the last date the system was last updated
S RCLASDAT=$P($P(^RC(342,1,0),"^",10),".")
; loop all days from the last update date up to today
; this will make sure all accounts are updated for missed days
F S RCLASDAT=$$FMADD^XLFDT(RCLASDAT,1) Q:RCLASDAT>DT D
. S RCDEBTDA=0
. F S RCDEBTDA=$O(^RCD(340,"AC",+$E(RCLASDAT,6,7),RCDEBTDA)) Q:'RCDEBTDA D
. . ; do not look at first party debts here
. . I $P($G(^RCD(340,RCDEBTDA,0)),"^")["DPT(" Q
. . ; add int/admin to non-benefit debts
. . D CHGACCT(RCDEBTDA,RCLASDAT)
;
; clear the lock
L -^RCD(340,"RCBECHGS")
;
; generate mailman report showing all charges added
D REPORT^RCBECHGU
;
K ^TMP("RCBECHGS REPORT",$J)
Q
;
;
CHGACCT(RCDEBTDA,RCUPDATE) ; get bills for debtor and add charges
; for a given date in rcupdate
N DAYSINT,DFN,FROMDATE,RCBILLDA,RCDATA0,RCDATA6,RCDATE,RCLASTDT,RCSTATUS,VA,VADM,VAERR,X
S RCDATA0=$G(^RCD(340,RCDEBTDA,0))
; do not add charges for insurance companies
I $P(RCDATA0,"^")["DIC(36" Q
; if first party and patient is dead, do not add charges
I $P(RCDATA0,"^")["DPT(" S DFN=+$P(RCDATA0,"^") D DEM^VADPT I +VADM(6) Q
;If Emergency Response Indicator flag is set quit out, do not add charges.
I $P(RCDATA0,"^")["DPT(",$$EMERES^PRCAUTL(+$P(RCDATA0,"^"))]"" Q
; lock the debtor to show charges being applied
L +^RCD(340,RCDEBTDA)
;
; loop thru all bills in active (16) and suspended (40) status
; build a list of bills sorted by the date bill prepared
K ^TMP("RCBECHGS",$J)
F RCSTATUS=16,40 D
. S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA)) Q:'RCBILLDA D
. . ; hold letter date (field 21) is set for bill
. . I $G(^PRCA(430,RCBILLDA,1)) Q
. . ; no letter1 sent
. . I '$G(^PRCA(430,RCBILLDA,6)) Q
. . ; no principal balance
. . I '$P($G(^PRCA(430,RCBILLDA,7)),"^") Q
. . ; no date bill prepared
. . I '$P(^PRCA(430,RCBILLDA,0),"^",10) Q
. . ; bill sent to cross-servicing prca*4.5*301
. . I $D(^PRCA(430,"TCSP",RCBILLDA)) Q
. . ; bill automatically recalled from cross-servicing prca*4.5*301
. . I $P($G(^PRCA(430,RCBILLDA,19)),"^",11) Q
. . ; store the bills in date prepared order
. . S ^TMP("RCBECHGS",$J,"LIST",$P(^PRCA(430,RCBILLDA,0),"^",10),RCBILLDA)=""
;
; *** calculate interest ***
D INTEREST^RCBECHGI
;
; *** calculate admin ***
D ADMIN^RCBECHGA
;
; *** calculate penalty ***
; penalty charges are not assessed on a first party account
I $P(RCDATA0,"^")'["DPT(" D PENALTY^RCBECHGP
;
; *** add charges to bills for this account ***
D ADDCHARG^RCBECHGU
;
; clear the lock on the debtor
L -^RCD(340,RCDEBTDA)
;
K ^TMP("RCBECHGS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGS 4298 printed Dec 13, 2024@01:42:43 Page 2
RCBECHGS ;WISC/RFJ-add charges to an account or bill (top routine) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,237,301**;Mar 20, 1995;Build 144
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
FIRSTPTY ; add int/admin charges to all benefit debts
+1 ; this entry point is called from CCPC on the
+2 ; statement day
+3 ; variable rclasdat passed equal to statement date
+4 ;
+5 NEW RCDEBTDA
+6 ;used to generate mailman report
KILL ^TMP("RCBECHGS REPORT",$JOB)
+7 ;
+8 ; check statement date
+9 IF +$EXTRACT(RCLASDAT,6,7)'=+$PIECE($GET(^RC(342,1,0)),"^",11)
QUIT
+10 ;
+11 ; lock the int/admin update to prevent two jobs from applying
+12 ; the charges at the same time
+13 LOCK +^RCD(340,"RCBECHGS")
+14 ;
+15 SET RCDEBTDA=0
FOR
SET RCDEBTDA=$ORDER(^RCD(340,"AB","DPT(",RCDEBTDA))
if 'RCDEBTDA
QUIT
DO CHGACCT(RCDEBTDA,RCLASDAT)
+16 ;
+17 ; clear the lock
+18 LOCK -^RCD(340,"RCBECHGS")
+19 ;
+20 ; generate mailman report showing all charges added
+21 DO REPORT^RCBECHGU
+22 ;
+23 KILL ^TMP("RCBECHGS REPORT",$JOB)
+24 QUIT
+25 ;
+26 ;
NONBENE ; add int/adm/penalty charges to all non-benefit debts
+1 ; this includes vendor, employee, ex-employee.
+2 ; this is called by prcabj. it does not update first party
+3 ; debts since they work off a set statement day where as
+4 ; non-benefit debts could be any statement day.
+5 ;
+6 NEW RCDEBTDA,RCLASDAT
+7 ;used to generate mailman report
KILL ^TMP("RCBECHGS REPORT",$JOB)
+8 ;
+9 ; lock the int/admin update to prevent two jobs from applying
+10 ; the charges at the same time
+11 LOCK +^RCD(340,"RCBECHGS")
+12 ;
+13 ; get the last date the system was last updated
+14 SET RCLASDAT=$PIECE($PIECE(^RC(342,1,0),"^",10),".")
+15 ; loop all days from the last update date up to today
+16 ; this will make sure all accounts are updated for missed days
+17 FOR
SET RCLASDAT=$$FMADD^XLFDT(RCLASDAT,1)
if RCLASDAT>DT
QUIT
Begin DoDot:1
+18 SET RCDEBTDA=0
+19 FOR
SET RCDEBTDA=$ORDER(^RCD(340,"AC",+$EXTRACT(RCLASDAT,6,7),RCDEBTDA))
if 'RCDEBTDA
QUIT
Begin DoDot:2
+20 ; do not look at first party debts here
+21 IF $PIECE($GET(^RCD(340,RCDEBTDA,0)),"^")["DPT("
QUIT
+22 ; add int/admin to non-benefit debts
+23 DO CHGACCT(RCDEBTDA,RCLASDAT)
End DoDot:2
End DoDot:1
+24 ;
+25 ; clear the lock
+26 LOCK -^RCD(340,"RCBECHGS")
+27 ;
+28 ; generate mailman report showing all charges added
+29 DO REPORT^RCBECHGU
+30 ;
+31 KILL ^TMP("RCBECHGS REPORT",$JOB)
+32 QUIT
+33 ;
+34 ;
CHGACCT(RCDEBTDA,RCUPDATE) ; get bills for debtor and add charges
+1 ; for a given date in rcupdate
+2 NEW DAYSINT,DFN,FROMDATE,RCBILLDA,RCDATA0,RCDATA6,RCDATE,RCLASTDT,RCSTATUS,VA,VADM,VAERR,X
+3 SET RCDATA0=$GET(^RCD(340,RCDEBTDA,0))
+4 ; do not add charges for insurance companies
+5 IF $PIECE(RCDATA0,"^")["DIC(36"
QUIT
+6 ; if first party and patient is dead, do not add charges
+7 IF $PIECE(RCDATA0,"^")["DPT("
SET DFN=+$PIECE(RCDATA0,"^")
DO DEM^VADPT
IF +VADM(6)
QUIT
+8 ;If Emergency Response Indicator flag is set quit out, do not add charges.
+9 IF $PIECE(RCDATA0,"^")["DPT("
IF $$EMERES^PRCAUTL(+$PIECE(RCDATA0,"^"))]""
QUIT
+10 ; lock the debtor to show charges being applied
+11 LOCK +^RCD(340,RCDEBTDA)
+12 ;
+13 ; loop thru all bills in active (16) and suspended (40) status
+14 ; build a list of bills sorted by the date bill prepared
+15 KILL ^TMP("RCBECHGS",$JOB)
+16 FOR RCSTATUS=16,40
Begin DoDot:1
+17 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+18 ; hold letter date (field 21) is set for bill
+19 IF $GET(^PRCA(430,RCBILLDA,1))
QUIT
+20 ; no letter1 sent
+21 IF '$GET(^PRCA(430,RCBILLDA,6))
QUIT
+22 ; no principal balance
+23 IF '$PIECE($GET(^PRCA(430,RCBILLDA,7)),"^")
QUIT
+24 ; no date bill prepared
+25 IF '$PIECE(^PRCA(430,RCBILLDA,0),"^",10)
QUIT
+26 ; bill sent to cross-servicing prca*4.5*301
+27 IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
QUIT
+28 ; bill automatically recalled from cross-servicing prca*4.5*301
+29 IF $PIECE($GET(^PRCA(430,RCBILLDA,19)),"^",11)
QUIT
+30 ; store the bills in date prepared order
+31 SET ^TMP("RCBECHGS",$JOB,"LIST",$PIECE(^PRCA(430,RCBILLDA,0),"^",10),RCBILLDA)=""
End DoDot:2
End DoDot:1
+32 ;
+33 ; *** calculate interest ***
+34 DO INTEREST^RCBECHGI
+35 ;
+36 ; *** calculate admin ***
+37 DO ADMIN^RCBECHGA
+38 ;
+39 ; *** calculate penalty ***
+40 ; penalty charges are not assessed on a first party account
+41 IF $PIECE(RCDATA0,"^")'["DPT("
DO PENALTY^RCBECHGP
+42 ;
+43 ; *** add charges to bills for this account ***
+44 DO ADDCHARG^RCBECHGU
+45 ;
+46 ; clear the lock on the debtor
+47 LOCK -^RCD(340,RCDEBTDA)
+48 ;
+49 KILL ^TMP("RCBECHGS",$JOB)
+50 QUIT
