source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEPAYP.m@ 1211

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1RCBEPAYP ;WISC/RFJ-check and apply prepayment to bill ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7PREPAY(RCBILLDA,RCSCREEN) ; if prepayment for patient account,
8 ; apply the prepayment to the bill.
9 ; pass variables:
10 ; rcbillda = active bill that needs to be paid
11 ; rcscreen = 1 if messages should be printed on the screen
12 ;
13 ; set rcscreen to 1 to display data on screen
14 I '$D(RCSCREEN) N RCSCREEN S RCSCREEN=$S($E($G(IOST),1,2)="C-":1,1:0)
15 ;
16 I RCSCREEN W !!,"Checking for Prepayment Receivable......"
17 ;
18 N COMMENT,RCBILBAL,RCDATA0,RCDATA7,RCDEBTDA,RCERROR,RCPAYAMT,RCPREBAL,RCPREDA,RCTRANDA,RCTRVALU,Y
19 ; lock the bill
20 L +^PRCA(430,RCBILLDA):10 I '$T S RCERROR="Bill "_$P(^PRCA(430,RCBILLDA,0),"^")_" is locked by another user." D Q Q
21 ;
22 ; get the bill data
23 S RCDATA0=^PRCA(430,RCBILLDA,0)
24 ;
25 ; get the debtor and first party patient ([DPT)
26 I $P($G(^RCD(340,+$P(RCDATA0,"^",9),0)),"^")'[";DPT" D Q Q
27 S RCDEBTDA=+$P(RCDATA0,"^",9)
28 ;
29 ; lock the account to prevent updates
30 L +^RCD(340,RCDEBTDA):10 I '$T S RCERROR="Account is locked by another user." D Q Q
31 ;
32 ; if the bill is not active or open, quit
33 I $P(RCDATA0,"^",8)'=16,$P(RCDATA0,"^",8)'=42 S RCERROR="BILL STATUS IS "_$P($G(^PRCA(430.3,$P(RCDATA0,"^",8),0)),"^") D Q Q
34 I $P(RCDATA0,"^",2)=26 S RCERROR="Bill is a prepayment" D Q Q
35 ;
36 ; get the bills balance, quit if 0
37 S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
38 S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
39 I RCBILBAL'>0 S RCERROR="Bill has no outstanding balance" D Q Q
40 ;
41 ; loop open (42) bills for debtor looking for prepayments
42 S RCPREDA=0
43 F S RCPREDA=$O(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA)) Q:'RCPREDA!($G(RCERROR)'="")!(RCBILBAL'>0) D
44 . ; get the bills balance, quit if 0
45 . S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
46 . S RCBILBAL=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
47 . I $G(RCBILBAL)'>0 Q
48 . ;
49 . ; not a prepayment
50 . I $P(^PRCA(430,RCPREDA,0),"^",2)'=26 Q
51 . ; lock the prepayment
52 . L +^PRCA(430,RCPREDA):5 I '$T Q
53 . ; no balance on prepayment, cancellation(39) the prepayment
54 . S RCPREBAL=$P($G(^PRCA(430,RCPREDA,7)),"^")
55 . I 'RCPREBAL D CHGSTAT^RCBEUBIL(RCPREDA,39) L -^PRCA(430,RCPREDA) Q
56 . ; determine payment amount. set to balance of bill. if
57 . ; the prepayment amount is less, set to prepayment amount
58 . S RCPAYAMT=RCBILBAL I RCPAYAMT>RCPREBAL S RCPAYAMT=RCPREBAL
59 . ;
60 . ; post payment, pass bill ien, payment amount, receipt and
61 . ; payment number is 0 since it is being posted from a
62 . ; prepayment, payment date = today
63 . S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,0,0,DT)
64 . I 'RCTRANDA S RCERROR=$P(RCTRANDA,"^",2) L -^PRCA(430,RCPREDA) Q
65 . ;
66 . ; add comment to transaction
67 . S COMMENT(1)="Payment posted from Prepayment Receivable "_$P(^PRCA(430,RCPREDA,0),"^")
68 . D ADDCOMM^RCBEUTRA(RCTRANDA,.COMMENT)
69 . ;
70 . ; since the bill is being paid with a prepayment, set the
71 . ; incomplete transaction flag on the payment. this code
72 . ; can be removed after patch 146.
73 . S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"10////1;")
74 . ;
75 . ; get the value of the payment transaction
76 . S RCTRVALU=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5) I 'RCTRVALU L -^PRCA(430,RCPREDA) Q
77 . ;
78 . I RCSCREEN W !,?5,"... Payment of $ ",$J(RCTRVALU,8,2)," applied from prepayment ",$P(^PRCA(430,RCPREDA,0),"^"),"."
79 . ;
80 . ; decrease the prepayment by amount paid.
81 . ; pass negative amount paid to create a decrease to prepayment.
82 . ; pass 0 for date processed, the current date/time will be used.
83 . ; pass the payment transaction ien (rctranda).
84 . S COMMENT(1)="Auto decrease from Account Receivable "_$P(RCDATA0,"^")
85 . S RCTRANDA=$$INCDEC^RCBEUTR1(RCPREDA,-RCTRVALU,.COMMENT,0,RCTRANDA)
86 . ;
87 . ; clear the prepayment bill lock
88 . L -^PRCA(430,RCPREDA)
89 ;
90Q ; show error to user and unlock
91 I $G(RCERROR)'="",RCSCREEN W !,?5,"ERROR: "_RCERROR
92 I $G(RCDEBTDA) L -^RCD(340,RCDEBTDA)
93 I $G(RCBILLDA) L -^PRCA(430,RCBILLDA)
94 Q
Note: See TracBrowser for help on using the repository browser.