source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRPL2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1RCDPRPL2 ;WISC/RFJ-receipt profile listmanager options ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,173,217**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ; this routine contains entry points for customize and printing
7 ;
8 ;
9ACCTPROF ; option: account profile
10 D FULL^VALM1
11 S VALMBCK="R"
12 ;
13 N ACCT,RCDEBTDA,RCTRANDA
14 ; select the payment transaction
15 S RCTRANDA=$$SELPAY^RCDPRPL1(RCRECTDA)
16 I RCTRANDA>0 D
17 . ; find debtor (file 340) entry
18 . S RCDEBTDA=0
19 . S ACCT=$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3)
20 . I ACCT[";DPT(" S RCDEBTDA=$O(^RCD(340,"B",ACCT,0))
21 . I ACCT["PRCA(430," S RCDEBTDA=$P($G(^PRCA(430,+ACCT,0)),"^",9)
22 . I 'RCDEBTDA S VALMSG="Account NOT found for payment transaction."
23 ;
24 ; payment not selected ask to select an account
25 I '$D(RCDEBTDA) S RCDEBTDA=$$SELACCT^RCDPAPLM
26 ;
27 I $G(RCDEBTDA)'>0 Q
28 D EN^VALM("RCDP ACCOUNT PROFILE")
29 S VALMBCK="R"
30 ; fast exit
31 I $G(RCDPFXIT) S VALMBCK="Q"
32 Q
33 ;
34 ;
35PRINRECT ; option: print a receipt
36 D FULL^VALM1
37 S VALMBCK="R"
38 ;
39 N RCTRANDA
40 ; select the payment transaction
41 S RCTRANDA=$$SELPAY^RCDPRPL1(RCRECTDA) I RCTRANDA<1 Q
42 ;
43 ; check if transaction has a payment amount
44 I '$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4) S VALMSG="NO Payment Amount on Transaction." Q
45 ;
46 S VALMSG=$$DEVICE^RCDPRECT
47 I VALMSG=0 S VALMSG="Receipt NOT printed"
48 Q
49 ;
50 ;
51PRINT215 ; print 215 report
52 N %ZIS,POP
53 D FULL^VALM1
54 S VALMBCK="R"
55 ;
56 N RECEIPDA,RCTYPE
57 S RECEIPDA=RCRECTDA
58 ;
59 S RCTYPE=$$GETTYPE^RCDPR215
60 I RCTYPE="" Q
61 ;
62 ; select device
63 W ! S %ZIS="Q" D ^%ZIS Q:POP
64 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D ^%ZISC Q
65 . S ZTDESC="Print 215 Report",ZTRTN="DQ^RCDPR215"
66 . S ZTSAVE("RECEIPDA")="",ZTSAVE("RCTYPE")="",ZTSAVE("ZTREQ")="@"
67 W !!,"<*> please wait <*>"
68 D DQ^RCDPR215
69 Q
70 ;
71 ;
72CUSTOMIZ ; option: customize display
73 D FULL^VALM1
74 S VALMBCK="R"
75 ;
76 W !!,"This option will allow the user to customize the screen and options"
77 W !,"used for receipt processing."
78 ;
79 ; ask to show check/credit card data
80 I $$ASKCHECK=-1 Q
81 ;
82 ; ask to show acct lookup, batch and sequence number
83 I $$ASKACCT=-1 D INIT^RCDPRPLM Q
84 ;
85 ; ask to show comments
86 I $$ASKCOMM=-1 D INIT^RCDPRPLM Q
87 ;
88 ; ask to show fms cr documents
89 I $$ASKFMS=-1 D INIT^RCDPRPLM Q
90 ;
91 ; ask to show EOB detail information
92 I $$ASKEOB=-1 D INIT^RCDPRPLM Q
93 ;
94 ; make sure form is rebuilt based on the above answers
95 D INIT^RCDPRPLM
96 ;
97 ;
98 W !!,"The next prompts will allow the user to individually set up the way receipts"
99 W !,"should be printed when entering payment transactions. The user can set"
100 W !,"the software up to automatically print a receipt to a device, never print"
101 W !,"the receipt, or ask to print the receipt. The user can also specify the"
102 W !,"printer used for printing receipts, preventing from having to re-enter it."
103 N DEVICE,TYPE
104 ;
105 ; for printing receipts
106 D Q:TYPE<0
107 . W !
108 . S TYPE=$$ASKRECT
109 . I TYPE<0 Q
110 . ;
111 . ; never print receipt
112 . I TYPE=0 D RCSET("RECEIPT",0) Q
113 . ;
114 . ; ask default printer device
115 . S DEVICE=$$ASKDEVIC(1)
116 . ;
117 . ; no default printer, always print receipt
118 . I DEVICE="",TYPE=1 D Q
119 . . W !,"Since you did not enter a default printer for printing receipts,"
120 . . W !,"I will change it so the software will ask you to print the receipt"
121 . . W !,"when entering a payment transaction."
122 . . D RCSET("RECEIPT",2)
123 . ;
124 . ; set default printer for receipts
125 . D RCSET("RECEIPT",TYPE_"^"_DEVICE)
126 ;
127 ; for printing 215 report
128 W !!!,"You now have the option of setting up the default printer for automatically"
129 W !,"printing the 215 report when a receipt is processed.",!
130 ; ask default printer device
131 S DEVICE=$$ASKDEVIC(2)
132 D RCSET("215REPORT",U_DEVICE)
133 Q
134RCSET(RCSNPT,RCSLDV) ;file the selected parameter & device
135 N DA,DIC,DIE,DR,X,Y
136 I '$D(^RC(342.3,"B",RCSNPT)) D
137 .K DD,DO,DIC("DR") S DIC="^RC(342.3,",DIC(0)="",X=RCSNPT D FILE^DICN
138 S DA(1)=$O(^RC(342.3,"B",RCSNPT,0))
139 I '$D(^RC(342.3,DA(1),1,"B",DUZ)) D Q
140 .S DIC(0)="",DIC("P")=$P(^DD(342.3,1,0),U,2),DIC="^RC(342.3,"_DA(1)_",1,",X=DUZ
141 .S DIC("DR")="1////"_$P(RCSLDV,U)_";2////"_$P(RCSLDV,U,2)
142 .K DD,DO D FILE^DICN
143 S DA=$O(^RC(342.3,DA(1),1,"B",DUZ,0)),DR=".01////"_DUZ_";1////"_$P(RCSLDV,U)_";2////"_$P(RCSLDV,U,2)
144 S DIE="^RC(342.3,"_DA(1)_",1," D ^DIE
145 Q
146 ;
147OPTCK(RCSNPT,RCSLDV) ;return the selection in piece 2 and device in piece 3
148 N RCDA
149 S RCDA=$O(^RC(342.3,+$O(^RC(342.3,"B",RCSNPT,0)),1,"B",DUZ,0))
150 I RCDA S RCDA=$P($G(^RC(342.3,+$O(^RC(342.3,"B",RCSNPT,0)),1,RCDA,0)),U,RCSLDV)
151 Q RCDA
152 ;
153 ;
154ASKCHECK() ; ask if its okay to show check/credit card data
155 ; 1 is yes, otherwise no
156 N DIR,DIQ2,DTOUT,DUOUT,X,Y
157 S DIR(0)="YO"
158 S DIR("B")="NO"
159 I $$OPTCK("SHOWCHECK",2) S DIR("B")="YES"
160 S DIR("A")=" Do you want to show check and credit card information"
161 W ! D ^DIR
162 I $G(DTOUT)!($G(DUOUT)) S Y=-1
163 I Y'=-1 D RCSET("SHOWCHECK",Y)
164 Q Y
165 ;
166ASKEOB() ; ask if its okay to show EOB detail data
167 ; 1 is yes, otherwise no
168 N DIR,DIQ2,DTOUT,DUOUT,X,Y
169 S DIR(0)="YO"
170 S DIR("B")="NO"
171 I $$OPTCK("SHOWEOB",2) S DIR("B")="YES"
172 S DIR("A")=" Do you want to show electronic EEOB detail data"
173 W ! D ^DIR
174 I $G(DTOUT)!($G(DUOUT)) S Y=-1
175 I Y'=-1 D RCSET("SHOWEOB",Y)
176 Q Y
177 ;
178ASKACCT() ; ask if its okay to show acct lookup, batch, and sequence
179 ; 1 is yes, otherwise no
180 N DIR,DIQ2,DTOUT,DUOUT,X,Y
181 S DIR(0)="YO"
182 S DIR("B")="NO"
183 I $$OPTCK("SHOWACCT",2) S DIR("B")="YES"
184 S DIR("A")=" Do you want to show acct lookup, batch and sequence information"
185 W ! D ^DIR
186 I $G(DTOUT)!($G(DUOUT)) S Y=-1
187 I Y'=-1 D RCSET("SHOWACCT",Y)
188 Q Y
189 ;
190 ;
191ASKCOMM() ; ask if its okay to show comments and posting errors
192 ; 1 is yes, otherwise no
193 N DIR,DIQ2,DTOUT,DUOUT,X,Y
194 S DIR(0)="YO"
195 S DIR("B")="NO"
196 I $$OPTCK("SHOWCOMMENTS",2) S DIR("B")="YES"
197 S DIR("A")=" Do you want to show comments"
198 W ! D ^DIR
199 I $G(DTOUT)!($G(DUOUT)) S Y=-1
200 I Y'=-1 D RCSET("SHOWCOMMENTS",Y)
201 Q Y
202 ;
203 ;
204ASKFMS() ; ask if its okay to show fms documents
205 ; 1 is yes, otherwise no
206 N DIR,DIQ2,DTOUT,DUOUT,X,Y
207 S DIR(0)="YO"
208 S DIR("B")="NO"
209 I $$OPTCK("SHOWFMS",2) S DIR("B")="YES"
210 S DIR("A")=" Do you want to show the FMS cash receipt documents"
211 W ! D ^DIR
212 I $G(DTOUT)!($G(DUOUT)) S Y=-1
213 I Y'=-1 D RCSET("SHOWFMS",Y)
214 Q Y
215 ;
216 ;
217ASKRECT() ; ask to print the receipt
218 ; returns 0 (never), 1 (always), or 2 (ask)
219 N DEFAULT,DIR,DIQ2,DTOUT,DUOUT,X,Y
220 S DEFAULT="ALWAYS"
221 I $$OPTCK("RECEIPT",2)'=""!($$OPTCK("RECEIPT",3)'="") S DEFAULT=$$OPTCK("RECEIPT",2),DEFAULT=$S(DEFAULT=0:"NEVER",DEFAULT=1:"ALWAYS",1:"MAYBE")
222 S DIR(0)="SO^0:Never Print the Receipt;1:Always Print the Receipt;2:Maybe, Ask to Print the Receipt"
223 S DIR("A")="Print Receipt"
224 S DIR("B")=DEFAULT
225 D ^DIR
226 I $G(DTOUT)!($G(DUOUT)) S Y=-1
227 Q Y
228 ;
229 ;
230ASKDEVIC(RCTYPE) ; ask the default printer for receipts and for 215 report
231 ; rctype=1 for receipts, rctype=2 for 215 report
232 N RCION
233 S %ZIS="NP0"
234 S %ZIS("A")="Enter the Default Printer for Printing Receipts: "
235 I RCTYPE=2 S %ZIS("A")="Enter the Default Printer for Printing the 215 Report: "
236 S %ZIS("B")=""
237 I RCTYPE=1,$$OPTCK("RECEIPT",3)'="" S %ZIS("B")=$$OPTCK("RECEIPT",3)
238 I RCTYPE=2,$$OPTCK("215REPORT",3)'="" S %ZIS("B")=$$OPTCK("215REPORT",3)
239 D ^%ZIS
240 I IO=IO(0) W !,"You cannot select your current device as a default printer." Q ""
241 S RCION=ION
242 ; reset current device
243 D ^%ZISC
244 Q RCION
245 ;
246SHEOB ; show EEOB detail if switch on - moved from RCDPRPLM
247 I $$OPTCK("SHOWEOB",2) D
248 . N Z
249 . S Z=$O(^RCY(344.4,"ARCT",RCRECTDA,0))
250 . Q:'Z
251 . S RCLINE=RCLINE+1 D SET^RCDPRPLM(" ",RCLINE,1,80)
252 . S RCLINE=RCLINE+1 D SET^RCDPRPLM("EEOB Detail:",RCLINE,1,80,0,IOUON,IOUOFF)
253 . K ^TMP($J,"RCDISP") D DISP^RCDPEDS(Z)
254 . S Z=0 F S Z=$O(^TMP($J,"RCDISP",Z)) Q:'Z S RCLINE=RCLINE+1 D SET^RCDPRPLM(^TMP($J,"RCDISP",Z),RCLINE,1,80)
255 . K ^TMP($J,"RCDISP")
256 Q
257 ;
Note: See TracBrowser for help on using the repository browser.