source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRPL1.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.4 KB
RevLine 
[613]1RCDPRPL1 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ; this routine contains the entry points for payment transactions
7 ;
8 ;
9ENTRTRAN ; option: enter a payment transaction
10 ; this option can only be selected for unapproved receipts
11 ; screen placed in protocol file and below as backup
12 D FULL^VALM1
13 S VALMBCK="R"
14 ;
15 I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
16 ;
17 N %,RCTRANDA,RCTYPE
18 S RCTYPE=$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
19 ;
20 W !
21 W !," Type of payment: ",$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
22 W !,"Adding a NEW payment transaction: "
23 S RCTRANDA=$$ADDTRAN^RCDPURET(RCRECTDA)
24 I 'RCTRANDA D Q
25 . S VALMSG="Unable to ADD a new payment transaction."
26 . D WRITE^RCDPRPLU(VALMSG)
27 . L -^RCY(344,RCRECTDA)
28 ;
29 W "# ",RCTRANDA
30 S %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
31 I '% D Q
32 . S VALMSG=%
33 . D WRITE^RCDPRPLU(VALMSG)
34 . L -^RCY(344,RCRECTDA)
35 ;
36 S VALMSG="Transaction # "_RCTRANDA_" has been ADDED."
37 ;
38 D INIT^RCDPRPLM
39 L -^RCY(344,RCRECTDA)
40 Q
41 ;
42 ;
43EDITTRAN ; option: edit a payment transaction
44 ; this option can only be selected for unapproved receipts
45 ; screen placed in protocol file and below as backup
46 D FULL^VALM1
47 S VALMBCK="R"
48 ;
49 N %,RCTRANDA
50 ; select the payment transaction
51 S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
52 ;
53 I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
54 ;
55 ; transaction is cancelled, cannot edit
56 I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
57 . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
58 . D WRITE^RCDPRPLU(VALMSG)
59 . L -^RCY(344,RCRECTDA)
60 ;
61 W !!,"Editing Payment: ",RCTRANDA
62 S %=$$EDITTRAN^RCDPURET(RCRECTDA,RCTRANDA)
63 I '% S VALMSG="Transaction DELETED." D WRITE^RCDPRPLU(VALMSG)
64 ;
65 D INIT^RCDPRPLM
66 L -^RCY(344,RCRECTDA)
67 Q
68 ;
69 ;
70CANCTRAN ; option: cancel a transaction
71 ; this option can only be selected for unapproved receipts
72 ; screen placed in protocol file and below as backup
73 D FULL^VALM1
74 S VALMBCK="R"
75 ;
76 N RCTRANDA
77 ; select the payment transaction
78 S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
79 ;
80 I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
81 ;
82 ; check to see if already cancelled
83 I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4)=0,$P($G(^(1)),"^")'="" D Q
84 . S VALMSG="Payment Transaction "_RCTRANDA_" is already CANCELLED."
85 . D WRITE^RCDPRPLU(VALMSG)
86 . L -^RCY(344,RCRECTDA)
87 ;
88 ; ask to cancel
89 I $$ASKCANC(RCTRANDA)=1 D
90 . D CANCTRAN^RCDPURET(RCRECTDA,RCTRANDA)
91 . S VALMSG="Transaction # "_RCTRANDA_" has been CANCELLED"
92 ;
93 D INIT^RCDPRPLM
94 L -^RCY(344,RCRECTDA)
95 Q
96 ;
97 ;
98MOVETRAN ; move a transaction from one receipt to another
99 D FULL^VALM1
100 S VALMBCK="R"
101 ;
102 N RCNEWREC,RCNEWTRA,RCTRANDA
103 ; select the payment transaction
104 S RCTRANDA=$$SELPAY(RCRECTDA) I RCTRANDA<1 Q
105 ;
106 I '$$LOCKREC^RCDPRPLU(RCRECTDA) Q
107 ;
108 ; transaction is cancelled, cannot edit
109 I '$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",4),$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),"^")'="" D Q
110 . S VALMSG="Payment Transaction "_RCTRANDA_" is CANCELLED."
111 . D WRITE^RCDPRPLU(VALMSG)
112 . D UNLOCK
113 ;
114 ; select the receipt to move transaction to (can add new one)
115 F D Q:RCNEWREC
116 . W !!,"Select the RECEIPT to move the payment transaction #"_RCTRANDA_" to:"
117 . S RCNEWREC=$$SELRECT^RCDPUREC(1)
118 . I RCNEWREC<1 S RCNEWREC=-1 Q
119 . I RCNEWREC=RCRECTDA W !,"Cannot copy transaction to same receipt." S RCNEWREC=0 Q
120 . I '$$CHECKREC^RCDPRPLU(RCNEWREC) W !,"Cannot copy to a receipt which is CLOSED." S RCNEWREC=0 Q
121 I RCNEWREC<1 D UNLOCK Q
122 ;
123 I '$$LOCKREC^RCDPRPLU(RCNEWREC) D UNLOCK Q
124 ;
125 W !
126 I $P($G(^RCY(344,RCNEWREC,0)),"^",4)'=$P(^RCY(344,RCRECTDA,0),"^",4) W !,"WARNING, receipt types of payment are not the same type of payment."
127 ;
128 I $$ASKMOVE(RCNEWREC)'=1 D UNLOCK Q
129 ;
130 ; movetran will add the new transaction, and allow the user to
131 ; edit the data. returns error message if not successful or
132 ; returns the transaction number.
133 S RCNEWTRA=$$MOVETRAN^RCDPURET(RCRECTDA,RCTRANDA,RCNEWREC)
134 I 'RCNEWTRA D Q
135 . S VALMSG=%
136 . D WRITE^RCDPRPLU(VALMSG)
137 . D UNLOCK
138 ;
139 ; delete the transaction just moved
140 D DELETRAN^RCDPURET(RCRECTDA,RCTRANDA)
141 ;
142 D INIT^RCDPRPLM
143 S VALMSG="Transaction # "_RCTRANDA_" has been MOVED/DELETED."
144 ;
145UNLOCK ; unlock receipts
146 L -^RCY(344,RCRECTDA)
147 I $G(RCNEWREC)>0 L -^RCY(344,RCNEWREC)
148 Q
149 ;
150 ;
151SELPAY(RCRECTDA) ; select the payment transaction for the receipt (from listmanager options)
152 N RCTRANDA
153 ; if no payments, quit
154 I '$O(^RCY(344,RCRECTDA,1,0)) S VALMSG="There are NO payments." Q 0
155 ; if only one payment, select that one automatically
156 I $P($G(^RCY(344,RCRECTDA,1,0)),"^",4)=1 S RCTRANDA=$O(^RCY(344,RCRECTDA,1,0))
157 ; select the payment transaction
158 I '$G(RCTRANDA) W ! S RCTRANDA=$$SELTRAN^RCDPURET(RCRECTDA)
159 Q RCTRANDA
160 ;
161 ;
162ASKCANC(RCTRANDA) ; ask if its okay to cancel a transaction
163 ; 1 is yes, otherwise no
164 N DIR,DIQ2,DTOUT,DUOUT,X,Y
165 S DIR(0)="YO",DIR("B")="NO"
166 S DIR("A")=" Are you sure you want to CANCEL transaction # "_RCTRANDA
167 W ! D ^DIR
168 I $G(DTOUT)!($G(DUOUT)) S Y=-1
169 Q Y
170 ;
171 ;
172ASKMOVE(RECTDA) ; ask if its okay to move the transaction
173 ; 1 is yes, otherwise no
174 N DIR,DIQ2,DTOUT,DUOUT,X,Y
175 S DIR(0)="YO",DIR("B")="NO"
176 S DIR("A")=" Are you sure you want to MOVE this payment to receipt "_$P($G(^RCY(344,RECTDA,0)),"^")
177 D ^DIR
178 I $G(DTOUT)!($G(DUOUT)) S Y=-1
179 Q Y
Note: See TracBrowser for help on using the repository browser.