source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRPL3.m@ 767

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1RCDPRPL3 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,153,173**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ; routine contains the entry points for receipt management
7 ;
8 ;
9EDITREC ; option: edit the receipt, deposit #
10 D FULL^VALM1
11 S VALMBCK="R"
12 ;
13 I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
14 ;
15 W !
16 D EDITREC^RCDPUREC(RCRECTDA)
17 L -^RCY(344,RCRECTDA)
18 ;
19 ; rebuild the header
20 D HDR^RCDPRPLM
21 Q
22 ;
23 ;
24PROCESS ; option: process receipt
25 N RCOK,RCEFT,RCEFT1,RCHAC,RC,RCERA,RCAMT,RCQUIT,CRTR,Z
26 D FULL^VALM1
27 S VALMBCK="R"
28 ;
29 S RC=$S('$P($G(^RCY(344,RCRECTDA,0)),U,6)&$$LBEVENT^RCDPEU():1,1:0),CRTR=$P("cash^transfer",U,RC+1)
30 W !!,"This option will process the payments for the receipt updating the AR"
31 W !,"Package and generate the "_CRTR_" receipt document to FMS. Any decrease"
32 W !,"adjustments entered via the EDI Lockbox Worklist will also be generated."
33 W !,"Once a receipt has been processed, the receipt status will change to closed"
34 W !,"and no further processing of the receipt can occur. If the FMS "_CRTR
35 W !," receipt document rejects, you can use this same option to reprocess the"
36 W !,"receipt.",!
37 ;
38 S RCEFT=+$P($G(^RCY(344,RCRECTDA,0)),U,17),RCERA=$P($G(^(0)),U,18),RCHAC=0
39 S RCAMT=+$$PAYTOTAL^RCDPURED(RCRECTDA)
40 ;
41 S RCQUIT=0
42 I RCERA,'RCEFT D Q:RCQUIT
43 . I +$P($G(^RCY(344.4,+RCERA,0)),U,5)'=RCAMT D S RCQUIT=1 Q
44 .. W !,"This receipt cannot be processed because the total amount of the associated",!," ERA ("_$J(+$P($G(^RCY(344.4,+RCERA,0)),U,5),"",2)_") does not equal the total amount on the receipt ("_$J(RCAMT,"",2)_")"
45 .. S VALMSG="Receipt total not = ERA total - Receipt NOT processed"
46 .. D RET^RCDPEWL2
47 ;
48 I RCEFT D Q:'RCOK
49 . N RCOK1
50 . S RCOK=0,RCEFT1=+$G(^RCY(344.3,+RCEFT,0)),RCHAC=($E($P($G(^RCY(344.3,RCEFT1,0)),U,6),1,3)="HAC")
51 . N Z,DIR,DIE,DA,DR
52 . I $P($G(^RCY(344.3,+RCEFT1,0)),U,10) D Q
53 .. W !,"This receipt cannot be processed until EDI Lockbox checksum exception is",!," cleared on the EFT transmission"
54 .. S VALMSG="EDI LOCKBOX exception still exists - Receipt NOT processed"
55 .. D RET^RCDPEWL2
56 . ;
57 . I +$P($G(^RCY(344.31,+RCEFT,0)),U,7)'=RCAMT D Q
58 .. W !,"This receipt cannot be processed - the receipt total does not match the",!," EFT total for this EDI Lockbox receipt"
59 .. S VALMSG="EDI LOCKBOX total of receipt not = EFT - Receipt NOT processed"
60 .. D RET^RCDPEWL2
61 . ; Check that EFT funds were posted
62 . S RCOK1=1
63 . I $P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFT,0)),0)),U,8),$P($G(^RCY(344.31,+RCEFT,0)),U,7) D Q:'RCOK1
64 .. N RCRECTDA,RCDEPDA
65 .. S RCDEPDA=+$P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFT,0)),0)),U,3),RCRECTDA=+$O(^RCY(344,"AD",+RCDEPDA,0)) ; Get deposit and its receipt
66 .. I RCRECTDA S Z=$P($$FMSSTAT^RCDPUREC(RCRECTDA),U,2) I $E(Z)="A" Q ; Accepted by FMS
67 .. W !,"This receipt cannot be processed yet - the EFT's deposit has not been",!," successfully sent to FMS. Status currently is "_Z
68 .. S VALMSG="EDI LOCKBOX EFT not yet posted",RCOK1=0
69 .. D RET^RCDPEWL2
70 . S RCOK=1
71 ;
72 I +$P($G(^RCY(344,RCRECTDA,0)),U,6),+$P(^(0),U,17) D Q:'RCOK
73 . S RCOK=0
74 . S DIR("A",1)="A DEPOSIT CANNOT BE ASSOCIATED WITH AN EDI LOCKBOX EFT DETAIL RECEIPT"
75 . S DIR(0)="YA",DIR("A")="DO YOU WANT TO DELETE THIS RECEIPT'S DEPOSIT REFERENCE NOW?: ",DIR("B")="NO" W ! D ^DIR K DIR
76 . I Y=1 S DIE="^RCY(344,",DR=".06///@",DA=RCRECTDA D ^DIE S RCOK=1 Q
77 . S VALMSG="EDI LBOX ERA receipt cannot have a deposit - Receipt NOT processed"
78 ;
79 N RCDEPTDA,RCDPDATA,RCDPFLAG,RCDPFHLP,RCTRDA,RCSCR,STATUS,RCADJ
80 ;
81 ; lock receipt
82 I '$$LOCKREC^RCDPRPLU(RCRECTDA) S VALMSG="Receipt NOT Processed." Q
83 ;
84 ; apply decrease adjustments from worklist entry
85 S RCSCR=+$O(^RCY(344.4,"ARCT",RCRECTDA,0)),RCSCR=$S($D(^RCY(344.49,+RCSCR,0)):RCSCR,1:0)
86 S RCADJ=$$ERAWL^RCDPRPL4(RCSCR)
87 I RCADJ=2 D UNLOCK Q
88 I RCADJ<0 D Q
89 . W !,"The bill balance for the bills listed above must be manually increased to",!,"accommodate the automatic ERA Worklist dec adjustment amounts and to allow",!,"the ERA receipt to be balanced - Receipt NOT processed."
90 . D UNLOCK
91 ;
92 ; warning no transactions
93 I '$O(^RCY(344,RCRECTDA,1,0)) D
94 . W !,"WARNING, no transactions are on the receipt. Processing will only change"
95 . W !,"the status of the receipt to closed."
96 ;
97 D DIQ344^RCDPRPLM(RCRECTDA,".06;.08;.17;.18;200;")
98 ; code sheet already sent once, this is a retransmission, check it
99 I RCDPDATA(344,RCRECTDA,200,"E")'="" D
100 . S STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
101 . W !,"This receipt has been previously processed to FMS in the cash receipt"
102 . W !,"document ",$TR(RCDPDATA(344,RCRECTDA,200,"E")," "),". The current status for this document in the"
103 . W !,"Generic Code Sheet Stack file is ",STATUS,"."
104 . ;
105 . ; okay to continue if status is Error, Rejected, or not defined (-1)
106 . I $E(STATUS)="E"!($E(STATUS)="R")!(STATUS=-1) Q
107 . ; okay to continue if document has not been transmitted
108 . I $E(STATUS)="Q"!($E(STATUS)="M") Q
109 . ; okay to continue if document is transmitted for 2 days
110 . I $E(STATUS)="T",$$FMDIFF^XLFDT(DT,RCDPDATA(344,RCRECTDA,.08,"I"))>1 Q
111 . ;
112 . ; do not allow reprocessing
113 . S RCDPFLAG=1
114 . I $E(STATUS)="A" W !!,"You cannot reprocess and retransmit an ACCEPTED document."
115 . I $E(STATUS)="T" W !!,"You cannot reprocess and retransmit a document which has previously been",!,"transmitted and is waiting on confirmation (less than 2 days since",!,"processing)."
116 I $G(RCDPFLAG) D UNLOCK Q
117 ;
118 ; check payments to verify it doesn't exceed bill amt
119 W !!,"Checking payment amounts versus billed amounts ..."
120 S RCTRDA=0 F S RCTRDA=$O(^RCY(344,RCRECTDA,1,RCTRDA)) Q:'RCTRDA D
121 . S X=$$CHECKPAY(RCRECTDA,RCTRDA)
122 . I 'X Q
123 . ; exceeds billed amt
124 . S RCDPFLAG=1
125 . ; check for >1 pending payment for this transaction
126 . I +$P(X,"^",3)'=$P(^RCY(344,RCRECTDA,1,RCTRDA,0),"^",4) S RCDPFLAG=2
127 . W !," " I RCDPFLAG=2 W "*" S RCDPFHLP=1
128 . W "WARNING: Trans# ",RCTRDA,". Pending Payments $ ",$J($P(X,"^",3),0,2)," exceed billed amount $ ",$J($P(X,"^",2),0,2)
129 I $G(RCDPFLAG) D Q
130 . I $G(RCDPFHLP) W !,"NOTE: * Indicates more than one pending payment entered against this bill."
131 . W !,"Adjust payments listed above before processing."
132 . D UNLOCK
133 ;
134 W " payments okay."
135 ;
136 S RCDEPTDA=RCDPDATA(344,RCRECTDA,.06,"I")
137 ; lock deposit tckt
138 I RCDEPTDA I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCK Q
139 ;
140 ; check for critical fields, deposit ticket, date of deposit
141 ; No deposit ticket is OK for ERA not related to an EFT or for HAC ERA
142 I 'RCDEPTDA,$S('$G(RCDPDATA(344,RCRECTDA,.18,"I")):1,$$EDILB^RCDPEU(RCRECTDA)=2:0,1:'$$HAC^RCDPURE1(RCRECTDA)) D
143 . W !!,"WARNING, Deposit Ticket is missing. If you continue with processing,"
144 . W !,"the AR accounts will be updated and a cash receipt (CR) document will"
145 . W !,"NOT be sent to FMS. You have the option to add the Deposit Ticket now."
146 . D EDITREC^RCDPUREC(RCRECTDA,".06;")
147 . S (RCDEPTDA,RCDPDATA(344,RCRECTDA,.06,"I"))=$P(^RCY(344,RCRECTDA,0),"^",6)
148 ;
149 ; deposit ticket added
150 I RCDEPTDA D
151 . D EDITDEP^RCDPUDEP(RCDEPTDA,1)
152 . D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
153 . I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
154 . W !!,"No DEPOSIT DATE, you can edit the deposit data now."
155 . D EDITDEP^RCDPUDEP(RCDEPTDA,1)
156 . D DIQ3441^RCDPDPLM(RCDEPTDA,".03;")
157 . I RCDPDATA(344.1,RCDEPTDA,.03,"I") Q
158 . W !!,"Still No DEPOSIT DATE, use the Edit Deposit option under Deposit Processing."
159 . S RCDPFLAG=1
160 I $G(RCDPFLAG) D UNLOCK Q
161 ;
162 W !
163 I $$ASKPROC'=1 D Q
164 . I $G(RCADJ)>0 W !!,*7,"WARNING - EDI Lbox Worklist auto dec adjustments have already been made for",!,"this receipt!!!"
165 . D UNLOCK
166 ;
167 ; process receipt, pass 1 to show messages
168 D PROCESS^RCDPURE1(RCRECTDA,1)
169 D UNLOCK
170 D INIT^RCDPRPLM
171 D HDR^RCDPRPLM
172 I $P(^RCY(344,RCRECTDA,0),"^",8) S VALMSG="Receipt PROCESSED."
173 Q
174 ;
175 ;
176UNLOCK ; unlock/pause
177 L -^RCY(344,RCRECTDA)
178 I $G(RCDEPTDA) L -^RCY(344.1,RCDEPTDA)
179 W !!,"Press RETURN to continue: " R X:DTIME
180 S VALMSG="Receipt NOT Processed."
181 D HDR^RCDPRPLM
182 Q
183 ;
184 ;
185CHECKPAY(RCRECTDA,RCTRDA) ; called to check amt pd against amt of bill
186 N PAYDATA,PENDING,X
187 ; receipt already processed
188 I $P($G(^RCY(344,RCRECTDA,0)),"^",7) Q 0
189 S PAYDATA=$G(^RCY(344,RCRECTDA,1,RCTRDA,0))
190 ; payment is 0
191 I '$P(PAYDATA,"^",4) Q 0
192 ; payment processed
193 I $P(PAYDATA,"^",5) Q 0
194 ; not a bill
195 I $P(PAYDATA,"^",3)'["PRCA(430," Q 0
196 ; first party bill (do not check dollars)
197 I $P($G(^RCD(340,+$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",9),0)),"^")["DPT(" Q 0
198 ; bill not activated or open
199 S X=$P($G(^PRCA(430,+$P(PAYDATA,"^",3),0)),"^",8)
200 I X'=42,X'=16 Q "1^0"
201 ; calculate dollars on receivable
202 S X=$G(^PRCA(430,+$P(PAYDATA,"^",3),7)),X=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
203 ; get pending payments
204 ; use pending since there may be more than one payment
205 ; to the same bill on the receipt
206 S PENDING=$$PENDPAY^RCDPURET($P(PAYDATA,"^",3))
207 K ^TMP($J,"RCDPUREC","PP") ;set by pending payment call
208 ; pending payments is not > billed
209 I PENDING'>X Q 0
210 ; greater, return billed amt ^ pending payment amt
211 Q "1^"_X_"^"_PENDING
212 ;
213 ;
214ASKPROC() ; ask if its okay to process the receipt
215 ; 1 is yes, otherwise no
216 N DIR,DIQ2,DTOUT,DUOUT,X,Y
217 S DIR(0)="YO",DIR("B")="NO"
218 S DIR("A")=" Are you sure you want to PROCESS this receipt"
219 D ^DIR
220 I $G(DTOUT)!($G(DUOUT)) S Y=-1
221 Q Y
Note: See TracBrowser for help on using the repository browser.