- 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 Jan 18, 2025@02:47:16 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