source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEUTR1.m@ 1166

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

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1RCBEUTR1 ;WISC/RFJ-add int,admin chg or increase,decrease principal ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153,169,192,226**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7INTADM(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE) ; add an intererst/admin charge (transaction type=13)
8 ; for a bill. rcvalue = interest ^ admin ^ penalty ^ marshal fee ^ court cost
9 ; for the transaction. rcdate = process date (optional)
10 ; returns transaction number if successful
11 ;
12 N RCDRSTRG,RCTRANDA,Y
13 ; add the transaction (if added to 433, transaction is locked)
14 S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,13) I 'RCTRANDA Q 0
15 ;
16 ; build dr string
17 ; transaction date (strip off time)
18 S RCDRSTRG="11////"_$S($G(RCDATE):$P(RCDATE,"."),1:DT)_";"
19 ;
20 ; transaction values
21 S RCDRSTRG=RCDRSTRG_"15////"_($P(RCVALUE,"^")+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5))_";"
22 I $P(RCVALUE,"^",4) S RCDRSTRG=RCDRSTRG_"25////"_$P(RCVALUE,"^",4)_";" ;marshal fee
23 I $P(RCVALUE,"^",5) S RCDRSTRG=RCDRSTRG_"26////"_$P(RCVALUE,"^",5)_";" ;court cost
24 I $P(RCVALUE,"^",1) S RCDRSTRG=RCDRSTRG_"27////"_$P(RCVALUE,"^",1)_";" ;interest
25 I $P(RCVALUE,"^",2) S RCDRSTRG=RCDRSTRG_"28////"_$P(RCVALUE,"^",2)_";" ;admin
26 I $P(RCVALUE,"^",3) S RCDRSTRG=RCDRSTRG_"29////"_$P(RCVALUE,"^",3)_";" ;penalty
27 I $G(RCDATE) S RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";" ;date entered
28 ;
29 ; input the fields for the transaction
30 S Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG) I 'Y L -^PRCA(433,RCTRANDA) Q 0
31 ;
32 ; set the comment
33 I $D(RCCOMMNT(1)) D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
34 ;
35 ; move over 433 from 430 (no principal, just move it)
36 D FY433^RCBEUTRA(RCTRANDA)
37 ;
38 ; mark transaction as processed
39 D PROCESS^RCBEUTRA(RCTRANDA)
40 ;
41 ; update the bill file with the balance of the transaction
42 D SETBAL^RCBEUBIL(RCTRANDA)
43 ;
44 ; if the bill has no balance, close or cancel it
45 D CLOSEIT(RCBILLDA)
46 ;
47 ; clear the lock and return the transaction added
48 L -^PRCA(433,RCTRANDA)
49 Q RCTRANDA
50 ;
51INCDEC(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCPREPAY,RCONTADJ) ; automatically
52 ; create an increase or decrease adjustment for a bill
53 ; pass variables:
54 ; rcvalue = principal value for the transaction.
55 ; if rcvalue is less than zero, it will create a
56 ; decrease adjustment. if rcvalue is greater than
57 ; zero, it will create an increase adjustment.
58 ; rccommnt = the comments for the word processing field.
59 ; rcdate = optional processing date and time. if not
60 ; passed, the current date and time will be used
61 ; rcprepay = optional prepayment transaction. this is the
62 ; payment transaction applied to the bill to
63 ; create the decrease adjustment. this gets
64 ; stored in field 20 (file 433).
65 ; rcontadj = optional contract adjustment. if 1 then this
66 ; gets stored in field 88 (file 433).
67 ;
68 ; returns transaction number added to 433 if successful.
69 ;
70 N ADJNUMB,RCDRSTRG,RCTRANDA,X,Y
71 ;
72 ; add the transaction (if added to 433, transaction is locked)
73 S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,$S(RCVALUE>0:1,1:35)) I 'RCTRANDA Q 0
74 ;
75 ; build dr string
76 ; 11=transaction date (strip off time)
77 S RCDRSTRG="11////"_$S($G(RCDATE):$P(RCDATE,"."),1:DT)_";"
78 ; transaction value (make sure it is not negative)
79 I RCVALUE<0 S RCVALUE=-RCVALUE
80 S RCDRSTRG=RCDRSTRG_"15////"_RCVALUE_";"
81 S RCDRSTRG=RCDRSTRG_"81////"_RCVALUE_";"
82 ;
83 ; get the next adjustment number if increase(1) or decrease(35)
84 ; start with the last transaction and work backwards
85 S X=999999999999,ADJNUMB=1
86 F S X=$O(^PRCA(433,"C",RCBILLDA,X),-1) Q:'X I $P($G(^PRCA(433,X,1)),"^",4) I $P(^(1),"^",2)=1!($P(^(1),"^",2)=35) S ADJNUMB=$P(^(1),"^",4)+1 Q
87 S RCDRSTRG=RCDRSTRG_"14////"_ADJNUMB_";"
88 ;
89 ; date entered
90 I $G(RCDATE) S RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";"
91 ;
92 ; store the prepayment transaction
93 I $G(RCPREPAY) D
94 . S RCDRSTRG=RCDRSTRG_"20////"_RCPREPAY_";"
95 . ; for prepayments, set the incomplete transaction flag
96 . ; this will no longer be used after patch 146 and can
97 . ; be removed
98 . S RCDRSTRG=RCDRSTRG_"10////1;"
99 ;
100 ; contract adjustment
101 I $G(RCONTADJ) S RCDRSTRG=RCDRSTRG_"88///1;"
102 ;
103 ; input the fields for the transaction
104 S Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG) I 'Y L -^PRCA(433,RCTRANDA) Q 0
105 ;
106 ; set the comment
107 I $D(RCCOMMNT(1)) D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
108 ;
109 ; mark the transaction processed
110 D PROCESS^RCBEUTRA(RCTRANDA)
111 ;
112 ; update the fiscal year multiple (must be done after marked as
113 ; processed so the value is defined)
114 D FYMULT^RCBEUTRA(RCTRANDA)
115 ;
116 ; update the bill file with the balance of the transaction
117 D SETBAL^RCBEUBIL(RCTRANDA)
118 ;
119 ; if the bill has no balance, close or cancel it
120 D CLOSEIT(RCBILLDA)
121 ;
122 ; send FMS document if non-accrued (redo this later on)
123 I '$$ACCK^PRCAACC(RCBILLDA) D
124 . N D0,DA,DI,DIC,DIE,DIQ2,DQ,DR,ENT,FMSNUM,GECSDATA
125 . N CATEG,DATA1,ERR
126 . S CATEG=$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
127 . ;
128 . ; category=29 champva, do not send to fms, quit
129 . I CATEG=29 Q
130 . ;
131 . ; category=30 tricare or 32 tricare third party, and contract adj
132 . I (CATEG=30!(CATEG=32)),$P($G(^PRCA(433,RCTRANDA,8)),"^",8) D Q
133 . . S DATA1=$G(^PRCA(433,RCTRANDA,1))
134 . . D EN^PRCAFWO(RCBILLDA,$P(DATA1,"^",1),$P(DATA1,"^",5),$$SITE^RCMSITE,RCTRANDA)
135 . ;
136 . ; all other categories
137 . ; pass trans amount(1;5),trans type(1;2),trans date(1;1)
138 . S DATA1=$G(^PRCA(433,RCTRANDA,1))
139 . D EN^PRCAFBDM(RCBILLDA,$P(DATA1,"^",5),$P(DATA1,"^",2),$P(DATA1,"^",1),RCTRANDA,.ERR)
140 ;
141 ; clear the lock and return the transaction added
142 L -^PRCA(433,RCTRANDA)
143 Q RCTRANDA
144 ;
145 ;
146CLOSEIT(RCBILLDA) ; check to cancel or close bill with no balance
147 N AMTPAID,BILLBAL,DATA7,TRANDA
148 ; if the bill has no balance, close or cancel it
149 S DATA7=$G(^PRCA(430,RCBILLDA,7))
150 S BILLBAL=$P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5)
151 I 'BILLBAL D
152 . ; get payments recorded against the bill. if payments have been
153 . ; made, then the status of the bill should be collected/closed.
154 . S AMTPAID=$P(DATA7,"^",7)+$P(DATA7,"^",8)+$P(DATA7,"^",9)+$P(DATA7,"^",10)+$P(DATA7,"^",11)
155 . I AMTPAID D CHGSTAT^RCBEUBIL(RCBILLDA,22) Q
156 . ; if the last transaction was a decrease contract adjustment,
157 . ; then the status will be collected/closed
158 . S TRANDA=+$O(^PRCA(433,"C",RCBILLDA,999999999999),-1)
159 . I $P($G(^PRCA(433,TRANDA,8)),"^",8) D CHGSTAT^RCBEUBIL(RCBILLDA,22) Q
160 . ; otherwise it should be cancellation
161 . D CHGSTAT^RCBEUBIL(RCBILLDA,39)
162 Q
Note: See TracBrowser for help on using the repository browser.