source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPLPL1.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: 4.2 KB
RevLine 
[613]1RCDPLPL1 ;WISC/RFJ-link payments listmanager options ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,153,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7CHKTRACE ; Ask to search by chec # or trace #
8 N DIR,X,Y
9 D FULL^VALM1
10 S DIR("A")="SEARCH BY (C)HECK OR (T)RACE #?: ",DIR(0)="SA^C:CHECK;T:TRACE",DIR("B")="CHECK" W ! D ^DIR K DIR
11 Q:$D(DTOUT)!$D(DUOUT)
12 I Y="C" D Q
13 . D FINDCHEK
14 I Y="T" D Q
15 . D FINDTRAC
16 Q
17 ;
18FINDCHEK ; find a specific check used for payments
19 D FULL^VALM1
20 S VALMBCK="R"
21 ;
22 N RCCHECK,RCTYPE
23 K RCFCHECK,RCFCREDT,RCFTRACE
24 W !
25 S RCCHECK=$$ASKCHEK I RCCHECK=-1 D INIT^RCDPLPLM Q
26 ;
27 S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
28 S RCFCHECK=RCCHECK_"^"_RCTYPE
29 D INIT^RCDPLPLM
30 Q
31 ;
32FINDTRAC ; find a specific trace # used for EFT/ERA payments
33 D FULL^VALM1
34 S VALMBCK="R"
35 ;
36 N RCTRACE,RCTYPE
37 K RCFTRACE,RCFCREDT,RCFCHECK
38 W !
39 S RCTRACE=$$ASKTRACE I RCTRACE=-1 D INIT^RCDPLPLM Q
40 ;
41 S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
42 S RCFTRACE=RCTRACE_"^"_RCTYPE
43 D INIT^RCDPLPLM
44 Q
45 ;
46 ;
47FINDCRED ; find a specific credit card used for payments
48 D FULL^VALM1
49 S VALMBCK="R"
50 ;
51 N RCCREDT,RCTYPE
52 K RCFCHECK,RCFCREDT,RCFTRACE
53 W !
54 S RCCREDT=$$ASKCRED I RCCREDT=-1 D INIT^RCDPLPLM Q
55 ;
56 S RCTYPE=$$ASKTYPE I RCTYPE=-1 D INIT^RCDPLPLM Q
57 S RCFCREDT=RCCREDT_"^"_RCTYPE
58 D INIT^RCDPLPLM
59 Q
60 ;
61 ;
62ACCOUNT ; account profile
63 D FULL^VALM1
64 D ACCTPROF^RCDPAPLM
65 D INIT^RCDPLPLM
66 S VALMBCK="R"
67 ; fast exit
68 I $G(RCDPFXIT) S VALMBCK="Q"
69 Q
70 ;
71 ;
72RECEIPT ; receipt profile
73 D FULL^VALM1
74 D RECTPROF^RCDPRPLM
75 D INIT^RCDPLPLM
76 S VALMBCK="R"
77 I $G(RCDPFXIT) S VALMBCK="Q"
78 Q
79 ;
80 ;
81CLEARSUS ; flag a payment as being cleared from suspense
82 D FULL^VALM1
83 S VALMBCK="R"
84 ;
85 W !!,"This option will allow you to enter the FMS Document Number used"
86 W !,"to clear the payment from the suspense account in FMS. Once an"
87 W !,"FMS Document Number is entered, the payment will no longer appear"
88 W !,"on the list as Unlinked.",!
89 N INDEX,RCPAY,RCRECTDA,RCTRANDA
90 S INDEX=$$SELPAY
91 I INDEX D
92 . S RCPAY=$G(^TMP("RCDPLPLM",$J,"IDX",INDEX,INDEX))
93 . S RCRECTDA=+$P(RCPAY,"^"),RCTRANDA=+$P(RCPAY,"^",2)
94 I 'INDEX D
95 . W ! S RCRECTDA=+$$SELRECT^RCDPUREC(0,0) I RCRECTDA<1 Q
96 . S RCTRANDA=+$$SELTRAN^RCDPURET(RCRECTDA) I RCTRANDA<1 S RCTRANDA=0
97 I '$G(RCRECTDA)!('$G(RCTRANDA)) S VALMBCK="R" Q
98 ;
99 W !!," Receipt: ",$P(^RCY(344,RCRECTDA,0),"^")
100 W !," Transaction: ",RCTRANDA
101 W !," Unapplied Deposit Number: ",$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
102 D EDITFMS^RCDPURET(RCRECTDA,RCTRANDA,"")
103 S VALMBCK="R"
104 D INIT^RCDPLPLM
105 Q
106 ;
107 ;
108 ;
109 ;
110SELPAY() ; select a payment from the form list
111 N VALMBG,VALMLST
112 ; if no payments, quit
113 I '$O(^TMP("RCDPLPLM",$J,"IDX",0)) S VALMSG="There are NO payments on the form to select." Q 0
114 ;
115 ; if only one payment, select that one automatically
116 I '$O(^TMP("RCDPLPLM",$J,"IDX",1)) Q 1
117 ;
118 ; select the entry from the list
119 ; if not on first screen, make sure selection begins with 1
120 S VALMBG=1
121 ; if not on last screen, make sure selection ends with last
122 S VALMLST=$O(^TMP("RCDPLPLM",$J,"IDX",999999999),-1)
123 D EN^VALM2($G(XQORNOD(0)),"OS")
124 Q $O(VALMY(0))
125 ;
126 ;
127ASKCHEK() ; ask the check number
128 N DIR,X,Y
129 S DIR(0)="FAO^1:15"
130 S DIR("A")="Enter the Check Number to Search for: "
131 S DIR("?")="Enter the check number from 1 to 15 characters free text."
132 D ^DIR
133 I $G(DTOUT)!($G(DUOUT)) S Y=-1
134 Q $S(Y'="":Y,1:-1)
135 ;
136 ;
137ASKTRACE() ; ask the e-payments trace number
138 N DIR,X,Y
139 S DIR(0)="FAO^1:30"
140 S DIR("A")="Enter the e-Payments Trace Number to Search for: "
141 S DIR("?")="Enter the trace number from 1 to 30 characters free text."
142 D ^DIR
143 I $G(DTOUT)!($G(DUOUT)) S Y=-1
144 Q $S(Y'="":Y,1:-1)
145 ;
146 ;
147ASKCRED() ; ask the credit card number
148 N DIR,DIRUT,DTOUT,DUOUT,X,Y
149 S DIR(0)="NAO^0:9999999999999999"
150 S DIR("A")="Enter the Credit Card Number to Search for: "
151 S DIR("?")="Enter the check card number from 1 to 16 numbers."
152 D ^DIR
153 I $G(DTOUT)!($G(DUOUT)) S Y=-1
154 Q $S(Y'="":Y,1:-1)
155 ;
156 ;
157ASKTYPE() ; ask the type of match
158 N DIR,DIRUT,DTOUT,DUOUT,X,Y
159 S DIR(0)="SAO^1:Exact Match;2:Contains;"
160 S DIR("A")="Type of Match: "
161 S DIR("B")="Contains"
162 D ^DIR
163 I $G(DTOUT)!($G(DUOUT)) S Y=-1
164 Q $S(Y=1:"EQUAL TO",Y=2:"CONTAINING",1:-1)
Note: See TracBrowser for help on using the repository browser.