| 1 | PRCAREP ;SF-ISC/YJK-CREATE REPAYMENT DATE SCHEDULE ;10/15/93 9:47 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;This sets up repayment schedule for A/R.
|
|---|
| 5 | BEGIN K DIC
|
|---|
| 6 | EN W !! D BILL^PRCAUTL G:('$D(PRCABN)) END I +PRCA("STATUS")>0,$P(^PRCA(430.3,PRCA("STATUS"),0),U,3)'=102 W !,*7,"NOT AN ACTIVE ACCOUNT !" G EN
|
|---|
| 7 | I $D(^PRCA(430,PRCABN,5)) W *7,!,"THIS ACCOUNT ALREADY HAS A REPAYMENT PLAN !",!
|
|---|
| 8 | S PRCAPB=$S($D(^PRCA(430,PRCABN,7)):$P(^(7),U,1)+$P(^(7),U,2)+$P(^(7),U,3)+$P(^(7),U,4)+$P(^(7),U,5),1:$P(^(0),U,3)),PRCAMT=0
|
|---|
| 9 | S PRCADT="" D DIE G:PRCA("LOCK")=1 EN I (+PRCADT>0)&(+PRCAMT>0) D SET G EN
|
|---|
| 10 | I '$D(^PRCA(430,PRCABN,4)) W !,"NO REPAYMENT PLAN!",*7 K ^PRCA(430,PRCABN,5) G EN
|
|---|
| 11 | I $P(^PRCA(430,PRCABN,4),U,1)="" W *7,!,"NO REPAYMENT PLAN !" K ^PRCA(430,PRCABN,5) G EN
|
|---|
| 12 | W !,"NOTHING CHANGED !",! G EN
|
|---|
| 13 | ;
|
|---|
| 14 | DIE S DIC="^PRCA(430,",DIE=DIC,DA=PRCABN,DR="41;S PRCADT=X;42;S PRCADAY=X;43;S PRCAMT=X" S PRCA("LOCK")=0 D LOCKF^PRCAWO1 D:PRCA("LOCK")=0 ^DIE
|
|---|
| 15 | K DIE,DR L -^PRCA(430,+$G(PRCABN)) Q ;end of DIE
|
|---|
| 16 | SET S PRCANPAY=PRCAPB/PRCAMT,PRCANPAY=$S(PRCANPAY>(PRCAPB\PRCAMT):PRCAPB\PRCAMT+1,1:PRCAPB\PRCAMT)
|
|---|
| 17 | W !!,"NUMBER OF PAYMENTS WILL BE ",PRCANPAY,! I PRCANPAY>60 W !,*7,"THIS NUMBER SHOULD BE LESS THAN 60 !, CHECK THE INPUT AGAIN",! Q
|
|---|
| 18 | S %DT="AEFX",%DT("A")="DUE DATE OF 1ST PAYMENT: " D ^%DT K %DT
|
|---|
| 19 | I Y<0 W !,*7,"NOTHING CHANGED !" Q
|
|---|
| 20 | K ^PRCA(430,PRCABN,5) S PRCAYR=$E(Y,1,3),PRCAMON=$E(Y,4,5) S:$L(PRCADAY)=1 PRCADAY="0"_PRCADAY D HOLD^PRCAUT1
|
|---|
| 21 | F Z0=1:1:PRCANPAY S Z1=PRCAYR_$S((PRCAMON<10&($E(PRCAMON,1)'=0)):0_PRCAMON,1:PRCAMON)_PRCADAY,^PRCA(430,DA,5,Z0,0)=Z1_U_"0",PRCAMON=PRCAMON+1 S:PRCAMON=13 PRCAMON=1,PRCAYR=PRCAYR+1
|
|---|
| 22 | S ^PRCA(430,DA,5,0)="^430.051DA^"_PRCANPAY_"^"_PRCANPAY,$P(^PRCA(430,DA,4),U,4)=PRCANPAY
|
|---|
| 23 | S PRCAKTY=$O(^PRCA(430.3,"AC",16,"")) D TRAN,IXDIK S $P(^PRCA(433,PRCAEN,0),U,4)=2
|
|---|
| 24 | W !!,"THE REPAYMENT PLAN HAS BEEN ESTABLISHED.",!
|
|---|
| 25 | EXIT K PRCAKTY,PRCAMON,PRCAYR,PRCANPAY,DA1,DIK,DA Q ;end of SET
|
|---|
| 26 | IXDIK S DIK="^PRCA(430,"_PRCABN_",5,",DA(1)=PRCABN D IXALL^DIK K DIK Q
|
|---|
| 27 | TRAN S PRCAEN=-1 D SETTR^PRCAUTL Q:PRCAEN<0 S DA=PRCAEN
|
|---|
| 28 | S DIE="^PRCA(433,",DR=".03////"_PRCABN_";11///"_PRCADT_";12///"_PRCAKTY_";15///"_PRCAPB_"" D ^DIE
|
|---|
| 29 | K DIE,DR,PRCADT Q
|
|---|
| 30 | END K PRCAS,PRCAMT,PRCA,PRCAKTY,PRCADT,DA,DIE,PRCAYR,PRCAMON,PRCANPAY,DR,PRCAEN,PRCABN,PRCAPB,Z0,PRCADAY,DIC,PRCAS,PRCATY D KVAR^VADPT Q ;end of PRCAREP
|
|---|
| 31 | PROFILE ;print the repayment plan profile.
|
|---|
| 32 | K %ZIS,DXS,IOP
|
|---|
| 33 | D BILL^PRCAUTL G:'$D(PRCABN) END
|
|---|
| 34 | S %ZIS="Q" D ^%ZIS Q:POP S IOM=80,PRCAIO=IO,PRCAIO(0)=IO(0)
|
|---|
| 35 | I IO=IO(0) W:$D(IOF) @IOF D TR,CLOSE K PRCAIO,PRCATY G PROFILE
|
|---|
| 36 | I $D(IO("Q")) K IO("Q") S ZTRTN="TR^PRCAREP",ZTSAVE("PRCABN")=PRCABN,ZTSAVE("PRCAIO(0)")=PRCAIO(0),ZTSAVE("PRCAIO")=PRCAIO,ZTDESC="Repayment Plan Profile"
|
|---|
| 37 | I D ^%ZTLOAD,CLOSE W:(IOM-$X)<20 ! W " <REQUEST QUEUED>",*7,! K PRCA,PRCATY G PROFILE
|
|---|
| 38 | U IO D TR,CLOSE G PROFILE
|
|---|
| 39 | TR S D0=PRCABN K DXS D ^PRCATR1 K DXS W !! K PRCABN,PRCAKTY,PRCA Q
|
|---|
| 40 | CLOSE D ^%ZISC K IOP,%ZIS,PRCAIO Q
|
|---|
