| 1 | PRCAFN1 ;WASH-ISC@ALTOONA,PA/LDB-Functions to return AR data ;8/12/93 10:36 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**48**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;;
|
|---|
| 5 | EN(TRAN) ;Input is transaction number
|
|---|
| 6 | ;Variable returned = internal number of debtor^internal bill number
|
|---|
| 7 | N X,Y
|
|---|
| 8 | S Y=$P($G(^PRCA(433,+TRAN,0)),"^",2) G NULL:'Y
|
|---|
| 9 | S X=$P($G(^PRCA(430,+Y,0)),"^",9) G NULL:'X
|
|---|
| 10 | S $P(X,"^",2)=Y
|
|---|
| 11 | Q X
|
|---|
| 12 | ;
|
|---|
| 13 | NULL ;Either no bill or debtor
|
|---|
| 14 | S X=""
|
|---|
| 15 | Q X
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | CAT(Y) ;Input: Internal Bill #
|
|---|
| 19 | ;Return: Category #^Category name^Category Type or -1
|
|---|
| 20 | ;
|
|---|
| 21 | 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)
|
|---|
| 22 | Q Y
|
|---|
| 23 | ;
|
|---|
| 24 | PAID(Y) ;Input: Internal Bill #
|
|---|
| 25 | ;Return: Amount of payments on receivable
|
|---|
| 26 | N AMT,X
|
|---|
| 27 | S AMT=0
|
|---|
| 28 | I 'Y!(Y<0)!('$D(^PRCA(430,Y,0))) S Y="ERROR" G PAIDQ
|
|---|
| 29 | S X="" F S X=$O(^PRCA(433,"C",+Y,X)) Q:'X D
|
|---|
| 30 | .S X(1)=$G(^PRCA(433,+X,1))
|
|---|
| 31 | .S X(2)=$P(X(1),"^",2)
|
|---|
| 32 | .I "^2^34^"[("^"_X(2)_"^") S AMT=AMT+$P(X(1),"^",5)
|
|---|
| 33 | S Y=AMT
|
|---|
| 34 | PAIDQ Q Y
|
|---|
