- 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 Feb 18, 2025@23:09:06 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