source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRCOB.m@ 949

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1RCRJRCOB ;WISC/RFJ-calculate a bills balance ;1 Mar 97
2 ;;4.5;Accounts Receivable;**68,96,103,153,156**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7BILLBAL(BILLDA,DATEEND) ; find bills balance on dateend
8 ; returns principal ^ interest ^ admin ^ mf ^ cc
9 N ACTDATE,ADMIN,CC,DATA1,DATA7,INTEREST,LASTTRAN,MF,PRINBAL,TRANDA,TYPE,VALUE
10 ;
11 ; bill activated after dateend
12 S ACTDATE=$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".")
13 I 'ACTDATE!(ACTDATE>DATEEND) Q "^^^^"
14 ;
15 ; this lock cannot fail and must be executed to prevent bill
16 ; activity during the calculation of the bills balance
17 L +^PRCA(430,BILLDA)
18 ;
19 ; try and find last 433 transaction
20 S LASTTRAN=999999999999 F S LASTTRAN=$O(^PRCA(433,"C",BILLDA,LASTTRAN),-1) Q:'LASTTRAN S DATA1=$G(^PRCA(433,LASTTRAN,1)) I $P($P(DATA1,"^",9),".")'>DATEEND,$P(DATA1,"^",2)'=45 Q
21 ;
22 ; there are no transactions in file 433
23 I 'LASTTRAN D G UNLOCK
24 . S PRINBAL=+$P($G(^PRCA(430,BILLDA,0)),"^",3)
25 . S (INTEREST,ADMIN,MF,CC)=0
26 ;
27 ; the last transaction may not be in date order
28 S TRANDA=LASTTRAN F S TRANDA=$O(^PRCA(433,"C",BILLDA,TRANDA)) Q:'TRANDA I $P($P($G(^PRCA(433,TRANDA,1)),"^",9),".")'>DATEEND S LASTTRAN=TRANDA
29 ;
30 ; the last transaction was during time period, use bill balance
31 I '$O(^PRCA(433,"C",BILLDA,LASTTRAN)) D G UNLOCK
32 . S DATA7=$G(^PRCA(430,BILLDA,7))
33 . S PRINBAL=+$P(DATA7,"^")
34 . S INTEREST=+$P(DATA7,"^",2)
35 . S ADMIN=$P(DATA7,"^",3)
36 . S MF=$P(DATA7,"^",4)
37 . S CC=$P(DATA7,"^",5)
38 ;
39 ; calculate balance
40 S DATA7=$G(^PRCA(430,BILLDA,7))
41 S PRINBAL=+$P(DATA7,"^")
42 S INTEREST=+$P(DATA7,"^",2)
43 S ADMIN=$P(DATA7,"^",3)
44 S MF=$P(DATA7,"^",4)
45 S CC=$P(DATA7,"^",5)
46 ;
47 ; if the bill's status is write-off, balance and int = 0
48 I $P($G(^PRCA(430,BILLDA,0)),"^",8)=23 S (PRINBAL,INTEREST,ADMIN,MF,CC)=0
49 ;
50 S TRANDA=LASTTRAN
51 F S TRANDA=$O(^PRCA(433,"C",BILLDA,TRANDA)) Q:'TRANDA I $P($G(^PRCA(433,TRANDA,0)),"^",4)=2 D
52 . S VALUE=$$TRANBAL^RCRJRCOT(TRANDA) I VALUE="" Q
53 . ;
54 . S TYPE=$P($G(^PRCA(433,TRANDA,1)),"^",2)
55 . I TYPE=1!(TYPE=12)!(TYPE=13)!(TYPE=43) D Q
56 . . S PRINBAL=PRINBAL-$P(VALUE,"^")
57 . . S INTEREST=INTEREST-$P(VALUE,"^",2)
58 . . S ADMIN=ADMIN-$P(VALUE,"^",3)
59 . . S MF=MF-$P(VALUE,"^",4)
60 . . S CC=CC-$P(VALUE,"^",5)
61 . I TYPE=2!(TYPE=8)!(TYPE=9)!(TYPE=10)!(TYPE=11)!(TYPE=14)!(TYPE=29)!(TYPE=34)!(TYPE=35)!(TYPE=41) D Q
62 . . S PRINBAL=PRINBAL+$P(VALUE,"^")
63 . . S INTEREST=INTEREST+$P(VALUE,"^",2)
64 . . S ADMIN=ADMIN+$P(VALUE,"^",3)
65 . . S MF=MF+$P(VALUE,"^",4)
66 . . S CC=CC+$P(VALUE,"^",5)
67 ;
68 ; do not allow balances to be negative
69 I PRINBAL<0 S PRINBAL=0
70 ; for transaction type 2,9,14, admin could not be broken out separate
71 ; if its negative, add it to interest
72 I ADMIN<0 S INTEREST=INTEREST+ADMIN,ADMIN=0
73 I INTEREST<0 S ADMIN=ADMIN+INTEREST,INTEREST=0
74 ;
75UNLOCK ; come here to unlock global and return results
76 L -^PRCA(430,BILLDA)
77 ;
78 Q PRINBAL_"^"_INTEREST_"^"_ADMIN_"^"_MF_"^"_CC
79 ;
80 ;
81CURRENT(BILLDA,DATEEND,AYEAROLD) ; finds a bills balance and age
82 N DA,DATA4,COUNTCUR,CURRAMT,FUTURAMT,INTEREST,NONCURR,PRINBAL,RCVALUE,TOTREPAY
83 ;
84 ; find a bills balance
85 S RCVALUE=$$BILLBAL(BILLDA,DATEEND)
86 ;
87 ; count as a current receivable
88 D CURRENT^RCRJRCOC(BILLDA,RCVALUE)
89 ;
90 S PRINBAL=$P(RCVALUE,"^"),INTEREST=$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
91 ; if no repay plan date or its greater than date range or no amt due
92 S DATA4=$G(^PRCA(430,BILLDA,4))
93 I '$P(DATA4,"^")!($P($P(DATA4,"^"),".")>DATEEND)!('$P(DATA4,"^",3)) D SETTOTAL^RCRJRCO1(2,PRINBAL,INTEREST),AGE Q
94 ;
95 ; total number of repayment due dates
96 S TOTREPAY=$P($G(^PRCA(430,BILLDA,5,0)),"^",3)
97 I 'TOTREPAY D SETTOTAL^RCRJRCO1(2,PRINBAL,INTEREST),AGE Q
98 ;
99 ; count the number of current repayments (less than yr old)
100 S DA=0 F COUNTCUR=0:1 S DA=$O(^PRCA(430,BILLDA,5,DA)) Q:'DA!($P($G(^(DA,0)),"^")>AYEAROLD)
101 ;
102 ; how many repayments are non-current
103 S NONCURR=TOTREPAY-COUNTCUR
104 ; all are current
105 I 'NONCURR D SETTOTAL^RCRJRCO1(2,PRINBAL,INTEREST),AGE Q
106 ;
107 ; future amount = noncurrent bills * repayment amount due
108 S FUTURAMT=NONCURR*$P(DATA4,"^",3),CURRAMT=PRINBAL-FUTURAMT
109 ; no current amt (all future)
110 I 'CURRAMT D SETTOTAL^RCRJRCO1(12,FUTURAMT,INTEREST),AGE Q
111 ;
112 D SETTOTAL^RCRJRCO1(2,CURRAMT,INTEREST)
113 D SETTOTAL^RCRJRCO1(12,FUTURAMT,0)
114 D AGE
115 Q
116 ;
117 ;
118AGE ; finds the age of delinquents
119 ; the date the 2nd letter was sent
120 N DAYSDIFF,LETRDATE
121 S LETRDATE=$P($P($G(^PRCA(430,BILLDA,6)),"^",2),".")
122 I 'LETRDATE!(LETRDATE>DATEEND) Q
123 ;
124 S DAYSDIFF=$$FMDIFF^XLFDT(DATEEND,LETRDATE,1)
125 ; pass criteria 2 based on days difference
126 D SETTOTAL^RCRJRCO1($S(DAYSDIFF<31:3,DAYSDIFF<61:4,DAYSDIFF<91:5,DAYSDIFF<121:6,DAYSDIFF<181:7,DAYSDIFF<366:8,DAYSDIFF<731:9,DAYSDIFF<1096:10,1:11),PRINBAL,INTEREST)
127 Q
Note: See TracBrowser for help on using the repository browser.