| [613] | 1 | PRCALST ;SF-ISC/YJK-AR LIST,REPORT ;6/20/95 9:50 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**17,63,107**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;This is a routine for list of new accounts, accounts with
|
|---|
| 5 | ;incompleted data , RC/DOJ ,pending CALM code sheet.
|
|---|
| 6 | PENDBIL ;list the pending CALM code sheet accounts.
|
|---|
| 7 | S PRCAHDR="@",(PRCAFT,PRCALAST)=",107",PRCATEMP="[PRCAT NEW AR]"
|
|---|
| 8 | WRLST S DIC="^PRCA(430," S:'$D(PRCATEMP) PRCATEMP="[PRCA AR LIST]"
|
|---|
| 9 | S PRCASORT="DATE BILL PREPARED,@CURRENT STATUS:STATUS NUMBER"
|
|---|
| 10 | D PRINT^PRCAREPT Q
|
|---|
| 11 | ;
|
|---|
| 12 | INCOMPL S PRCAHDR="INCOMPLETE ACCOUNTS RECEIVABLE",(PRCAFT,PRCALAST)=",101"
|
|---|
| 13 | D WRLST Q
|
|---|
| 14 | ;
|
|---|
| 15 | NEWBILL ;list new bills
|
|---|
| 16 | S PRCAHDR="LIST OF NEW BILLS",(PRCAFT,PRCALAST)=",104"
|
|---|
| 17 | S PRCATEMP="[PRCA NEWB LIST]" D WRLST Q
|
|---|
| 18 | ;
|
|---|
| 19 | WROFF ;list of written-off accounts receivable.
|
|---|
| 20 | S PRCAHDR="LIST OF WRITTEN-OFF ACCOUNTS RECEIVABLE",(PRCAFT,PRCALAST)=",109"
|
|---|
| 21 | D WRLST Q
|
|---|
| 22 | ;
|
|---|
| 23 | ACTBIL ;list of active accounts receivable
|
|---|
| 24 | S PRCAHDR="LIST OF ACTIVE ACCOUNTS RECEIVABLE",(PRCAFT,PRCALAST)=",102"
|
|---|
| 25 | D WRLST Q
|
|---|
| 26 | ;
|
|---|
| 27 | RETNAR ;returned AR list
|
|---|
| 28 | S PRCAHDR="RETURNED AR LIST",PRCASORT="@CURRENT STATUS:STATUS NUMBER,@DATE RETURNED TO SERVICE",PRCAFT="220,",PRCALAST="230,"
|
|---|
| 29 | S PRCATEMP="[PRCAC RETURN AR]",DIC="^PRCA(430," D PRINT^PRCAREPT Q
|
|---|
| 30 | ;
|
|---|
| 31 | RC ;list of AR to be referred to RC
|
|---|
| 32 | N PRCA
|
|---|
| 33 | S PRCAHDR="ACCOUNTS RECEIVABLE POSSIBLE REFERRALS TO REGIONAL COUNSEL" D MINMAX
|
|---|
| 34 | S PRCASORT="DEBTOR,@OVER LETTER3,@RC/DOJ REFERRAL DATE,@CURRENT STATUS:STATUS NUMBER",PRCAFT=",30,@,102",PRCALAST=",,@,102",PRCATEMP="[PRCAL L DC-DOJ]",DIS(0)="I $D(^PRCA(430,D0,7)),+^(7)'<PRCAMIN,+^(7)'>PRCAMAX"
|
|---|
| 35 | S DIC="^PRCA(430,"
|
|---|
| 36 | S:$D(ZTSK) IOP=ION
|
|---|
| 37 | D @$S($D(ZTSK):"DIP^PRCAREPT",1:"PRINT^PRCAREPT")
|
|---|
| 38 | K DIOBEG,DIS,PRCAMIN,PRCAMAX Q
|
|---|
| 39 | ;
|
|---|
| 40 | DOJ ;list of AR to be referred to Dept. of Justice.
|
|---|
| 41 | N PRCA
|
|---|
| 42 | S PRCAHDR="ACCOUNTS RECEIVABLE POSSIBLE REFERRALS TO DEPT. OF JUSTICE" D MINMAX
|
|---|
| 43 | S PRCASORT="DEBTOR,@OVER LETTER3,@RC/DOJ REFERRAL DATE,@CURRENT STATUS:STATUS NUMBER",PRCAFT=",30,@,102",PRCALAST=",,@,102",PRCATEMP="[PRCAL L DC-DOJ]",DIS(0)="I $D(^PRCA(430,D0,7)),+^(7)'<PRCAMAX"
|
|---|
| 44 | S DIC="^PRCA(430,"
|
|---|
| 45 | D @$S($D(ZTSK):"DIP^PRCAREPT",1:"PRINT^PRCAREPT")
|
|---|
| 46 | K DIOBEG,DIS,PRCAMIN,PRCAMAX Q
|
|---|
| 47 | ;
|
|---|
| 48 | COWC ;List of the accounts referred to COWC.
|
|---|
| 49 | S PRCA("DATE")="DATE REFERRED TO COWC" D ASKDT^PRCAQUE I (PRCADT1="")!(PRCADT2="") K PRCADT1,PRCADT2 Q
|
|---|
| 50 | S PRCAHDR="ACCOUNTS RECEIVABLE REFERRED TO COWC",PRCATEMP="[PRCAD COWC LIST]",PRCASORT="REFERRAL DATE TO COWC,DEBTOR"
|
|---|
| 51 | S PRCAFT=PRCADT1_",",PRCALAST=PRCADT2_",",DIC="^PRCA(430,"
|
|---|
| 52 | D PRINT^PRCAREPT,END Q
|
|---|
| 53 | ;
|
|---|
| 54 | MINMAX ;get the minimum and maximum referral amount to the RC/DOJ.
|
|---|
| 55 | ;Returns: PRCAMIN, PRCAMAX
|
|---|
| 56 | N PRCAKDA,Z0,Z1,Z2
|
|---|
| 57 | S PRCAMIN=1,PRCAMAX=5000,PRCAKDA=$O(^RC(342.1,"B","REGIONAL COUNSEL",0))
|
|---|
| 58 | I +PRCAKDA'>0 Q
|
|---|
| 59 | S Z1=$G(^RC(342.1,PRCAKDA,2))
|
|---|
| 60 | S Z2=+$P(Z1,"^",2),Z1=+Z1
|
|---|
| 61 | S:(Z1>0)&(Z2>0) PRCAMIN=Z1,PRCAMAX=Z2 K Z0,Z1,Z2,PRCAKDA
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | PRCOMM ;print comment field
|
|---|
| 65 | Q:'$D(D0)!('$D(PRCAPC)) Q:'$D(^PRCA(430,D0,3)) S PRCAKGL=$P(^(3),U,PRCAPC) G:PRCAKGL="" EXCOMM
|
|---|
| 66 | I $L(PRCAKGL)<70 W !,?3,PRCAKGL K PRCAKGL Q
|
|---|
| 67 | F PRCAK=70:-1:1 Q:$E(PRCAKGL,PRCAK)=" "
|
|---|
| 68 | W !,?3 F PRCAJ=1:1:PRCAK W $E(PRCAKGL,PRCAJ)
|
|---|
| 69 | W !,?3 F PRCAI=PRCAK+1:1:$L(PRCAKGL) W $E(PRCAKGL,PRCAI)
|
|---|
| 70 | EXCOMM K PRCAKGL,PRCAK,PRCAJ,PRCAI Q
|
|---|
| 71 | ;
|
|---|
| 72 | END K PRCA Q
|
|---|
| 73 | ;
|
|---|
| 74 | ;============== COUNT NEW CALM PENDING TRANSACTIONS=================
|
|---|
| 75 | COUNTR I $O(^PRCA(433,"AE",1,0)) W *7,!!,"*** You have new transactions from the AR section pending CALM transmission *** "
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | RETN ;returned bills list
|
|---|
| 79 | NEW ZTSK,POP,PRCAP,PRCASVC
|
|---|
| 80 | D SVC^PRCABIL Q:'$D(PRCAP("S"))
|
|---|
| 81 | S PRCASVC=PRCAP("S")
|
|---|
| 82 | S %ZIS="MQ" D ^%ZIS G:POP Q1
|
|---|
| 83 | I $D(IO("Q")) S ZTRTN="RETNDQ^PRCALST",ZTDESC="Returned Bill List",ZTSAVE("PRCASVC")="" D ^%ZTLOAD G Q1
|
|---|
| 84 | RETNDQ ;
|
|---|
| 85 | NEW BILL,STAT,DIC,L,FR,TO,FLDS
|
|---|
| 86 | I $E(IOST)="C" W @IOF
|
|---|
| 87 | F STAT=$O(^PRCA(430.3,"AC",220,0)),$O(^PRCA(430.3,"AC",230,0)) D
|
|---|
| 88 | .S BILL=0 F S BILL=$O(^PRCA(430,"AC",STAT,BILL)) Q:'BILL I $D(^PRCA(430,BILL,100)),$P(^(100),"^",2)=PRCASVC D
|
|---|
| 89 | ..S D0=BILL K DXS D ^PRCATP6 K DXS I $Y+15>IOSL D
|
|---|
| 90 | ...I $E(IOST)="C" W *7 W ! R X:DTIME I X["^"!'$T S STAT=-1 Q
|
|---|
| 91 | ...W @IOF
|
|---|
| 92 | ...Q
|
|---|
| 93 | ..Q
|
|---|
| 94 | .Q
|
|---|
| 95 | Q1 D ^%ZISC Q
|
|---|
