RCDPLPL2 ;WISC/RFJ-link payments listmanager options ;1 Jun 99
;;4.5;Accounts Receivable;**114,148**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
SHOWPAY ; this will show how a payment was applied to an account
D FULL^VALM1
S VALMBCK="R"
;
N %,ACCOUNT,BILLDA,DATA,RCRECTDA,RCTRANDA,RECEIPT,TRANDA
;
F W ! S RCRECTDA=+$$SELRECT^RCDPUREC(0,0) Q:RCRECTDA<1 D
. S RCTRANDA=+$$SELTRAN^RCDPURET(RCRECTDA) Q:RCTRANDA<1
. ;
. S ACCOUNT=$P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3)
. I 'ACCOUNT W !,"This payment is not linked, there is no account." Q
. ;
. S RECEIPT=$P(^RCY(344,RCRECTDA,0),"^")
. W !!," Receipt: ",RECEIPT
. W !," Transaction: ",RCTRANDA
. W !," Unapplied Deposit Number: ",$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
. W !," Total Paid Amount: ",$J($P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4),10,2)
. W !,"<searching>"
. ;
. S TRANDA=0
. F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
. . S BILLDA=+$P($G(^PRCA(433,TRANDA,0)),"^",2)
. . I $P($G(^RCD(340,+$P($G(^PRCA(430,BILLDA,0)),"^",9),0)),"^")=ACCOUNT D
. . . S DATA=$G(^PRCA(433,TRANDA,3))
. . . F %=1:1:11 W $C(8) ;backspace
. . . W " "
. . . W !?5,"Transaction: ",TRANDA
. . . W !?9," Principal Collected: ",$J($P(DATA,"^"),10,2)
. . . W !?9," Interest Collected: ",$J($P(DATA,"^",2),10,2)
. . . W !?9," Admin Collected: ",$J($P(DATA,"^",3),10,2)
. . . W !?9,"Marshal Fee Collected: ",$J($P(DATA,"^",4),10,2)
. . . W !?9," Court Cost Collected: ",$J($P(DATA,"^",5),10,2)
. . . W !,"<searching>"
. ;
. F %=1:1:11 W $C(8) ;backspace
. W " "
;
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPLPL2 1861 printed Dec 13, 2024@01:46:03 Page 2
RCDPLPL2 ;WISC/RFJ-link payments listmanager options ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SHOWPAY ; this will show how a payment was applied to an account
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 NEW %,ACCOUNT,BILLDA,DATA,RCRECTDA,RCTRANDA,RECEIPT,TRANDA
+5 ;
+6 FOR
WRITE !
SET RCRECTDA=+$$SELRECT^RCDPUREC(0,0)
if RCRECTDA<1
QUIT
Begin DoDot:1
+7 SET RCTRANDA=+$$SELTRAN^RCDPURET(RCRECTDA)
if RCTRANDA<1
QUIT
+8 ;
+9 SET ACCOUNT=$PIECE(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",3)
+10 IF 'ACCOUNT
WRITE !,"This payment is not linked, there is no account."
QUIT
+11 ;
+12 SET RECEIPT=$PIECE(^RCY(344,RCRECTDA,0),"^")
+13 WRITE !!," Receipt: ",RECEIPT
+14 WRITE !," Transaction: ",RCTRANDA
+15 WRITE !," Unapplied Deposit Number: ",$PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
+16 WRITE !," Total Paid Amount: ",$JUSTIFY($PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4),10,2)
+17 WRITE !,"<searching>"
+18 ;
+19 SET TRANDA=0
+20 FOR
SET TRANDA=$ORDER(^PRCA(433,"AF",RECEIPT,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:2
+21 SET BILLDA=+$PIECE($GET(^PRCA(433,TRANDA,0)),"^",2)
+22 IF $PIECE($GET(^RCD(340,+$PIECE($GET(^PRCA(430,BILLDA,0)),"^",9),0)),"^")=ACCOUNT
Begin DoDot:3
+23 SET DATA=$GET(^PRCA(433,TRANDA,3))
+24 ;backspace
FOR %=1:1:11
WRITE $CHAR(8)
+25 WRITE " "
+26 WRITE !?5,"Transaction: ",TRANDA
+27 WRITE !?9," Principal Collected: ",$JUSTIFY($PIECE(DATA,"^"),10,2)
+28 WRITE !?9," Interest Collected: ",$JUSTIFY($PIECE(DATA,"^",2),10,2)
+29 WRITE !?9," Admin Collected: ",$JUSTIFY($PIECE(DATA,"^",3),10,2)
+30 WRITE !?9,"Marshal Fee Collected: ",$JUSTIFY($PIECE(DATA,"^",4),10,2)
+31 WRITE !?9," Court Cost Collected: ",$JUSTIFY($PIECE(DATA,"^",5),10,2)
+32 WRITE !,"<searching>"
End DoDot:3
End DoDot:2
+33 ;
+34 ;backspace
FOR %=1:1:11
WRITE $CHAR(8)
+35 WRITE " "
End DoDot:1
+36 ;
+37 SET VALMBCK="R"
+38 QUIT
