source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEIB.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1RCBEIB ;WISC/RFJ-integrated billing entry points ;1 Jun 00
2 ;;4.5;Accounts Receivable;**157**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7CANCEL(RCBILLDA,RCCANDAT,RCCANDUZ,RCCANAMT,RCCANCOM) ; this entry point is
8 ; called when a bill is cancelled in IB
9 ; input rcbillda = ien of bill to cancel
10 ; rccandat = (optional) the date the bill was cancelled
11 ; rccanduz = (optional) the user cancelling the bill
12 ; rccanamt = (optional) amount being cancelled
13 ; rccancom = (optional) comments
14 ;
15 ; if the optional fields are passed, they will be stored in the
16 ; comment field (98) of the bill.
17 ;
18 ; returns 1 if bill is cancelled in AR
19 ; 0^error message if process fails to cancel bill in AR
20 ;
21 N ACTDATE,COMMENT,DATA,INTADM,LINE,PIECE,RCBALANC,RCDATA0,RCDATE,RCFCANC,RCLIST,RCOMMENT,RCPAYAMT,RCPAYMNT,RCTRANDA,VALUE,X,XMDUN,XMY,Y
22 ;
23 ; lock the bill
24 L +^PRCA(430,RCBILLDA):10
25 I '$T Q "0^AR bill is locked by another process"
26 ;
27 S RCDATA0=$G(^PRCA(430,RCBILLDA,0))
28 I RCDATA0="" L -^PRCA(430,RCBILLDA) Q "0^AR bill not found"
29 ;
30 ; add comments to bill
31 S RCOMMENT(1)="Bill was cancelled in IB on "_$$FMTE^XLFDT($$NOW^XLFDT)_".",LINE=2
32 S Y=$G(RCCANDAT) I Y S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),LINE=LINE+1,RCOMMENT(LINE)=" Cancel Date: "_Y
33 S Y=$G(RCCANDUZ) I Y S Y=$P($G(^VA(200,+RCCANDUZ,0)),"^"),LINE=LINE+1,RCOMMENT(LINE)=" Cancel By: "_Y
34 S Y=$G(RCCANAMT) I Y S Y=$J(Y,0,2),LINE=LINE+1,RCOMMENT(LINE)=" Cancel Amount: "_Y
35 I $G(RCCANCOM)'="" S LINE=LINE+1,RCOMMENT(LINE)=" Comments: "_RCCANCOM
36 I LINE'=2 S RCOMMENT(2)="The following information was passed from IB:"
37 D ADDCOMM^RCBEUBIL(RCBILLDA,.RCOMMENT)
38 ;
39 ; test to see if the bill is active in AR
40 S ACTDATE=$P($G(^PRCA(430,RCBILLDA,6)),"^",21)
41 ;
42 ; === bill not activated ===
43 ; set status to cancelled bill (26)
44 I 'ACTDATE D CHGSTAT^RCBEUBIL(RCBILLDA,26) L -^PRCA(430,RCBILLDA) Q 1
45 ;
46 ; === bill is activated ===
47 ;
48 ; get the balance of the bill
49 S RCBALANC=$$GETTRANS^RCDPBTLM(RCBILLDA)
50 ;
51 ; calculate payments made
52 S RCDATE="",RCPAYAMT=0,RCPAYMNT=""
53 F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE D
54 . S RCTRANDA=0
55 . F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
56 . . I RCLIST(RCDATE,RCTRANDA)'["PAYMENT" Q
57 . . F PIECE=2:1:6 D
58 . . . ; total payments
59 . . . S RCPAYAMT=RCPAYAMT+$P(RCLIST(RCDATE,RCTRANDA),"^",PIECE)
60 . . . ; total payments by prin ^ int ^ adm ^ mf ^ cc
61 . . . S $P(RCPAYMNT,"^",PIECE-1)=$P(RCPAYMNT,"^",PIECE-1)+$P(RCLIST(RCDATE,RCTRANDA),"^",PIECE)
62 ;
63 ; if the current bill status is active, cancel it
64 I $P(^PRCA(430,RCBILLDA,0),"^",8)=16!($P(^PRCA(430,RCBILLDA,0),"^",8)=42) D
65 . ; if there is a principal balance, decrease it
66 . S COMMENT(1)="Bill cancelled in IB. Automatic decrease adjustment created."
67 . I $P(RCBALANC,"^") S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,-$P(RCBALANC,"^"),.COMMENT) I 'RCTRANDA Q
68 . ;
69 . ; create an int/adm charge (minus)
70 . ; determine if there is an interest ^ admin ^ mf ^ cc charge
71 . ; set value = interest ^ admin ^ mf ^ cc (and make negative)
72 . S INTADM=0,VALUE=""
73 . F PIECE=2:1:5 S INTADM=INTADM+$P(RCBALANC,"^",PIECE),VALUE=VALUE_(-$P(RCBALANC,"^",PIECE))_"^"
74 . I INTADM S RCTRANDA=$$INTADM^RCBEUTR1(RCBILLDA,VALUE,.COMMENT) I 'RCTRANDA Q
75 . ;
76 . ; mark bill as cancellation (39)
77 . D CHGSTAT^RCBEUBIL(RCBILLDA,39)
78 ;
79 ; recheck status to see if bill was cancelled
80 ; set rcfcanc to indicate bill could not be canceled
81 S RCDATA0=$G(^PRCA(430,RCBILLDA,0))
82 I $P(RCDATA0,"^",8)'=39,$P(RCDATA0,"^",8)'=26 S RCFCANC="AR could not automatically CANCEL the bill. User action is required."
83 ;
84 ; if the bill was cancelled in AR and no payments, do not send mail
85 I $G(RCFCANC)="",'RCPAYAMT L -^PRCA(430,RCBILLDA) Q 1
86 ;
87 ;
88 ; bill could not be cancelled in AR or payments made,
89 ; send mailman message to user
90 K ^TMP($J,"RCRJRCORMM")
91 S ^TMP($J,"RCRJRCORMM",1,0)="Integrated Billing has cancelled bill "_$P(RCDATA0,"^")_"."
92 S ^TMP($J,"RCRJRCORMM",2,0)=" "
93 S ^TMP($J,"RCRJRCORMM",3,0)=" BILL: "_$P(RCDATA0,"^")_" STATUS: "_$P($G(^PRCA(430.3,+$P(^PRCA(430,RCBILLDA,0),"^",8),0)),"^")
94 S DATA=$$ACCNTHDR^RCDPAPLM($P(RCDATA0,"^",9))
95 S ^TMP($J,"RCRJRCORMM",4,0)=" ACCOUNT: "_$P(DATA,"^")_" "_$P(DATA,"^",2)
96 S ^TMP($J,"RCRJRCORMM",5,0)=" "
97 S ^TMP($J,"RCRJRCORMM",6,0)=" Principal Interest Admin"
98 S ^TMP($J,"RCRJRCORMM",7,0)=" Current Balance: "_$J($P(RCBALANC,"^"),10,2)_$J($P(RCBALANC,"^",2),10,2)_$J($P(RCBALANC,"^",3)+$P(RCBALANC,"^",4)+$P(RCBALANC,"^",5),10,2)
99 S LINE=7
100 ;
101 ; if payments made, show amount paid
102 I RCPAYAMT S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" Payments Made: "_$J(-$P(RCPAYMNT,"^"),10,2)_$J(-$P(RCPAYMNT,"^",2),10,2)_$J(-$P(RCPAYMNT,"^",3)-$P(RCPAYMNT,"^",4)-$P(RCPAYMNT,"^",5),10,2)
103 ;
104 ; if comments passed from IB, include them
105 I $D(RCOMMENT(2)) D
106 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" "
107 . F X=1:1 Q:'$D(RCOMMENT(X)) S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=RCOMMENT(X)
108 ;
109 ; if the bill could not be cancelled in AR, let user know the error
110 I $G(RCFCANC)'="" D
111 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" "
112 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
113 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=RCFCANC
114 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
115 ;
116 ; if a payment has been made, let user know it needs to be refunded
117 I RCPAYAMT D
118 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)=" "
119 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
120 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="In AR, a payment of $ "_$J(-RCPAYAMT,0,2)_" has been collected and needs to be REFUNDED."
121 . S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE,0)="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
122 ;
123 ; send report
124 S XMY("G.PRCA ADJUSTMENT TRANS")=""
125 S X=$$SENDMSG^RCRJRCOR("AR User Action Required "_$P(RCDATA0,"^"),.XMY)
126 K ^TMP($J,"RCRJRCORMM")
127 ;
128 L -^PRCA(430,RCBILLDA)
129 ;
130 Q $S($G(RCFCANC)'="":"0^"_RCFCANC,1:1)
Note: See TracBrowser for help on using the repository browser.