| 1 | PRCACOL ;WASH-ISC@ALTOONA,PA/LDB-Payment History Report ;9/27/93 4:31 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**165,198**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;Ask debtor and date range for payment history
|
|---|
| 6 | N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1
|
|---|
| 7 | K DIR S POP=0
|
|---|
| 8 | S DIR(0)="PO^340:QEAMZ",DIR("A")="Select Patient ",DIR("?")="Enter a Patient name" D ^DIR
|
|---|
| 9 | I $D(DIRUT)!(Y="") G EXIT1
|
|---|
| 10 | I $P($G(^RCD(340,+Y,0)),U)'["DPT" W *7 G EN
|
|---|
| 11 | S DEBTOR=+Y K DIR
|
|---|
| 12 | I '$D(^PRCA(433,"ATD",DEBTOR)) W !,"This patient has made no payments." Q
|
|---|
| 13 | S BDATE=$S(($$LST^RCFN01(DEBTOR,2)<0):$$FMADD^XLFDT(DT,-30),1:+$$LST^RCFN01(DEBTOR,2)),DIR(0)="DO^2880101:DT",DIR("A")="Payment history beginning date",DIR("B")=$$FMTE^XLFDT(BDATE,"1D")
|
|---|
| 14 | S DIR("?")="The default date is either the last statement day or T-30, but any date may be entered."
|
|---|
| 15 | D ^DIR
|
|---|
| 16 | S:Y'="" BDATE=Y I $D(DIRUT)&'Y G EXIT1 Q
|
|---|
| 17 | K DIR,X,Y
|
|---|
| 18 | S DIR(0)="DO^"_BDATE_":DT",DIR("A")="Payment history ending date",DIR("B")=$$FMTE^XLFDT(DT,"1D")
|
|---|
| 19 | D ^DIR S:Y="" Y=DT I $D(DIRUT)&'Y G EXIT1 Q
|
|---|
| 20 | S EDATE=Y
|
|---|
| 21 | K DIR
|
|---|
| 22 | S %ZIS="AEQ" D ^%ZIS G:POP EXIT1
|
|---|
| 23 | I $D(IO("Q")) D Q
|
|---|
| 24 | .S ZTSAVE("DEBTOR")="",ZTSAVE("BDATE")="",ZTSAVE("EDATE")="",ZTRTN="DQ^PRCACOL",ZTDESC="Patient Payment/Refund Transaction History Report"
|
|---|
| 25 | .D ^%ZTLOAD,^%ZISC,EXIT1 K ZTSAVE,ZTRTN Q
|
|---|
| 26 | ;
|
|---|
| 27 | DQ ;Call to build array of payment transactions
|
|---|
| 28 | ;
|
|---|
| 29 | U IO
|
|---|
| 30 | D TRANS
|
|---|
| 31 | I '$D(^TMP($J,"PRCACOL")) D HDR W !!,"This patient has no payments or refunds during this time period."
|
|---|
| 32 | I $D(^TMP($J)) D HDR,PRINT
|
|---|
| 33 | ;
|
|---|
| 34 | EXIT1 K AMT,BDATE,EDATE,DATE,DEBTOR,DIR,DUOUT,DX,DY,LINE,PG,PNODE,TN,X,Y,ZTSK,TOTPD,TOTREF,TOTPRIN,TOTINT,TOTADM,^TMP($J),^UTILITY($J)
|
|---|
| 35 | I $D(DIRUT)!POP K DIRUT,POP Q
|
|---|
| 36 | ;end of routine
|
|---|
| 37 | EXIT2 I $E(IOST,1,2)'="C-" W @IOF D ^%ZISC Q
|
|---|
| 38 | I $E(IOST,1,2)="C-" D ENS^%ZISS S DY=IOM-1,DX=0 X IOXY D KILL^%ZISS K DIR,X,Y,^UTILITY($J) S DIR(0)="E" D ^DIR
|
|---|
| 39 | I $D(DIRUT) K DIRUT Q
|
|---|
| 40 | D ^%ZISC
|
|---|
| 41 | G EN
|
|---|
| 42 | ;
|
|---|
| 43 | TRANS ;Build array of transactions
|
|---|
| 44 | S (PG,TOTPD,TOTREF,TOTPRIN,TOTINT,TOTADM)=0,$P(LINE,"-",75)="-" K ^TMP($J) D DT^DICRW
|
|---|
| 45 | S BILL=0 F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:'BILL D
|
|---|
| 46 | .S TN=0 F S TN=$O(^PRCA(433,"C",+BILL,TN)) Q:'TN D
|
|---|
| 47 | ..I $D(^PRCA(433,TN,0)),$D(^(1)),"^2^34^41^"[("^"_$P(^(1),"^",2)_"^") D
|
|---|
| 48 | ...; if transaction is not complete (2), do not display it
|
|---|
| 49 | ...I $P(^PRCA(433,TN,0),"^",4)'=2 Q
|
|---|
| 50 | ...S X=^PRCA(433,TN,1),DATE=+X Q:DATE<BDATE!(+X>EDATE)
|
|---|
| 51 | ...S ^TMP($J,"PRCACOL",DATE,TN)=$P($G(^PRCA(433,+TN,0)),U,2)_U_$P(X,U)_U_$S($P(X,U,2)=41:"Y",1:"")_U_$P(X,U,3)_U_$P(X,U,5)
|
|---|
| 52 | ...S:$P(^TMP($J,"PRCACOL",DATE,TN),U,3)'="Y" TOTPD=TOTPD+$P(X,U,5) S:$P(^(TN),U,3)="Y" TOTREF=TOTREF+$P(X,U,5)
|
|---|
| 53 | ...I $D(^PRCA(433,TN,3)) S X=^(3),^TMP($J,"PRCACOL",DATE,TN)=^TMP($J,"PRCACOL",DATE,TN)_U_$P(X,U)_U_$P(X,U,2)_U_$P(X,U,3) D
|
|---|
| 54 | ....S:$P(^TMP($J,"PRCACOL",DATE,TN),U,3)'="Y" TOTPRIN=TOTPRIN+$P(X,U),TOTINT=TOTINT+$P(X,U,2),TOTADM=TOTADM+$P(X,U,3)
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | PRINT ;Print transactions
|
|---|
| 58 | S DATE=0 F S DATE=$O(^TMP($J,"PRCACOL",DATE)) Q:'DATE Q:$D(DIRUT) D
|
|---|
| 59 | .S TN=0 F S TN=$O(^TMP($J,"PRCACOL",DATE,TN)) Q:'TN D SCRN Q:$D(DIRUT) D
|
|---|
| 60 | ..S PNODE=^TMP($J,"PRCACOL",DATE,TN) W !,$$FMTE^XLFDT($P(PNODE,U,2),"1D"),?15,$P($G(^PRCA(430,+$P(PNODE,U),0)),U)
|
|---|
| 61 | ..W ?27,$P(PNODE,U,3),?32,$P(PNODE,U,4),?42 S AMT=$P(PNODE,U,5) W $J(AMT,6,2)
|
|---|
| 62 | ..F X=1:1:3 S X(X)=$P(PNODE,U,X+5) W:X=1 ?50,$J(X(X),6,2) W:X=2 ?58,$J(X(X),6,2) W:X=3 ?66,$J(X(X),6,2)
|
|---|
| 63 | ..D SCRN Q:$D(DIRUT)
|
|---|
| 64 | ..Q
|
|---|
| 65 | .Q
|
|---|
| 66 | ;
|
|---|
| 67 | D SCRN Q:$D(DIRUT)
|
|---|
| 68 | W !!,?25," Total Principal Paid: ",?50,$J(TOTPRIN,12,2)
|
|---|
| 69 | D SCRN Q:$D(DIRUT)
|
|---|
| 70 | W !,?25," Total Interest Paid: ",?50,$J(TOTINT,12,2)
|
|---|
| 71 | D SCRN Q:$D(DIRUT)
|
|---|
| 72 | W !,?25," Total Admin Paid: ",?50,$J(TOTADM,12,2)
|
|---|
| 73 | D SCRN Q:$D(DIRUT)
|
|---|
| 74 | W !,?25," Total Paid: ",?50,$J(TOTPD,12,2)
|
|---|
| 75 | D SCRN Q:$D(DIRUT)
|
|---|
| 76 | W !,?25," Total Refund: ",?50,$J(TOTREF,12,2)
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | SCRN ;Check for screen
|
|---|
| 80 | K DIR I ($Y+3)>IOSL D
|
|---|
| 81 | .I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR Q:$D(DIRUT)
|
|---|
| 82 | .D HDR
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | HDR ;Heading for report
|
|---|
| 86 | S PG=PG+1
|
|---|
| 87 | W @IOF,!,?20,"Patient Payment History Report",?70,"Page ",PG
|
|---|
| 88 | W !,?20,"------------------------------"
|
|---|
| 89 | W !!,?18,"For Patient: ",$$NAM^RCFN01(DEBTOR),!,?25,"SSN : ",$$SSN^RCFN01(DEBTOR)
|
|---|
| 90 | W !,?20,"For dates: ",$$FMTE^XLFDT(BDATE,"ID"),"-",$$FMTE^XLFDT(EDATE,"1D")
|
|---|
| 91 | W !!," DATE OF",!,"PAYMENT/REFUND",?16,"BILL #",?25,"REFUND",?32,"RECEIPT #",?42,"AMOUNT",?51,"PRIN.",?59,"INT.",?67,"ADMIN.",!,LINE
|
|---|
| 92 | Q
|
|---|
