source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRECT.m@ 1556

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1RCDPRECT ;WISC/RFJ-print a receipt ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148,217,244**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7RECEIPT(RCRECTDA,RCTRANDA) ; control printing of receipt for device selection
8 N %,IOP,PRINT
9 S PRINT=$$OPTCK^RCDPRPL2("RECEIPT",2)_"^"_$$OPTCK^RCDPRPL2("RECEIPT",3)
10 ; if not defined by user, ask for the device
11 I PRINT="" S PRINT=2
12 ;
13 ; never print receipt
14 I $P(PRINT,"^")=0 Q
15 ;
16 ; always print receipt to default device
17 I $P(PRINT,"^")=1 D
18 . ; test device without opening it
19 . S IOP=$P(PRINT,"^",2) I IOP="" S PRINT=2 Q
20 . S %ZIS="N"
21 . D ^%ZIS I POP S PRINT=2 Q
22 . D QUEUEIT
23 ;
24 ; ask to print receipt
25 I $P(PRINT,"^")=2 S %=$$DEVICE
26 Q
27 ;
28 ;
29DEVICE() ; select the device and print receipt
30 ; returns 0 if not successful
31 S %ZIS("A")="Print Receipt on DEVICE: "
32 S %ZIS("B")=$$OPTCK^RCDPRPL2("RECEIPT",3)
33 S %ZIS="Q"
34 W ! D ^%ZIS
35 I POP D ^%ZISC Q 0
36 I $D(IO("Q")) D QUEUEIT Q "Print Receipt Queued"
37 D PRINT
38 Q "Receipt Printed"
39 ;
40 ;
41QUEUEIT ; queue printing receipt
42 N ZTSK
43 S ZTDTH=$H,ZTDESC="Print Payment Receipt",ZTRTN="PRINT^RCDPRECT"
44 S ZTSAVE("RCRECTDA")="",ZTSAVE("RCTRANDA")="",ZTSAVE("ZTREQ")="@"
45 D ^%ZTLOAD
46 D ^%ZISC
47 Q
48 ;
49 ;
50PRINT ; print a receipt
51 ; requires variables rcrectda and rctranda
52 N %,%H,%I,ADDRESS,DATA,LINE,RCTYPE,X,Y
53 U IO
54 ;
55 ; print address for station at top
56 S ADDRESS=$$SADD^RCFN01(1)
57 W !?25,"Department Of Veterans Affairs"
58 F %=1,2,3 I $P(ADDRESS,"^",%)'="" W !?((80-$L($P(ADDRESS,"^",%)))/2),$P(ADDRESS,"^",%)
59 S ADDRESS=$P(ADDRESS,"^",4)_", "_$P(ADDRESS,"^",5)_" "_$P(ADDRESS,"^",6)
60 I $TR(ADDRESS,", ")'="" W !?((80-$L(ADDRESS))/2),ADDRESS
61 ;
62 S LINE="",$P(LINE,"-",80)=""
63 W !,LINE
64 ;
65 S %="*** Payment Receipt ***"
66 W !!?((80-$L(%))/2),%
67 ;
68 ; account and name
69 S DATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
70 I $P(DATA,"^",3)'="" D
71 . W !
72 . ; account from patient file
73 . I $P(DATA,"^",3)[";DPT(" D Q
74 . . W $P($G(^DPT(+$P(DATA,"^",3),0)),"^")
75 . . S %=$$SSN^RCFN01($P(DATA,"^",3))
76 . . I $E(%,6,9)'="" W " (",$E(%,6,9),")"
77 . ;
78 . ; account from bill file
79 . W $P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^")
80 . W " "
81 . W $$NAM^RCFN01($P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^",9))
82 . S %=$$SSN^RCFN01($P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^",9))
83 . I $E(%,6,9)'="" W " (",$E(%,6,9),")"
84 ;
85 W !," Receipt #: ",$P(^RCY(344,RCRECTDA,0),"^"),"/",$P(DATA,"^")
86 D NOW^%DTC S Y=X D DD^%DT
87 W ?53,"Date: ",Y
88 W !," Payment Type: ",$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
89 S Y=$P(DATA,"^",6) I Y D DD^%DT
90 W ?45,"Payment Date: ",Y
91 ;
92 S RCTYPE=$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
93 ; type = 3 (district counsel), 4 (check), 5 (dept of justice)
94 I RCTYPE=3!(RCTYPE=4)!(RCTYPE=5) D
95 . W !," Check #: ",$P(DATA,"^",7)
96 . S Y=$P(DATA,"^",10) I Y D DD^%DT
97 . W ?47,"Check Date: ",Y
98 . W !," Bank #: ",$P(DATA,"^",8)
99 ;
100 ; type = 7 (credit card)
101 I RCTYPE=7 D
102 . W !," Last 4 of Credit Card #: ",$E($P(DATA,"^",11),$L($P(DATA,"^",11))-3,$L($P(DATA,"^",11)))
103 . W !," Confirmation#: ",$P(DATA,"^",2)
104 ;
105 W !,"Payment Amount: $ ",$J($P(DATA,"^",4),0,2)
106 W ?42,"Account Balance: $ ",$J($$BAL^PRCAFN($S($P(DATA,"^",3)[";PRCA(430":$P(^PRCA(430,+$P(DATA,"^",3),0),"^",9),1:$P(DATA,"^",3))),0,2)
107 ;
108 W !!,"IMPORTANT"
109 W !!,"Note that checks or drafts are not valid until paid by your bank."
110 W !!,"This receipt should be retained for your records."
111 W !,"A detailed listing of how your payment has been applied to your"
112 W !,"account will be provided on your patient statement, which you"
113 W !,"will receive in the mail at a later date."
114 W !!,LINE
115 D ^%ZISC
116 Q
Note: See TracBrowser for help on using the repository browser.