RCBECHGS ;WISC/RFJ-add charges to an account or bill (top routine) ;1 Jun 00 ;;4.5;Accounts Receivable;**153,237**;Mar 20, 1995 ;;Per VHA Directive 10-93-142, 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 . . ; 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