source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBECHGS.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RCBECHGS ;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 ;
7FIRSTPTY ; 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 ;
34NONBENE ; 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 ;
69CHGACCT(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
Note: See TracBrowser for help on using the repository browser.