source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCACOL.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PRCACOL ;WASH-ISC@ALTOONA,PA/LDB-Payment History Report ;9/27/93 4:31 PM
2V ;;4.5;Accounts Receivable;**165,198**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ;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 ;
27DQ ;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 ;
34EXIT1 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
37EXIT2 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 ;
43TRANS ;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 ;
57PRINT ;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 ;
79SCRN ;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 ;
85HDR ;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
Note: See TracBrowser for help on using the repository browser.