| [613] | 1 | PRCAACC ;WASH-ISC@ALTOONA,PA/CMS-AR ACCRUAL TOTALS ;2/6/95 11:17 AM
|
|---|
| 2 | ;;4.5;Accounts Receivable;**60,74,90,101,157,203,220**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEW PRCAQUE,PRCADEV,PRCA,ZTSK
|
|---|
| 5 | S PRCA("MESS")="Do you wish to queue this report" D QUE^PRCAQUE G:'$D(PRCAQUE) Q
|
|---|
| 6 | I $D(IO("Q")) S ZTRTN="DQ^PRCAACC",ZTDESC="AR Accrual Totals" D ^%ZTLOAD G Q
|
|---|
| 7 | DQ ;
|
|---|
| 8 | U IO
|
|---|
| 9 | NEW BILLN,COM,TOT,STAT,X,Y
|
|---|
| 10 | S BILLN=0
|
|---|
| 11 | D COM G:$O(COM(""))="" RPT
|
|---|
| 12 | F STAT=42,16 F S BILLN=$O(^PRCA(430,"AC",STAT,BILLN)) Q:'BILLN I $$ACCK(BILLN) D
|
|---|
| 13 | .S X=(","_$P(^PRCA(430,BILLN,0),"^",2)_",")
|
|---|
| 14 | .S TOT(X)=$G(TOT(X))+$G(^PRCA(430,BILLN,7))
|
|---|
| 15 | .QUIT
|
|---|
| 16 | RPT D NOW^%DTC W @IOF,!!,?23,"Accrual Totals Report",!?20,"As of: " S Y=% X ^DD("DD") W Y,!
|
|---|
| 17 | S X="",$P(X,"=",80)="" W X
|
|---|
| 18 | W:$O(COM(""))="" !!,"WARNING: Accruals are *NOT* set-up correctly.",!,"No RX accrual common numbering series are set-up in AR Bill Number File!",!!
|
|---|
| 19 | S TOT=$G(TOT(",22,"))+$G(TOT(",23,")) I TOT W !!!,"RX CO-PAYMENT Accrual Amount: $",$FN(TOT,",",2)
|
|---|
| 20 | I $G(TOT(",18,"))>0 W !!!,"C (MEANS TEST) Accrual Amount: $",$FN(TOT(",18,"),",",2)
|
|---|
| 21 | W !!!!,"Includes Common Numbering Series:",! S COM="" F S COM=$O(COM(COM)) Q:COM="" W !,COM,?20,COM(COM)
|
|---|
| 22 | Q D ^%ZISC S IOP=IO(0) D ^%ZIS K IOP,IO("Q") Q
|
|---|
| 23 | ACCK(BN) ;Check BILLN to see if Accrual
|
|---|
| 24 | N ACC,ACTDATE,CAT,FUND,DB
|
|---|
| 25 | S CAT=+$P(^PRCA(430,BN,0),"^",2)
|
|---|
| 26 | ; field 12, ACCRUED ? where 0=no 1=yes, 2=could be either
|
|---|
| 27 | S ACC=+$P($G(^PRCA(430.2,CAT,0)),"^",9)
|
|---|
| 28 | ; it could be either accrued or non-accrued
|
|---|
| 29 | I ACC=2 D
|
|---|
| 30 | . S FUND=$P($G(^PRCA(430,BN,11)),"^",17)
|
|---|
| 31 | . S ACC=$S(FUND=5014:1,FUND=2431:1,1:0)
|
|---|
| 32 | . I $E(FUND,1,4)=5287 S ACC=$$PTACCT(FUND)
|
|---|
| 33 | . ; special case with Workman's Comp
|
|---|
| 34 | . I ACC=0,CAT=6,FUND="" D
|
|---|
| 35 | . . S DB=$P($G(^RCD(340,+$P($G(^PRCA(430,BN,0)),U,9),0)),U)
|
|---|
| 36 | . . I DB[";DPT"!($P($G(^PRCA(430,BN,0)),U,7)'="") S ACC=1
|
|---|
| 37 | ;
|
|---|
| 38 | ; public law states that bills in the category ineligible (1),
|
|---|
| 39 | ; emerg/human (2), torts (10), or medicare (21) which are older
|
|---|
| 40 | ; than oct 1, 1992 should be treated as non-accrued.
|
|---|
| 41 | I CAT=1!(CAT=2)!(CAT=10)!(CAT=21) D
|
|---|
| 42 | . S ACTDATE=$P($G(^PRCA(430,BN,6)),"^",21) I 'ACTDATE S ACTDATE=DT
|
|---|
| 43 | . I ACTDATE<2921001 S ACC=0
|
|---|
| 44 | . ;
|
|---|
| 45 | . ; patch157 changes ineligibles. an ineligible created before
|
|---|
| 46 | . ; oct 1, 1992 or after sep 30, 2000 will be non-accrued.
|
|---|
| 47 | . ; otherwise it will be accrued.
|
|---|
| 48 | . I CAT=1,ACTDATE>3000930 S ACC=0
|
|---|
| 49 | ;
|
|---|
| 50 | Q ACC
|
|---|
| 51 | COM ;Find Accrual common numbering series
|
|---|
| 52 | S COM=0
|
|---|
| 53 | F S COM=$O(^PRCA(430.4,COM)) Q:'COM I $P(^PRCA(430.4,COM,0),"^",6) S COM($P(^PRCA(430.4,COM,0),"^"))=$P($G(^DIC(49,$P(^(0),"^",5),0)),"^",1)
|
|---|
| 54 | Q
|
|---|
| 55 | PTACCT(FUND) ;Determines whether Point Accounts are accrued
|
|---|
| 56 | ;returns 1 for accrued funds 528701,528702,528703,528709
|
|---|
| 57 | ;returns 0 for any other fund
|
|---|
| 58 | I FUND'[5287 Q 0
|
|---|
| 59 | S X=$E(FUND,5,6),X=$S(X="09":1,X<"05":1,1:0)
|
|---|
| 60 | Q X
|
|---|
| 61 | ADDPTEDT() ;Effective date of additional point accounts
|
|---|
| 62 | ; (528705 - 528708 and 528710)
|
|---|
| 63 | ;Effective date of switch from 4032 to 528709
|
|---|
| 64 | Q 3040928
|
|---|
