RCDPRECT ;WISC/RFJ-print a receipt ;1 Jun 99
;;4.5;Accounts Receivable;**114,148,217,244,260**;Mar 20, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
RECEIPT(RCRECTDA,RCTRANDA) ; control printing of receipt for device selection
N %,IOP,PRINT
S PRINT=$$OPTCK^RCDPRPL2("RECEIPT",2)_"^"_$$OPTCK^RCDPRPL2("RECEIPT",3)
; if not defined by user, ask for the device
I PRINT="" S PRINT=2
;
; never print receipt
I $P(PRINT,"^")=0 Q
;
; always print receipt to default device
I $P(PRINT,"^")=1 D
. ; test device without opening it
. S IOP=$P(PRINT,"^",2) I IOP="" S PRINT=2 Q
. S %ZIS="N"
. D ^%ZIS I POP S PRINT=2 Q
. D QUEUEIT
;
; ask to print receipt
I $P(PRINT,"^")=2 S %=$$DEVICE
Q
;
;
DEVICE() ; select the device and print receipt
; returns 0 if not successful
S %ZIS("A")="Print Receipt on DEVICE: "
S %ZIS("B")=$$OPTCK^RCDPRPL2("RECEIPT",3)
S %ZIS="Q"
W ! D ^%ZIS
I POP D ^%ZISC Q 0
I $D(IO("Q")) D QUEUEIT Q "Print Receipt Queued"
D PRINT
Q "Receipt Printed"
;
;
QUEUEIT ; queue printing receipt
N ZTSK
S ZTDTH=$H,ZTDESC="Print Payment Receipt",ZTRTN="PRINT^RCDPRECT"
S ZTSAVE("RCRECTDA")="",ZTSAVE("RCTRANDA")="",ZTSAVE("ZTREQ")="@"
D ^%ZTLOAD
D ^%ZISC
Q
;
;
PRINT ; print a receipt
; requires variables rcrectda and rctranda
N %,%H,%I,ADDRESS,DATA,LINE,RCTYPE,X,Y,MSG
U IO
;
; print address for station at top
S ADDRESS=$$SADD^RCFN01(1)
W !?25,"Department Of Veterans Affairs"
F %=1,2,3 I $P(ADDRESS,"^",%)'="" W !?((80-$L($P(ADDRESS,"^",%)))/2),$P(ADDRESS,"^",%)
S ADDRESS=$P(ADDRESS,"^",4)_", "_$P(ADDRESS,"^",5)_" "_$P(ADDRESS,"^",6)
I $TR(ADDRESS,", ")'="" W !?((80-$L(ADDRESS))/2),ADDRESS
;
S LINE="",$P(LINE,"-",80)=""
W !,LINE
;
S %="*** Payment Receipt ***"
W !!?((80-$L(%))/2),%
;
; account and name
S DATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
I $P(DATA,"^",3)'="" D
. W !
. ; account from patient file
. I $P(DATA,"^",3)[";DPT(" D Q
. . W $P($G(^DPT(+$P(DATA,"^",3),0)),"^")
. . S %=$$SSN^RCFN01($P(DATA,"^",3))
. . I $E(%,6,9)'="" W " (",$E(%,6,9),")"
. ;
. ; account from bill file
. W $P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^")
. W " "
. W $$NAM^RCFN01($P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^",9))
. S %=$$SSN^RCFN01($P($G(^PRCA(430,+$P(DATA,"^",3),0)),"^",9))
. I $E(%,6,9)'="" W " (",$E(%,6,9),")"
;
W !," Receipt #: ",$P(^RCY(344,RCRECTDA,0),"^"),"/",$P(DATA,"^")
D NOW^%DTC S Y=X D DD^%DT
W ?53,"Date: ",Y
W !," Payment Type: ",$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
S Y=$P(DATA,"^",6) I Y D DD^%DT
W ?45,"Payment Date: ",Y
;
S RCTYPE=$P($G(^RC(341.1,+$P(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
; type = 3 (district counsel), 4 (check), 5 (dept of justice)
I RCTYPE=3!(RCTYPE=4)!(RCTYPE=5) D
. W !," Check #: ",$P(DATA,"^",7)
. S Y=$P(DATA,"^",10) I Y D DD^%DT
. W ?47,"Check Date: ",Y
. W !," Bank #: ",$P(DATA,"^",8)
;
; type = 7 (credit card)
I RCTYPE=7 D
. W !," Last 4 of Credit Card #: ",$E($P(DATA,"^",11),$L($P(DATA,"^",11))-3,$L($P(DATA,"^",11)))
. W !," Confirmation#: ",$P(DATA,"^",2)
;
W !,"Payment Amount: $ ",$J($P(DATA,"^",4),0,2)
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)
;
W !!,"IMPORTANT"
W !!,"Note that checks or drafts are not valid until paid by your bank."
W !!,"This receipt should be retained for your records."
W !,"A detailed listing of how your payment has been applied to your"
W !,"account will be provided on your patient statement, which you"
W !,"will receive in the mail at a later date."
S MSG="THANK YOU FOR YOUR PAYMENT"
W !!,?((80-$L(MSG))/2),MSG
W !!,LINE
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPRECT 3896 printed Sep 23, 2025@19:22:21 Page 2
RCDPRECT ;WISC/RFJ-print a receipt ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148,217,244,260**;Mar 20, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
RECEIPT(RCRECTDA,RCTRANDA) ; control printing of receipt for device selection
+1 NEW %,IOP,PRINT
+2 SET PRINT=$$OPTCK^RCDPRPL2("RECEIPT",2)_"^"_$$OPTCK^RCDPRPL2("RECEIPT",3)
+3 ; if not defined by user, ask for the device
+4 IF PRINT=""
SET PRINT=2
+5 ;
+6 ; never print receipt
+7 IF $PIECE(PRINT,"^")=0
QUIT
+8 ;
+9 ; always print receipt to default device
+10 IF $PIECE(PRINT,"^")=1
Begin DoDot:1
+11 ; test device without opening it
+12 SET IOP=$PIECE(PRINT,"^",2)
IF IOP=""
SET PRINT=2
QUIT
+13 SET %ZIS="N"
+14 DO ^%ZIS
IF POP
SET PRINT=2
QUIT
+15 DO QUEUEIT
End DoDot:1
+16 ;
+17 ; ask to print receipt
+18 IF $PIECE(PRINT,"^")=2
SET %=$$DEVICE
+19 QUIT
+20 ;
+21 ;
DEVICE() ; select the device and print receipt
+1 ; returns 0 if not successful
+2 SET %ZIS("A")="Print Receipt on DEVICE: "
+3 SET %ZIS("B")=$$OPTCK^RCDPRPL2("RECEIPT",3)
+4 SET %ZIS="Q"
+5 WRITE !
DO ^%ZIS
+6 IF POP
DO ^%ZISC
QUIT 0
+7 IF $DATA(IO("Q"))
DO QUEUEIT
QUIT "Print Receipt Queued"
+8 DO PRINT
+9 QUIT "Receipt Printed"
+10 ;
+11 ;
QUEUEIT ; queue printing receipt
+1 NEW ZTSK
+2 SET ZTDTH=$HOROLOG
SET ZTDESC="Print Payment Receipt"
SET ZTRTN="PRINT^RCDPRECT"
+3 SET ZTSAVE("RCRECTDA")=""
SET ZTSAVE("RCTRANDA")=""
SET ZTSAVE("ZTREQ")="@"
+4 DO ^%ZTLOAD
+5 DO ^%ZISC
+6 QUIT
+7 ;
+8 ;
PRINT ; print a receipt
+1 ; requires variables rcrectda and rctranda
+2 NEW %,%H,%I,ADDRESS,DATA,LINE,RCTYPE,X,Y,MSG
+3 USE IO
+4 ;
+5 ; print address for station at top
+6 SET ADDRESS=$$SADD^RCFN01(1)
+7 WRITE !?25,"Department Of Veterans Affairs"
+8 FOR %=1,2,3
IF $PIECE(ADDRESS,"^",%)'=""
WRITE !?((80-$LENGTH($PIECE(ADDRESS,"^",%)))/2),$PIECE(ADDRESS,"^",%)
+9 SET ADDRESS=$PIECE(ADDRESS,"^",4)_", "_$PIECE(ADDRESS,"^",5)_" "_$PIECE(ADDRESS,"^",6)
+10 IF $TRANSLATE(ADDRESS,", ")'=""
WRITE !?((80-$LENGTH(ADDRESS))/2),ADDRESS
+11 ;
+12 SET LINE=""
SET $PIECE(LINE,"-",80)=""
+13 WRITE !,LINE
+14 ;
+15 SET %="*** Payment Receipt ***"
+16 WRITE !!?((80-$LENGTH(%))/2),%
+17 ;
+18 ; account and name
+19 SET DATA=$GET(^RCY(344,RCRECTDA,1,RCTRANDA,0))
+20 IF $PIECE(DATA,"^",3)'=""
Begin DoDot:1
+21 WRITE !
+22 ; account from patient file
+23 IF $PIECE(DATA,"^",3)[";DPT("
Begin DoDot:2
+24 WRITE $PIECE($GET(^DPT(+$PIECE(DATA,"^",3),0)),"^")
+25 SET %=$$SSN^RCFN01($PIECE(DATA,"^",3))
+26 IF $EXTRACT(%,6,9)'=""
WRITE " (",$EXTRACT(%,6,9),")"
End DoDot:2
QUIT
+27 ;
+28 ; account from bill file
+29 WRITE $PIECE($GET(^PRCA(430,+$PIECE(DATA,"^",3),0)),"^")
+30 WRITE " "
+31 WRITE $$NAM^RCFN01($PIECE($GET(^PRCA(430,+$PIECE(DATA,"^",3),0)),"^",9))
+32 SET %=$$SSN^RCFN01($PIECE($GET(^PRCA(430,+$PIECE(DATA,"^",3),0)),"^",9))
+33 IF $EXTRACT(%,6,9)'=""
WRITE " (",$EXTRACT(%,6,9),")"
End DoDot:1
+34 ;
+35 WRITE !," Receipt #: ",$PIECE(^RCY(344,RCRECTDA,0),"^"),"/",$PIECE(DATA,"^")
+36 DO NOW^%DTC
SET Y=X
DO DD^%DT
+37 WRITE ?53,"Date: ",Y
+38 WRITE !," Payment Type: ",$PIECE($GET(^RC(341.1,+$PIECE(^RCY(344,RCRECTDA,0),"^",4),0)),"^")
+39 SET Y=$PIECE(DATA,"^",6)
IF Y
DO DD^%DT
+40 WRITE ?45,"Payment Date: ",Y
+41 ;
+42 SET RCTYPE=$PIECE($GET(^RC(341.1,+$PIECE(^RCY(344,RCRECTDA,0),"^",4),0)),"^",2)
+43 ; type = 3 (district counsel), 4 (check), 5 (dept of justice)
+44 IF RCTYPE=3!(RCTYPE=4)!(RCTYPE=5)
Begin DoDot:1
+45 WRITE !," Check #: ",$PIECE(DATA,"^",7)
+46 SET Y=$PIECE(DATA,"^",10)
IF Y
DO DD^%DT
+47 WRITE ?47,"Check Date: ",Y
+48 WRITE !," Bank #: ",$PIECE(DATA,"^",8)
End DoDot:1
+49 ;
+50 ; type = 7 (credit card)
+51 IF RCTYPE=7
Begin DoDot:1
+52 WRITE !," Last 4 of Credit Card #: ",$EXTRACT($PIECE(DATA,"^",11),$LENGTH($PIECE(DATA,"^",11))-3,$LENGTH($PIECE(DATA,"^",11)))
+53 WRITE !," Confirmation#: ",$PIECE(DATA,"^",2)
End DoDot:1
+54 ;
+55 WRITE !,"Payment Amount: $ ",$JUSTIFY($PIECE(DATA,"^",4),0,2)
+56 WRITE ?42,"Account Balance: $ ",$JUSTIFY($$BAL^PRCAFN($SELECT($PIECE(DATA,"^",3)[";PRCA(430":$PIECE(^PRCA(430,+$PIECE(DATA,"^",3),0),"^",9),1:$PIECE(DATA,"^",3))),0,2)
+57 ;
+58 WRITE !!,"IMPORTANT"
+59 WRITE !!,"Note that checks or drafts are not valid until paid by your bank."
+60 WRITE !!,"This receipt should be retained for your records."
+61 WRITE !,"A detailed listing of how your payment has been applied to your"
+62 WRITE !,"account will be provided on your patient statement, which you"
+63 WRITE !,"will receive in the mail at a later date."
+64 SET MSG="THANK YOU FOR YOUR PAYMENT"
+65 WRITE !!,?((80-$LENGTH(MSG))/2),MSG
+66 WRITE !!,LINE
+67 DO ^%ZISC
+68 QUIT
