Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBECHGS

RCBECHGS.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. FIRSTPTY ; add int/admin charges to all benefit debts
  1. ; this entry point is called from CCPC on the
  1. ; statement day
  1. ; variable rclasdat passed equal to statement date
  1. ;
  1. N RCDEBTDA
  1. K ^TMP("RCBECHGS REPORT",$J) ;used to generate mailman report
  1. ;
  1. ; check statement date
  1. I +$E(RCLASDAT,6,7)'=+$P($G(^RC(342,1,0)),"^",11) Q
  1. ;
  1. ; lock the int/admin update to prevent two jobs from applying
  1. ; the charges at the same time
  1. L +^RCD(340,"RCBECHGS")
  1. ;
  1. S RCDEBTDA=0 F S RCDEBTDA=$O(^RCD(340,"AB","DPT(",RCDEBTDA)) Q:'RCDEBTDA D CHGACCT(RCDEBTDA,RCLASDAT)
  1. ;
  1. ; clear the lock
  1. L -^RCD(340,"RCBECHGS")
  1. ;
  1. ; generate mailman report showing all charges added
  1. D REPORT^RCBECHGU
  1. ;
  1. K ^TMP("RCBECHGS REPORT",$J)
  1. Q
  1. ;
  1. ;
  1. NONBENE ; add int/adm/penalty charges to all non-benefit debts
  1. ; this includes vendor, employee, ex-employee.
  1. ; this is called by prcabj. it does not update first party
  1. ; debts since they work off a set statement day where as
  1. ; non-benefit debts could be any statement day.
  1. ;
  1. N RCDEBTDA,RCLASDAT
  1. K ^TMP("RCBECHGS REPORT",$J) ;used to generate mailman report
  1. ;
  1. ; lock the int/admin update to prevent two jobs from applying
  1. ; the charges at the same time
  1. L +^RCD(340,"RCBECHGS")
  1. ;
  1. ; get the last date the system was last updated
  1. S RCLASDAT=$P($P(^RC(342,1,0),"^",10),".")
  1. ; loop all days from the last update date up to today
  1. ; this will make sure all accounts are updated for missed days
  1. F S RCLASDAT=$$FMADD^XLFDT(RCLASDAT,1) Q:RCLASDAT>DT D
  1. . S RCDEBTDA=0
  1. . F S RCDEBTDA=$O(^RCD(340,"AC",+$E(RCLASDAT,6,7),RCDEBTDA)) Q:'RCDEBTDA D
  1. . . ; do not look at first party debts here
  1. . . I $P($G(^RCD(340,RCDEBTDA,0)),"^")["DPT(" Q
  1. . . ; add int/admin to non-benefit debts
  1. . . D CHGACCT(RCDEBTDA,RCLASDAT)
  1. ;
  1. ; clear the lock
  1. L -^RCD(340,"RCBECHGS")
  1. ;
  1. ; generate mailman report showing all charges added
  1. D REPORT^RCBECHGU
  1. ;
  1. K ^TMP("RCBECHGS REPORT",$J)
  1. Q
  1. ;
  1. ;
  1. CHGACCT(RCDEBTDA,RCUPDATE) ; get bills for debtor and add charges
  1. ; for a given date in rcupdate
  1. N DAYSINT,DFN,FROMDATE,RCBILLDA,RCDATA0,RCDATA6,RCDATE,RCLASTDT,RCSTATUS,VA,VADM,VAERR,X
  1. S RCDATA0=$G(^RCD(340,RCDEBTDA,0))
  1. ; do not add charges for insurance companies
  1. I $P(RCDATA0,"^")["DIC(36" Q
  1. ; if first party and patient is dead, do not add charges
  1. I $P(RCDATA0,"^")["DPT(" S DFN=+$P(RCDATA0,"^") D DEM^VADPT I +VADM(6) Q
  1. ;If Emergency Response Indicator flag is set quit out, do not add charges.
  1. I $P(RCDATA0,"^")["DPT(",$$EMERES^PRCAUTL(+$P(RCDATA0,"^"))]"" Q
  1. ; lock the debtor to show charges being applied
  1. L +^RCD(340,RCDEBTDA)
  1. ;
  1. ; loop thru all bills in active (16) and suspended (40) status
  1. ; build a list of bills sorted by the date bill prepared
  1. K ^TMP("RCBECHGS",$J)
  1. F RCSTATUS=16,40 D
  1. . S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA)) Q:'RCBILLDA D
  1. . . ; hold letter date (field 21) is set for bill
  1. . . I $G(^PRCA(430,RCBILLDA,1)) Q
  1. . . ; no letter1 sent
  1. . . I '$G(^PRCA(430,RCBILLDA,6)) Q
  1. . . ; no principal balance
  1. . . I '$P($G(^PRCA(430,RCBILLDA,7)),"^") Q
  1. . . ; no date bill prepared
  1. . . I '$P(^PRCA(430,RCBILLDA,0),"^",10) Q
  1. . . ; bill sent to cross-servicing prca*4.5*301
  1. . . I $D(^PRCA(430,"TCSP",RCBILLDA)) Q
  1. . . ; bill automatically recalled from cross-servicing prca*4.5*301
  1. . . I $P($G(^PRCA(430,RCBILLDA,19)),"^",11) Q
  1. . . ; store the bills in date prepared order
  1. . . S ^TMP("RCBECHGS",$J,"LIST",$P(^PRCA(430,RCBILLDA,0),"^",10),RCBILLDA)=""
  1. ;
  1. ; *** calculate interest ***
  1. D INTEREST^RCBECHGI
  1. ;
  1. ; *** calculate admin ***
  1. D ADMIN^RCBECHGA
  1. ;
  1. ; *** calculate penalty ***
  1. ; penalty charges are not assessed on a first party account
  1. I $P(RCDATA0,"^")'["DPT(" D PENALTY^RCBECHGP
  1. ;
  1. ; *** add charges to bills for this account ***
  1. D ADDCHARG^RCBECHGU
  1. ;
  1. ; clear the lock on the debtor
  1. L -^RCD(340,RCDEBTDA)
  1. ;
  1. K ^TMP("RCBECHGS",$J)
  1. Q