| 1 | RCBECHGS ;WISC/RFJ-add charges to an account or bill (top routine) ;1 Jun 00
|
|---|
| 2 | ;;4.5;Accounts Receivable;**153,237**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | FIRSTPTY ; add int/admin charges to all benefit debts
|
|---|
| 8 | ; this entry point is called from CCPC on the
|
|---|
| 9 | ; statement day
|
|---|
| 10 | ; variable rclasdat passed equal to statement date
|
|---|
| 11 | ;
|
|---|
| 12 | N RCDEBTDA
|
|---|
| 13 | K ^TMP("RCBECHGS REPORT",$J) ;used to generate mailman report
|
|---|
| 14 | ;
|
|---|
| 15 | ; check statement date
|
|---|
| 16 | I +$E(RCLASDAT,6,7)'=+$P($G(^RC(342,1,0)),"^",11) Q
|
|---|
| 17 | ;
|
|---|
| 18 | ; lock the int/admin update to prevent two jobs from applying
|
|---|
| 19 | ; the charges at the same time
|
|---|
| 20 | L +^RCD(340,"RCBECHGS")
|
|---|
| 21 | ;
|
|---|
| 22 | S RCDEBTDA=0 F S RCDEBTDA=$O(^RCD(340,"AB","DPT(",RCDEBTDA)) Q:'RCDEBTDA D CHGACCT(RCDEBTDA,RCLASDAT)
|
|---|
| 23 | ;
|
|---|
| 24 | ; clear the lock
|
|---|
| 25 | L -^RCD(340,"RCBECHGS")
|
|---|
| 26 | ;
|
|---|
| 27 | ; generate mailman report showing all charges added
|
|---|
| 28 | D REPORT^RCBECHGU
|
|---|
| 29 | ;
|
|---|
| 30 | K ^TMP("RCBECHGS REPORT",$J)
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | NONBENE ; add int/adm/penalty charges to all non-benefit debts
|
|---|
| 35 | ; this includes vendor, employee, ex-employee.
|
|---|
| 36 | ; this is called by prcabj. it does not update first party
|
|---|
| 37 | ; debts since they work off a set statement day where as
|
|---|
| 38 | ; non-benefit debts could be any statement day.
|
|---|
| 39 | ;
|
|---|
| 40 | N RCDEBTDA,RCLASDAT
|
|---|
| 41 | K ^TMP("RCBECHGS REPORT",$J) ;used to generate mailman report
|
|---|
| 42 | ;
|
|---|
| 43 | ; lock the int/admin update to prevent two jobs from applying
|
|---|
| 44 | ; the charges at the same time
|
|---|
| 45 | L +^RCD(340,"RCBECHGS")
|
|---|
| 46 | ;
|
|---|
| 47 | ; get the last date the system was last updated
|
|---|
| 48 | S RCLASDAT=$P($P(^RC(342,1,0),"^",10),".")
|
|---|
| 49 | ; loop all days from the last update date up to today
|
|---|
| 50 | ; this will make sure all accounts are updated for missed days
|
|---|
| 51 | F S RCLASDAT=$$FMADD^XLFDT(RCLASDAT,1) Q:RCLASDAT>DT D
|
|---|
| 52 | . S RCDEBTDA=0
|
|---|
| 53 | . F S RCDEBTDA=$O(^RCD(340,"AC",+$E(RCLASDAT,6,7),RCDEBTDA)) Q:'RCDEBTDA D
|
|---|
| 54 | . . ; do not look at first party debts here
|
|---|
| 55 | . . I $P($G(^RCD(340,RCDEBTDA,0)),"^")["DPT(" Q
|
|---|
| 56 | . . ; add int/admin to non-benefit debts
|
|---|
| 57 | . . D CHGACCT(RCDEBTDA,RCLASDAT)
|
|---|
| 58 | ;
|
|---|
| 59 | ; clear the lock
|
|---|
| 60 | L -^RCD(340,"RCBECHGS")
|
|---|
| 61 | ;
|
|---|
| 62 | ; generate mailman report showing all charges added
|
|---|
| 63 | D REPORT^RCBECHGU
|
|---|
| 64 | ;
|
|---|
| 65 | K ^TMP("RCBECHGS REPORT",$J)
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | ;
|
|---|
| 69 | CHGACCT(RCDEBTDA,RCUPDATE) ; get bills for debtor and add charges
|
|---|
| 70 | ; for a given date in rcupdate
|
|---|
| 71 | N DAYSINT,DFN,FROMDATE,RCBILLDA,RCDATA0,RCDATA6,RCDATE,RCLASTDT,RCSTATUS,VA,VADM,VAERR,X
|
|---|
| 72 | S RCDATA0=$G(^RCD(340,RCDEBTDA,0))
|
|---|
| 73 | ; do not add charges for insurance companies
|
|---|
| 74 | I $P(RCDATA0,"^")["DIC(36" Q
|
|---|
| 75 | ; if first party and patient is dead, do not add charges
|
|---|
| 76 | I $P(RCDATA0,"^")["DPT(" S DFN=+$P(RCDATA0,"^") D DEM^VADPT I +VADM(6) Q
|
|---|
| 77 | ;If Emergency Response Indicator flag is set quit out, do not add charges.
|
|---|
| 78 | I $P(RCDATA0,"^")["DPT(",$$EMERES^PRCAUTL(+$P(RCDATA0,"^"))]"" Q
|
|---|
| 79 | ; lock the debtor to show charges being applied
|
|---|
| 80 | L +^RCD(340,RCDEBTDA)
|
|---|
| 81 | ;
|
|---|
| 82 | ; loop thru all bills in active (16) and suspended (40) status
|
|---|
| 83 | ; build a list of bills sorted by the date bill prepared
|
|---|
| 84 | K ^TMP("RCBECHGS",$J)
|
|---|
| 85 | F RCSTATUS=16,40 D
|
|---|
| 86 | . S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA)) Q:'RCBILLDA D
|
|---|
| 87 | . . ; hold letter date (field 21) is set for bill
|
|---|
| 88 | . . I $G(^PRCA(430,RCBILLDA,1)) Q
|
|---|
| 89 | . . ; no letter1 sent
|
|---|
| 90 | . . I '$G(^PRCA(430,RCBILLDA,6)) Q
|
|---|
| 91 | . . ; no principal balance
|
|---|
| 92 | . . I '$P($G(^PRCA(430,RCBILLDA,7)),"^") Q
|
|---|
| 93 | . . ; no date bill prepared
|
|---|
| 94 | . . I '$P(^PRCA(430,RCBILLDA,0),"^",10) Q
|
|---|
| 95 | . . ; store the bills in date prepared order
|
|---|
| 96 | . . S ^TMP("RCBECHGS",$J,"LIST",$P(^PRCA(430,RCBILLDA,0),"^",10),RCBILLDA)=""
|
|---|
| 97 | ;
|
|---|
| 98 | ; *** calculate interest ***
|
|---|
| 99 | D INTEREST^RCBECHGI
|
|---|
| 100 | ;
|
|---|
| 101 | ; *** calculate admin ***
|
|---|
| 102 | D ADMIN^RCBECHGA
|
|---|
| 103 | ;
|
|---|
| 104 | ; *** calculate penalty ***
|
|---|
| 105 | ; penalty charges are not assessed on a first party account
|
|---|
| 106 | I $P(RCDATA0,"^")'["DPT(" D PENALTY^RCBECHGP
|
|---|
| 107 | ;
|
|---|
| 108 | ; *** add charges to bills for this account ***
|
|---|
| 109 | D ADDCHARG^RCBECHGU
|
|---|
| 110 | ;
|
|---|
| 111 | ; clear the lock on the debtor
|
|---|
| 112 | L -^RCD(340,RCDEBTDA)
|
|---|
| 113 | ;
|
|---|
| 114 | K ^TMP("RCBECHGS",$J)
|
|---|
| 115 | Q
|
|---|
