source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPURED.m@ 1261

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

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1RCDPURED ;WISC/RFJ-file 344 receipt/payment dd calls ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,169,174,196,202,244**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7 ; ***** dd references from file 344 (receipts) *****
8 ;
9 ;
10DUPLCATE ; called by input transform receipt number (.01)
11 ; make sure no duplicate receipt numbers
12 I $O(^RCY(344,"B",X,"")) K X W !,"This is a duplicate receipt number." Q
13 I $O(^PRCA(433,"AF",X,"")) K X W !,"This receipt number has already been used and has been purged from the system. " K X
14 Q
15 ;
16 ;
17PAYCOUNT(RCRECTDA) ; called by computed field number of transactions (101)
18 ; return the count of payments for the receipt
19 N COUNT,X
20 S COUNT=0
21 S X=0 F S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X S COUNT=COUNT+1
22 Q COUNT
23 ;
24 ;
25PAYTOTAL(RCRECTDA) ; called by computed field total amount of receipts (.15)
26 ; return the total dollars for payments entered for the receipt
27 N TOTAL,X
28 S TOTAL=0
29 S X=0 F S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X S TOTAL=TOTAL+$P($G(^(X,0)),"^",4)
30 Q TOTAL
31 ;
32 ;
33 ; ***** dd references from sub-file 344.01 (transactions) *****
34 ;
35 ;
36CHGAMT ; called from the input transform on the transaction amount (.04)
37 ; field. if the amount is changed, this will create a new cancelled
38 ; transaction showing the original amount before the change.
39 N ORIGDATA,TRANDA
40 S ORIGDATA=^RCY(344,DA(1),1,DA,0)
41 ; no original payment amount
42 I '$P(ORIGDATA,"^",4) Q
43 ; payment amount did not change
44 I +$P(ORIGDATA,"^",4)=+X Q
45 ; payment amount increased
46 I $P(ORIGDATA,"^",4)<X Q
47 ; amount was changed
48 ; enter a new transaction
49 S TRANDA=$$ADDTRAN^RCDPURET(DA(1))
50 I 'TRANDA W !," Unable to edit amount." K X Q
51 ; copy the current data for the transaction
52 ; do not use fileman, will overwrite variables
53 ; set the cancel comment (field 1.01)
54 S $P(^RCY(344,DA(1),1,TRANDA,1),"^")="Amount $"_$P(ORIGDATA,"^",4)_" decreased in original trans#"_DA
55 ; set the payment amount to zero (for cancelled)
56 S $P(ORIGDATA,"^",4)=0
57 S $P(ORIGDATA,"^",14)=DUZ
58 S $P(^RCY(344,DA(1),1,TRANDA,0),"^",2,99)=$P(ORIGDATA,"^",2,99)
59 Q
60 ;
61 ;
62PAYCHK ; called from the input transform on the transaction amount (.04)
63 ; field. This will compare the amount paid with the amount owed
64 ; for a bill.
65 N ACCOUNT,AMOUNT,OWED
66 S ACCOUNT=$P($G(^RCY(344,DA(1),1,DA,0)),"^",3)
67 ; quit, account not a bill
68 I ACCOUNT'["PRCA(430," Q
69 ; quit, account is a patient
70 I $P($G(^RCD(340,+$P($G(^PRCA(430,+ACCOUNT,0)),"^",9),0)),"^")[";DPT(" Q
71 ; calculate amount owed for a bill
72 S OWED=$G(^PRCA(430,+ACCOUNT,7))
73 S OWED=$P(OWED,"^")+$P(OWED,"^",2)+$P(OWED,"^",3)+$P(OWED,"^",4)+$P(OWED,"^",5)
74 ; compare amount paid (in x) with amount owed (if not processed 0;7)
75 I X>OWED,'$P($G(^RCY(344,DA(1),0)),"^",7) W " WARNING: Payment amount greater than amount of bill!"
76 ; check for other bills
77 S AMOUNT=$$EOB^IBCNSBL2(+ACCOUNT,+$P($G(^PRCA(430,+ACCOUNT,0)),"^",3),$$PAID^PRCAFN1(+ACCOUNT))
78 I AMOUNT W !!,$P(AMOUNT,"^",2)," may also be billable.",!
79 Q
80 ;
81 ;
82PNORBILL ; called by the input transform in receipt file 344, transaction
83 ; multiple (field 1), patient name or bill number (sub field .09)
84 I $L(X)>20!($L(X)<1) K X Q
85 ;
86 N DFN,RCBILL,RCINPUT,RCOUTPUT,Y,RCTYP,DIC
87 ;
88 S RCINPUT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
89 ; try and lookup on bill number
90 S X=$S($O(^PRCA(430,"B",RCINPUT,0)):$O(^(0))_";PRCA(430,",$O(^PRCA(430,"D",RCINPUT,0)):$O(^(0))_";PRCA(430,",1:RCINPUT)
91 I X[";PRCA(430," D DISPLAY(X)
92 ; bill not found, try and lookup on patient
93 I X=RCINPUT S DIC="^DPT(",DIC(0)="EM" D ^DIC S X=+Y_";DPT("
94 ; new value in variable X (output in X)
95 ;
96 ; patient not found, type of payment = check/mo
97 I +$G(Y)<0,($P($G(^RCY(344,DA(1),0)),"^",4)=4) D
98 . S (X,Y)=$$REC^IBRFN(RCINPUT,.RCTYP),(RCBILL,X)=X_";PRCA(430,"
99 . I Y>0 D
100 . . N DIR,DIQ2,DIRUT,DTOUT,DUOUT,RCPRM
101 . . S RCTYP=$G(RCTYP,1)
102 . . S RCPRM=$S(RCTYP=1:"TRICARE reference number",RCTYP=2:"ECME Rx reference number",RCTYP=3:"prescription number",1:"reference number")
103 . . S DIR("A")="Is this "_RCPRM_" - "_RCINPUT
104 . . S DIR("B")="No",DIR("A",1)=" "
105 . . S DIR(0)="Y^O" D ^DIR S:'Y Y=-1
106 . . I Y'>0 Q
107 . . W !!,$P($G(^PRCA(430,+RCBILL,0)),"^")," "
108 . . D DISPLAY(RCBILL)
109 . . S X=RCBILL
110 ; output in variable X
111 ;
112 I +$G(Y)<0 K X Q
113 ;
114 S RCOUTPUT=X
115 ;
116 ; patient account, show messages and quit (output still in variable X)
117 I RCOUTPUT[";DPT(" D CHECKPAT(+RCOUTPUT) Q
118 ;
119 ; bill account
120 I $$IB^IBRUTL(+RCOUTPUT) W " ... This bill appears to have other patient bills on 'hold'."
121 S X=$P($G(^RCD(340,+$P(^PRCA(430,+RCOUTPUT,0),"^",9),0)),"^")
122 I X[";DPT(" D CHECKPAT(+X)
123 S X=RCOUTPUT
124 Q
125 ;
126 ;
127CHECKPAT(DFN) ; check patient for other charges, etc., show message
128 N X
129 S X="IBARXEU" X ^%ZOSF("TEST")
130 I $T S X=$$RXST^IBARXEU(DFN,DT) I X D
131 . W !?2,"* Patient is exempt from RX Copay: ",$P(X,"^",4)," *"
132 S X="PSOCOPAY" X ^%ZOSF("TEST")
133 I $T S X=$$POT^PSOCOPAY(DFN) I X D
134 . W !?2,"* This patient has ",X,"-30 day RX's totaling $",(X*8),".00 that are potentially *"
135 . W !?2,"* billable. This represents any Window Rx's issued today. *"
136 Q
137 ;
138 ;
139DISPLAY(RCBILLDA) ; display bill
140 N DATA
141 S DATA=$P(^PRCA(430,+RCBILLDA,0),"^",9) W:DATA " ",$$NAM^RCFN01(DATA)
142 S DATA=$P(^PRCA(430,+RCBILLDA,0),"^",8) I DATA D
143 . W " ",$P(^PRCA(430.3,DATA,0),"^")
144 . I $P(^PRCA(430.3,DATA,0),"^",3)'=102,$P($G(^RCD(340,+$P(^PRCA(430,+RCBILLDA,0),"^",9),0)),"^")'[";DPT(" W !,"This bill is not in 'active' status."
145 S DATA=$G(^PRCA(430,+RCBILLDA,7)) W " $",$J($P(DATA,"^")+$P(DATA,"^",2)+$P(DATA,"^",3)+$P(DATA,"^",4)+$P(DATA,"^",5),1,2)
146 Q
147 ;
148 ;
149PAYDATE ; called by the input transform in receipt file 344, transaction
150 ; multiple (field 1), date of payment (sub field .06)
151 ; date of payment not in future or more than one month ago
152 N DAYSDIFF
153 S DAYSDIFF=$$FMDIFF^XLFDT(X,DT)
154 I DAYSDIFF<-31!(DAYSDIFF>0) K X
155 Q
156 ;
157 ;
158 ; ***** dd references from file 344.1 (deposits) *****
159 ;
160 ;
161RECTOTAL(RCDEPTDA) ; called from computed field TOTAL AMT OF RECEIPTS (.18) in
162 ; deposit file (344.1)
163 ; this returns the total dollars paid for all receipts on deposit ticket
164 N RCRECTDA,TOTAL
165 S TOTAL=0
166 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",+RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
167 . S TOTAL=TOTAL+$$PAYTOTAL(RCRECTDA)
168 Q TOTAL
169 ;
170 ;
171RECCOUNT(RCDEPTDA) ; called from computed field TOTAL RECEIPTS (100) in deposit file (344.1)
172 ; this returns a count of the number of receipts on a deposit ticket
173 N RCRECTDA,COUNT
174 S COUNT=0
175 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",+RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D
176 . S COUNT=COUNT+1
177 Q COUNT
Note: See TracBrowser for help on using the repository browser.