source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBDFST1.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.7 KB
RevLine 
[613]1RCBDFST1 ;WISC/RFJ-patient statement utilities continued ;1 Dec 00
2 ;;4.5;Accounts Receivable;**162**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7CHEKACCT(RCDEBTDA) ; check to see if a debtor is in balance
8 ; returns null if in balance, or the calculated statement
9 ; if out of balance
10 ; returns rcbilbal,rcevent,rcnewact,rcstate,rclastev
11 ; returns ^tmp("rcbdfst1",$j ... (see NEWTRANS below)
12 ;
13 N %,DATA1,OUTOFBAL
14 ; get the current balance of all active bills
15 D BILLBAL(RCDEBTDA)
16 ; get the last statement, rclastev=ien file 341 ^ statement date
17 S RCLASTEV=$$LASTEVNT(RCDEBTDA)
18 I RCLASTEV L +^RC(341,+RCLASTEV)
19 ; get the last statement balance
20 D EVENTBAL(+RCLASTEV)
21 ; get new activity after the statement date
22 D NEWTRANS(RCDEBTDA,$P(RCLASTEV,"^",2),9999999)
23 ; test for out of balance
24 ; out of balance if the statement balance +/- new activity
25 ; does not equal the current bill balance
26 S OUTOFBAL=""
27 F %="PB","IN","AD","MF","CC" D
28 . ; copy current statement to rcstate, rcstate used to track
29 . ; what the statement balance should be
30 . S RCSTATE(%)=RCEVENT(%)
31 . I RCEVENT(%)+RCNEWACT(%)=RCBILBAL(%) Q
32 . S OUTOFBAL=1
33 . S RCSTATE(%)=RCBILBAL(%)-RCNEWACT(%)
34 ; compute calculated statement total
35 S RCSTATE=0
36 F %="PB","IN","AD","MF","CC" S RCSTATE=RCSTATE+RCSTATE(%)
37 ;
38 I OUTOFBAL S OUTOFBAL=RCSTATE("PB")_"^"_RCSTATE("IN")_"^"_RCSTATE("AD")_"^"_RCSTATE("CC")_"^"_RCSTATE("MF")
39 ;
40 L -^RC(341,+RCLASTEV)
41 Q OUTOFBAL
42 ;
43 ;
44BILLBAL(DEBTDA) ; get the bill balances for a debtor
45 ; returns array RCBILBAL("PB")=principal balance
46 ; RCBILBAL("IN")=interest balance
47 ; RCBILBAL("AD")=admin balance
48 ; RCBILBAL("MF")=marshal fee balance
49 ; RCBILBAL("CC")=court cost balance
50 ; RCBILBAL =total balance
51 N %,BILLDA,DATA7,STATUS
52 ; initialize
53 S RCBILBAL=0
54 F %="PB","IN","AD","MF","CC" S RCBILBAL(%)=0
55 ;
56 ; for active, open, and refund review (for prepayments),
57 ; calc bill balance
58 F STATUS=16,42,44 S BILLDA=0 F S BILLDA=$O(^PRCA(430,"AS",DEBTDA,STATUS,BILLDA)) Q:'BILLDA D
59 . S DATA7=$P($G(^PRCA(430,BILLDA,7)),"^",1,5)
60 . ; if prepayment, subtract it from active bills principal balance
61 . I $P($G(^PRCA(430,BILLDA,0)),"^",2)=26 S RCBILBAL("PB")=RCBILBAL("PB")-$P(DATA7,"^") Q
62 . ; add balances
63 . S RCBILBAL("PB")=RCBILBAL("PB")+$P(DATA7,"^") ;principal
64 . S RCBILBAL("IN")=RCBILBAL("IN")+$P(DATA7,"^",2) ;interest
65 . S RCBILBAL("AD")=RCBILBAL("AD")+$P(DATA7,"^",3) ;admin
66 . S RCBILBAL("MF")=RCBILBAL("MF")+$P(DATA7,"^",4) ;marshal fee
67 . S RCBILBAL("CC")=RCBILBAL("CC")+$P(DATA7,"^",5) ;court cost
68 ;
69 ; compute total
70 F %="PB","IN","AD","MF","CC" S RCBILBAL=RCBILBAL+RCBILBAL(%)
71 Q
72 ;
73 ;
74NEWTRANS(DEBTDA,BEGDATE,ENDDATE) ; get new transaction activity between dates
75 ; returns global array
76 ; tmp("rcbdfst1",$j,account,transactiondate,bill,transaction)=value
77 ; where
78 ; value = ^ prin ^ int ^ admin ^ mf ^ cc
79 ;
80 N %,BILLDA,DATE,ORIGAMT,STATUS,TRANDA,VALUE
81 ; initialize
82 S RCNEWACT=0
83 F %="PB","IN","AD","MF","CC" S RCNEWACT(%)=0
84 K ^TMP("RCBDFST1",$J,DEBTDA)
85 ;
86 ; get new bills
87 S DATE=BEGDATE F S DATE=$O(^PRCA(430,"ATD",DEBTDA,DATE)) Q:'DATE!(DATE>ENDDATE) D
88 . S BILLDA=0 F S BILLDA=$O(^PRCA(430,"ATD",DEBTDA,DATE,BILLDA)) Q:'BILLDA D
89 . . S ORIGAMT=$P($G(^PRCA(430,BILLDA,0)),"^",3)
90 . . S ^TMP("RCBDFST1",$J,DEBTDA,DATE,BILLDA,0)=ORIGAMT
91 . . S RCNEWACT("PB")=RCNEWACT("PB")+ORIGAMT
92 ;
93 ; get transactions
94 S DATE=BEGDATE F S DATE=$O(^PRCA(433,"ATD",DEBTDA,DATE)) Q:'DATE!(DATE>ENDDATE) D
95 . S TRANDA=0 F S TRANDA=$O(^PRCA(433,"ATD",DEBTDA,DATE,TRANDA)) Q:'TRANDA D
96 . . ; if not a valid transaction, do not include it
97 . . I '$$VALID^RCRJRCOT(TRANDA) Q
98 . . S BILLDA=+$P(^PRCA(433,TRANDA,0),"^",2)
99 . . ; get the transaction value
100 . . S VALUE=$$TRANVALU^RCDPBTLM(TRANDA)
101 . . ; transaction has no value
102 . . I $TR(VALUE,"^0")="" Q
103 . . ; for patient statements, if the bill is a prepayment(26),
104 . . ; change the sign
105 . . I $P($G(^PRCA(430,BILLDA,0)),"^",2)=26 F %=2:1:6 S $P(VALUE,"^",%)=-$P(VALUE,"^",%)
106 . . S ^TMP("RCBDFST1",$J,DEBTDA,DATE,BILLDA,TRANDA)=VALUE
107 . . S RCNEWACT("PB")=RCNEWACT("PB")+$P(VALUE,"^",2)
108 . . S RCNEWACT("IN")=RCNEWACT("IN")+$P(VALUE,"^",3)
109 . . S RCNEWACT("AD")=RCNEWACT("AD")+$P(VALUE,"^",4)
110 . . S RCNEWACT("MF")=RCNEWACT("MF")+$P(VALUE,"^",5)
111 . . S RCNEWACT("CC")=RCNEWACT("CC")+$P(VALUE,"^",6)
112 ;
113 ; compute total
114 F %="PB","IN","AD","MF","CC" S RCNEWACT=RCNEWACT+RCNEWACT(%)
115 Q
116 ;
117 ;
118LASTEVNT(DEBTDA) ; get last type of event for debtor patient statement (2)
119 N EVENTDA,REVDATE,TYPEDA
120 ; find the inverse date of the last statement, return 0 if none
121 S TYPEDA=+$O(^RC(341.1,"AC",2,0))
122 S REVDATE=+$O(^RC(341,"AD",DEBTDA,TYPEDA,0))
123 I 'REVDATE Q 0
124 ; find the internal entry number of the statement
125 S EVENTDA=+$O(^RC(341,"AD",DEBTDA,TYPEDA,REVDATE,0))
126 ; return the internal entry number ^ last statement date
127 Q EVENTDA_"^"_(9999999.999999-REVDATE)
128 ;
129 ;
130EVENTBAL(EVENTDA) ; get the last statement balance
131 ; returns array RCEVENT("PB")=principal balance
132 ; RCEVENT("IN")=interest balance
133 ; RCEVENT("AD")=admin balance
134 ; RCEVENT("MF")=marshal fee balance
135 ; RCEVENT("CC")=court cost balance
136 ; RCEVENT =total balance
137 N %,DATA1
138 S DATA1=$G(^RC(341,EVENTDA,1))
139 S RCEVENT("PB")=$P(DATA1,"^",1) ;principal
140 S RCEVENT("IN")=$P(DATA1,"^",2) ;interest
141 S RCEVENT("AD")=$P(DATA1,"^",3) ;admin
142 S RCEVENT("CC")=$P(DATA1,"^",4) ;court cost
143 S RCEVENT("MF")=$P(DATA1,"^",5) ;marshal fee
144 ; compute total
145 S RCEVENT=0
146 F %="PB","IN","AD","MF","CC" S RCEVENT=RCEVENT+RCEVENT(%)
147 Q
Note: See TracBrowser for help on using the repository browser.