| [613] | 1 | PRCARPS ;SF-ISC/YJK-REPAYMENT PAYMENT STATEMENT ;10/23/93 9:50 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**104**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;PRINT THE PAYMENT STATEMENT FOR REPAYMENT PLAN
|
|---|
| 5 | N PRCALL
|
|---|
| 6 | BEGIN D BILL^PRCAUTL Q:'$D(PRCABN) S PRCA("BILLN")=$P(^PRCA(430,PRCABN,0),U,1),PRCA("DEBTOR")=$P(^(0),U,9)
|
|---|
| 7 | I '$D(^PRCA(430,PRCABN,5)) W !,*7,"NO REPAYMENT PLAN FOR THIS ACCOUNT.",! Q
|
|---|
| 8 | S PRCAREP=1 Q
|
|---|
| 9 | PRINTST S PRCAREP=0 D BEGIN G:PRCAREP=0 END D EN,KILLV G PRINTST
|
|---|
| 10 | EN S PRCAPT=0 D GETPT I PRCAPT=0 W !,"NO PAYMENT DATA!",! Q
|
|---|
| 11 | I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y K %DT
|
|---|
| 12 | S %ZIS="Q" D ^%ZIS Q:POP I IO=IO(0) D PRT Q
|
|---|
| 13 | I $D(IO("Q")) K IO("Q") D QUE D:IO'=IO(0) CLOSEDV Q
|
|---|
| 14 | U IO D PRT Q
|
|---|
| 15 | PRT K PRCAPP D GETPAY Q:'$D(PRCAPP) D SETLINE,GETPB,WRST^PRCARPS1
|
|---|
| 16 | I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y K %DT
|
|---|
| 17 | I PRCANOD>0 S $P(^PRCA(430,PRCABN,5,PRCANOD,0),U,3)=1,$P(^PRCA(430,PRCABN,5,PRCANOD,0),U,5)=DT
|
|---|
| 18 | D CLOSEDV Q
|
|---|
| 19 | QUE K ZTSK,ZTSAVE S ZTSAVE("PRCAPT")=PRCAPT,ZTSAVE("PRCADUE")=PRCADUE,ZTSAVE("PRCABN")=PRCABN,ZTSAVE("PRCA(""BILLN"")")=PRCA("BILLN"),ZTSAVE("PRCA(""DEBTOR"")")=PRCA("DEBTOR"),ZTSAVE("PRCANOD")=PRCANOD
|
|---|
| 20 | S ZTRTN="PRT^PRCARPS",ZTDESC="Repayment Plan Statement" D ^%ZTLOAD K ZTRTN,ZTSAVE Q
|
|---|
| 21 | CLOSEDV D ^%ZISC Q
|
|---|
| 22 | KILLV ;
|
|---|
| 23 | END K PRCAREP,PRCABN,PRCA,PRCAPP,PRCAPB,PRCALN,PRCAST1,PRCACITY,PRCA("DEBTNAM"),PRCA("DEBTOR"),I,PRCADT,PRCADUE,PRCAMT,PRCANOD,PRCAPT,PRCASSAN,PRCAKIP,PRCABN1,PRCA1,PRCATY,PRCARDT,PRCANO D KVAR^VADPT Q
|
|---|
| 24 | ;
|
|---|
| 25 | GETPT S PRCAKEN=+$P(^PRCA(430,PRCABN,5,0),U,4),(PRCADUE,PRCANOD)=0
|
|---|
| 26 | F Z=1:1:PRCAKEN I +$P(^PRCA(430,PRCABN,5,Z,0),U,4)>0,+$P(^(0),U,3)'>0 S PRCAPT=$P(^(0),U,4),PRCANOD=Z Q
|
|---|
| 27 | F Z=1:1:PRCAKEN I +$P(^PRCA(430,PRCABN,5,Z,0),U,2)<1 S PRCADUE=+$P(^(0),U,1) Q
|
|---|
| 28 | K Z,PRCAKEN Q
|
|---|
| 29 | GETPAY S PRCADT=$P(^PRCA(433,PRCAPT,1),U,1) Q:PRCADT=""
|
|---|
| 30 | S Y=PRCADT D DD^%DT
|
|---|
| 31 | S PRCADT=$E(PRCADT,4,5)_"/"_$E(PRCADT,6,7)_"/"_$P(Y,", ",2)
|
|---|
| 32 | S PRCAMT=+$P(^PRCA(433,PRCAPT,1),U,5) Q:PRCAMT'>0
|
|---|
| 33 | S Z3=$S($D(^PRCA(433,PRCAPT,3)):^(3),1:"") Q:Z3=""
|
|---|
| 34 | F Z=1:1:5 S PRCAPP(Z)=+$P(Z3,U,Z)
|
|---|
| 35 | K Z,Z3 Q
|
|---|
| 36 | GETPB S Z4=^PRCA(430,PRCABN,7)
|
|---|
| 37 | F Z=1:1:5 S PRCAPB(Z)=+$P(Z4,U,Z)
|
|---|
| 38 | K Z,Z4 Q
|
|---|
| 39 | SETLINE S PRCALN=0 S:IOM>87 PRCALN=7 S PRCALN(0)=25+PRCALN,PRCALN(1)=50+PRCALN,PRCALN(2)=52+PRCALN,PRCALN(3)=62+PRCALN,PRCALN(4)=64+PRCALN,PRCALN(5)=10+PRCALN,PRCALN(6)=30+PRCALN
|
|---|
| 40 | S PRCALL(1)=18+PRCALN,PRCALL(2)=20+PRCALN,PRCALL(3)=30+PRCALN,PRCALL(4)=32+PRCALN,PRCALL(5)=42+PRCALN,PRCALL(6)=44+PRCALN,PRCALL(7)=54+PRCALN,PRCALL(8)=56+PRCALN,PRCALL(9)=66+PRCALN,PRCALL(10)=68+PRCALN,PRCALL(11)=78+PRCALN Q
|
|---|
| 41 | ;==================== REPRINT STATEMENT ============================
|
|---|
| 42 | EN1 ;Reprint the payment statement.
|
|---|
| 43 | S PRCAREP=0 D BEGIN G:+PRCAREP=0 END
|
|---|
| 44 | K PRCARDT D DATE G:'$D(PRCARDT) END
|
|---|
| 45 | S PRCA1=0 D LOOK I PRCA1=0 W !,*7,"THE DATE DOES NOT MATCH !, PLEASE CHECK REPAYMENT PROFILE.",!! G END
|
|---|
| 46 | D CLDATE D EN,KILLV G EN1
|
|---|
| 47 | LOOK S Z1=0
|
|---|
| 48 | F Z0=0:0 S Z1=$O(^PRCA(430,PRCABN,5,Z1)) Q:+Z1'>0 I $P(^(Z1,0),U,5)=PRCARDT S PRCA1=1,PRCABN1=Z1 K Z1 Q
|
|---|
| 49 | K Z0 Q
|
|---|
| 50 | DATE S %DT="AE",%DT("A")="Enter the date the statement was printed: " D ^%DT Q:Y<0 S PRCARDT=+Y Q
|
|---|
| 51 | CLDATE Q:'$D(^PRCA(430,PRCABN,5,PRCABN1,0)) S $P(^(0),U,3)=0,$P(^(0),U,5)="" Q
|
|---|
