source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPLPL3.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.3 KB
Line 
1RCDPLPL3 ;WISC/RFJ-link payments listmanager options (link payment) ;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 ;
7LINKPAY ; link a payment to an account
8 D FULL^VALM1
9 S VALMBCK="R"
10 ;
11 W !!,"This option will allow the account to be entered for an unapplied"
12 W !,"payment transaction selected from the above list. If the selected"
13 W !,"receipt has been previously processed, the selected account in the"
14 W !,"accounts receivable package will be updated with the payment.",!
15 N INDEX,RCDPFLAG,RCERROR,RCGECSCR,RCPAY,RCRECTDA,RCSTATUS,RCTRANDA
16 S INDEX=$$SELPAY^RCDPLPL1 I 'INDEX Q
17 S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX))
18 S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2)
19 ;
20 I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
21 ;
22 ; check to see if the cr document has been sent for the receipt
23 S RCGECSCR=$P($G(^RCY(344,RCRECTDA,2)),"^")
24 ; code sheet already sent once, this is a retransmission, check it
25 I RCGECSCR'="" D
26 . S RCSTATUS=$$STATUS^GECSSGET(RCGECSCR)
27 . W !!,"This receipt has been processed to FMS with cash receipt document"
28 . W !,$TR(RCGECSCR," "),". The current status for this document in the"
29 . W !,"Generic Code Sheet Stack file is ",RCSTATUS,"."
30 . ;
31 . ; okay to continue if status is Error, Rejected, or not defined (-1)
32 . I $E(RCSTATUS)="E"!($E(RCSTATUS)="R")!(RCSTATUS=-1) Q
33 . ; okay to continue if status is Accepted
34 . I $E(RCSTATUS)="A" Q
35 . ; okay to continue if document is transmitted for 2 days
36 . I $E(RCSTATUS)="T",$$FMDIFF^XLFDT(DT,$P(^RCY(344,RCRECTDA,0),"^",8))>1 Q
37 . ;
38 . W !!,"You cannot link the payment to an account until the FMS cash receipt"
39 . W !,"document is either Accepted or Rejected by FMS."
40 . W !," 1. If the FMS cash receipt is Accepted by FMS, you will need to"
41 . W !," remove the payment from the station's suspense account online"
42 . W !," in FMS."
43 . W !," 2. If the FMS cash receipt document is rejected by FMS, you can"
44 . W !," use the option Process Receipt under the Receipt Processing"
45 . W !," listmanager screen to regenerate the document. The payment"
46 . W !," has not been deposited in the station's suspense account by"
47 . W !," FMS since the cash receipt document rejected.",!
48 . S VALMSG="Try linking this payment again tomorrow."
49 . D WRITE^RCDPRPLU(VALMSG)
50 . S RCDPFLAG=1
51 I $G(RCDPFLAG) D QUIT Q
52 ;
53 ; show payment transaction
54 W !!,"The current payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^")
55 W !,"--------------------------------"
56 D SHOWPAY(RCRECTDA,RCTRANDA)
57 ;
58 ; transaction has account entered
59 I $P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D Q
60 . S VALMSG="An account has been assigned to this payment."
61 . D QUIT
62 ;
63 ; transaction is cancelled, cannot edit
64 I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
65 . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
66 . D WRITE^RCDPRPLU(VALMSG)
67 . D QUIT
68 ;
69 ;
70 W !!,"Editing Payment: ",RCTRANDA
71 D EDITACCT^RCDPURET(RCRECTDA,RCTRANDA)
72 ;
73 W !
74 ; account not entered
75 I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3) D Q
76 . S VALMSG="Account was not linked."
77 . D WRITE^RCDPRPLU(VALMSG)
78 . D QUIT
79 ;
80 ; show payment transaction
81 W !,"The NEW payment transaction:",?40,"RECEIPT: ",$P(^RCY(344,RCRECTDA,0),"^")
82 W !,"-----------------------------"
83 D SHOWPAY(RCRECTDA,RCTRANDA)
84 ;
85 I $$ASKACCT'=1 D Q
86 . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
87 . S VALMSG="Account was deleted and not linked."
88 . D WRITE^RCDPRPLU(VALMSG)
89 . D QUIT
90 ;
91 ; receipt has been processed since the cash receipt document
92 ; has been generated. update the new account with payment
93 W !
94 I RCGECSCR'="" D I RCERROR Q
95 . W !,"Updating the Linked Account with the payment ..."
96 . S RCERROR=$$PROCESS^RCBEPAY(RCRECTDA,RCTRANDA)
97 . ; an error occurred during processing a payment
98 . I RCERROR D Q
99 . . W !
100 . . W !,"+------------------------------------------------------------------------------+"
101 . . W !,"| An ERROR has occurred when processing payment ",RCTRANDA," on receipt ",$P(^RCY(344,RCRECTDA,0),"^"),".",?79,"|"
102 . . W !,"| The error message returned during processing is:",?79,"|"
103 . . W !,"|",?79,"|"
104 . . W !,"| ",$P(RCERROR,"^",2),?79,"|"
105 . . W !,"|",?79,"|"
106 . . W !,"| You will need to correct the error before you can link the payment.",?79,"|"
107 . . W !,"+------------------------------------------------------------------------------+"
108 . . W !
109 . . D DELEACCT^RCDPURET(RCRECTDA,RCTRANDA)
110 . . S VALMSG="Account was deleted and not linked."
111 . . D WRITE^RCDPRPLU(VALMSG)
112 . . D QUIT
113 . ;
114 . ; payment processed correctly
115 . W " done."
116 . W !
117 . I $E(RCSTATUS)="A" D
118 . . W !,"Since the FMS cash receipt document is Accepted in FMS, you need to go"
119 . . W !,"online in FMS and transfer the amount paid out of the station's suspense"
120 . . W !,"account.",!
121 . . ; send mail message to the RCDP PAYMENTS mail group
122 . . W !,"Sending mail message to RCDP PAYMENTS mail group."
123 . . D MAILMSG^RCDPLPSR(RCRECTDA,RCTRANDA)
124 . . ; place an x in the fms doc field so it will show on the
125 . . ; suspense report
126 . . D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"x")
127 . I $E(RCSTATUS)'="A" D
128 . . W !,"Since the FMS cash receipt document is NOT Accepted in FMS, you can use"
129 . . W !,"the option Process Receipt located under the Receipt Processing Menu"
130 . . W !,"to regenerate the cash receipt document to FMS.",!
131 . S VALMSG="Payment linked and removed from list."
132 . D WRITE^RCDPRPLU(VALMSG)
133 ;
134 ; receipt has not been processed
135 I RCGECSCR="" D
136 . S VALMSG="Since the receipt has not been processed, accounts will not be updated."
137 . D WRITE^RCDPRPLU(VALMSG)
138 . S VALMSG="Payment linked and removed from list."
139 ;
140QUIT ; call here to unlock and rebuild list
141 L -^RCY(344,RCRECTDA)
142 D INIT^RCDPLPLM
143 Q
144 ;
145 ;
146SHOWPAY(RCRECTDA,RCTRANDA) ; show the payment transaction
147 N A,D0,DA,DIC,DIQ,DK,DL,DX,S,Y
148 S DIC="^RCY(344,"_RCRECTDA_",1,",DA(1)=RCRECTDA,DA=RCTRANDA,DIQ(0)="C"
149 D EN^DIQ
150 Q
151 ;
152 ;
153ASKACCT() ; ask if its the correct account
154 ; 1 is yes, otherwise no
155 N DIR,DIQ2,DTOUT,DUOUT,X,Y
156 S DIR(0)="YO",DIR("B")="NO"
157 S DIR("A")=" Is this the correct ACCOUNT to apply the payment to"
158 D ^DIR
159 I $G(DTOUT)!($G(DUOUT)) S Y=-1
160 Q Y
Note: See TracBrowser for help on using the repository browser.