| 1 | PRCAFN ;WASH-ISC@ALTOONA,PA/RGY-Functions to return AR data ;4/3/95 8:24 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**2,48,120,144**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;Note: These functions are only valid for non-patient and non-
|
|---|
| 6 | ;means test patient bills. The category type of the bill
|
|---|
| 7 | ;must not be a PATIENT or MEANS TEST PATIENT type for these
|
|---|
| 8 | ;functions to work. (Except for the PST, PUR, and CATN functions).
|
|---|
| 9 | ;
|
|---|
| 10 | ;Note: All functions return a -1 if unable to determine
|
|---|
| 11 | ;
|
|---|
| 12 | BN(Y) ;Input: Internal Bill #
|
|---|
| 13 | ;Return: Action number or -1
|
|---|
| 14 | D CHK I Y>0 S Y=$S('$D(Y)#2:-1,Y="":-1,1:$P($G(^PRCA(430,Y,0)),"^")) S:Y="" Y=-1
|
|---|
| 15 | Q Y
|
|---|
| 16 | ;
|
|---|
| 17 | CAT(Y) ;Input: Internal Bill #
|
|---|
| 18 | ;Return: Category #^Category name^Category Type or -1
|
|---|
| 19 | ;
|
|---|
| 20 | D CHK I Y>0 S Y=$S('$D(Y)#2:-1,Y="":-1,1:$G(^PRCA(430.2,+$P($G(^PRCA(430,Y,0)),"^",2),0))) S:Y="" Y=-1 S:Y'=-1 Y=$P(Y,"^",7)_"^"_$P(Y,"^")_"^"_$P(Y,"^",6)
|
|---|
| 21 | Q Y
|
|---|
| 22 | CATN(Y) ;Input: Category Internal Number (430.2)
|
|---|
| 23 | ;Return: Category #^Category name^Category Type or -1
|
|---|
| 24 | S Y=$S('$D(Y)#2:-1,1:$G(^PRCA(430.2,+Y,0))) S:Y="" Y=-1 S:Y'=-1 Y=$P(Y,"^",7)_"^"_$P(Y,"^")_"^"_$P(Y,"^",6)
|
|---|
| 25 | Q Y
|
|---|
| 26 | ;
|
|---|
| 27 | TPR(Y) ;Input: Internal Bill #
|
|---|
| 28 | ;Return: Total paid principal or -1
|
|---|
| 29 | D CHK I Y>0 S Y=$S('$D(Y)#2:-1,Y="":-1,1:+$P($G(^PRCA(430,Y,7)),"^",7))
|
|---|
| 30 | Q Y
|
|---|
| 31 | ;
|
|---|
| 32 | ORI(Y) ;Input: Internal Bill #
|
|---|
| 33 | ;Return: Original amount or -1
|
|---|
| 34 | D CHK I Y>0 S Y=$S('$D(Y)#2:-1,Y="":-1,$G(^PRCA(430,Y,0))="":-1,1:+$P(^(0),"^",3))
|
|---|
| 35 | Q Y
|
|---|
| 36 | ;
|
|---|
| 37 | STA(Y) ;Input: Internal Bill #
|
|---|
| 38 | ;Return: Status #^Status name or -1
|
|---|
| 39 | D CHK I Y'=-1 S Y=$S('$D(Y)#2:-1,Y="":-1,1:$G(^PRCA(430.3,+$P($G(^PRCA(430,Y,0)),"^",8),0))) S:Y="" Y=-1 S:Y'=-1 Y=$P(Y,"^",3)_"^"_$P(Y,"^")
|
|---|
| 40 | Q Y
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | CLO(BILLDA) ; input: internal bill #
|
|---|
| 44 | ; return: date the bill was closed
|
|---|
| 45 | ; -1 for patient or means test
|
|---|
| 46 | ; -2 if bill not closed
|
|---|
| 47 | ;
|
|---|
| 48 | N DATE,STAT,TYPE
|
|---|
| 49 | ; if type of bill category is for patient or means test quit -1
|
|---|
| 50 | S TYPE=$P($G(^PRCA(430.2,+$P($G(^PRCA(430,BILLDA,0)),"^",2),0)),"^",6)
|
|---|
| 51 | I TYPE="P"!(TYPE="C") Q -1
|
|---|
| 52 | ;
|
|---|
| 53 | ; do not look at bills never activated
|
|---|
| 54 | ;I '$P($P($G(^PRCA(430,BILLDA,6)),"^",21),".") Q -2
|
|---|
| 55 | ;
|
|---|
| 56 | ; bill not closed
|
|---|
| 57 | S STAT=$P($G(^PRCA(430,BILLDA,0)),"^",8)
|
|---|
| 58 | I STAT'=22,STAT'=23,STAT'=26,STAT'=39,STAT'=48,STAT'=49 Q -2
|
|---|
| 59 | ;
|
|---|
| 60 | S DATE=$P($G(^PRCA(430,BILLDA,0)),"^",14)
|
|---|
| 61 | Q DATE
|
|---|
| 62 | ;
|
|---|
| 63 | ;
|
|---|
| 64 | PST(Y) ;
|
|---|
| 65 | Q $$PST^RCAMFN01($G(Y))
|
|---|
| 66 | CHK ;
|
|---|
| 67 | S Y=$S('$D(Y)#2:-1,",C,P,"[(","_$P($G(^PRCA(430.2,+$P($G(^PRCA(430,+Y,0)),"^",2),0)),"^",6)_","):-1,1:Y)
|
|---|
| 68 | Q
|
|---|
| 69 | PUR(Y) ;Input: Internal Bill #
|
|---|
| 70 | ;Return: Date Bill can be purged (FM format) or
|
|---|
| 71 | ;Return: -1 Do Not Purge
|
|---|
| 72 | ;Return: -2 Purge but no Date, does not exist or Archived
|
|---|
| 73 | NEW BN0,X,Z,LST
|
|---|
| 74 | I $G(Y)="" S Y=-1 G PURQ
|
|---|
| 75 | S BN0=$G(^PRCA(430,Y,0)) I BN0']"" S Y=-2 G PURQ
|
|---|
| 76 | I "^220^102^110^104^112^107^113^240^230^205^"[("^"_$P($G(^PRCA(430.3,+$P(BN0,"^",8),0)),"^",3)_"^") S Y=-1 G PURQ
|
|---|
| 77 | I $P($G(^PRCA(430.3,+$P(BN0,"^",8),0)),"^",3)=115 S Y=-2 G PURQ
|
|---|
| 78 | S Z=0 F X=0:0 S X=$O(^PRCA(433,"C",Y,X)) Q:'X S Z=$S(+$P($G(^PRCA(433,X,1)),"^",9):$P(^(1),"^",9),1:+$G(^PRCA(433,X,1)))
|
|---|
| 79 | I Z S LST(9999999-Z)=""
|
|---|
| 80 | S Z=$G(^PRCA(430,Y,6)) F X=3:-1:1 I $P(Z,"^",X) S LST(9999999-$P(Z,"^",X))="" Q
|
|---|
| 81 | S LST(9999999-$P(BN0,U,10))=""
|
|---|
| 82 | S Z=9999999-$O(LST(0)) S:'Z Z=-2
|
|---|
| 83 | S Y=Z
|
|---|
| 84 | PURQ Q $P(Y,".")
|
|---|
| 85 | RETN(Y) ;Input: Internal Bill #
|
|---|
| 86 | ;Return: 1 if bill was returned to IB, 0 if bill was not returned to IB
|
|---|
| 87 | Q ",220,"[(","_$P($G(^PRCA(430.3,+$P($G(^PRCA(430,+Y,0)),"^",8),0)),"^",3)_",")
|
|---|
| 88 | BAL(DEBT) ;Input: IEN of file 340 or Varable ptr value of debtor
|
|---|
| 89 | NEW STAT,X,Y,TOTAL,BILL,BAT,TRAN
|
|---|
| 90 | S TOTAL="-"
|
|---|
| 91 | I $G(DEBT)'?1N.N,$G(DEBT)'?1N.N1";".A1"(" G Q8
|
|---|
| 92 | I DEBT?1N.N1";".E S DEBT=$$DEBT^RCEVUTL(DEBT) ;+$O(^RCD(340,"B",DEBT,0))
|
|---|
| 93 | I $G(^RCD(340,DEBT,0))="" G Q8
|
|---|
| 94 | S TOTAL=0
|
|---|
| 95 | F STAT=$O(^PRCA(430.3,"AC",102,0)),$O(^PRCA(430.3,"AC",107,0)),$O(^PRCA(430.3,"AC",112,0)) F BILL=0:0 S BILL=$O(^PRCA(430,"AS",DEBT,STAT,BILL)) Q:'BILL D:$G(^PRCA(430,BILL,0))]""
|
|---|
| 96 | .S X=$G(^PRCA(430,BILL,7)),Y=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
|
|---|
| 97 | .I $P(^PRCA(430,BILL,0),"^",2)=$O(^PRCA(430.2,"AC",33,0)) S Y=-Y
|
|---|
| 98 | .S TOTAL=TOTAL+$S($P(^PRCA(430,BILL,0),"^",2)=$O(^PRCA(430.2,"AC",33,0))&(STAT'=$O(^PRCA(430.3,"AC",112,0))):0,1:Y)
|
|---|
| 99 | .Q
|
|---|
| 100 | S DEBT=$P(^RCD(340,DEBT,0),"^")
|
|---|
| 101 | F BAT=0:0 S BAT=$O(^RCY(344,"AC",DEBT,BAT)) Q:'BAT F TRAN=0:0 S TRAN=$O(^RCY(344,"AC",DEBT,BAT,TRAN)) Q:'TRAN I $G(^RCY(344,BAT,1,TRAN,0))]"",$P(^(0),"^",5)="" S TOTAL=TOTAL-$P(^(0),"^",4)
|
|---|
| 102 | Q8 Q TOTAL
|
|---|
| 103 | ;
|
|---|
| 104 | BN1(Y) ;Input: Internal Bill #
|
|---|
| 105 | ;Return: Action number or -1
|
|---|
| 106 | S Y=$S('$D(Y)#2:-1,Y="":-1,1:$P($G(^PRCA(430,Y,0)),"^")) S:Y="" Y=-1
|
|---|
| 107 | Q Y
|
|---|
