| 1 | RCEVUTL ;WASH-ISC@ALTOONA,PA/RGY-Generic Event Utilities ;5/6/96  8:15 AM
 | 
|---|
| 2 | V ;;4.5;Accounts Receivable;42;Mar 20, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 | DEBT(DEB) ;Return or add Debtor to debtor file
 | 
|---|
| 5 |  NEW DIC,DLAYGO,X,Y
 | 
|---|
| 6 |  S DEB=$G(DEB) I "^DPT(^DIC(36^DIC(4^PRC(440^VA(200^"'[("^"_$P($S(DEB'[";DPT(":$E(DEB,1,$L(DEB)-1),1:DEB),";",2)_"^") S DEB=-1 G Q1
 | 
|---|
| 7 |  I '$D(@("^"_$P(DEB,";",2)_(+DEB)_",0)")) S DEB=-1 G Q1
 | 
|---|
| 8 |  I '$O(^RCD(340,"B",DEB,0)) K DD,D0 S DIC="^RCD(340,",DLAYGO=340,X=DEB,DIC(0)="L" D FILE^DICN K D0 S DEB=$S(+Y>0:+Y,1:-1) G Q1
 | 
|---|
| 9 |  S DEB=$O(^RCD(340,"B",DEB,0)) S:'DEB DEB=-1
 | 
|---|
| 10 | Q1 Q DEB
 | 
|---|
| 11 | EFF(TRAN) ;Return effect on balance
 | 
|---|
| 12 |  S TRAN=$P($G(^RC(341.1,+$P($G(^RC(341,+$G(TRAN),0)),"^",2),0)),"^",3) S:TRAN="" TRAN=-1
 | 
|---|
| 13 | Q3 Q TRAN
 | 
|---|
| 14 | BAL(DEBT) ;Return amount owed by debtor
 | 
|---|
| 15 |  S Y="" G:'$D(DEBT) Q4
 | 
|---|
| 16 |  S:DEBT?1N.N1";"1A.A1"(" DEBT=$O(^RCD(340,"B",DEBT,0))
 | 
|---|
| 17 |  S Y=$P($G(^RC(341,+$P($G(^RCD(340,DEBT,0)),"^",2),1)),"^",6,10)
 | 
|---|
| 18 | Q4 Q Y
 | 
|---|
| 19 | OVD(TRAN) ;Return effect on overdue
 | 
|---|
| 20 |  S TRAN=$P($G(^RC(341.1,+$P($G(^RC(341,+$G(TRAN),0)),"^",2),0)),"^",5) S:TRAN="" TRAN=-1
 | 
|---|
| 21 |  Q TRAN
 | 
|---|
| 22 | BILT(BILL) ;Return amount of bill
 | 
|---|
| 23 |  I $G(BILL)'?1N.N Q 0
 | 
|---|
| 24 |  I $G(^PRCA(430,BILL,0))="" Q 0
 | 
|---|
| 25 |  S X=$P($G(^PRCA(430,BILL,7)),"^",1,5)
 | 
|---|
| 26 |  S $P(X,"^",6)=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
 | 
|---|
| 27 |  Q X
 | 
|---|
| 28 | BALO(DEBT) ;Return overdue amount for a debtor
 | 
|---|
| 29 |  S Y="" G:'$D(DEBT) Q5
 | 
|---|
| 30 |  S:DEBT?1N.N1";"1A.A1"(" DEBT=$O(^RCD(340,"B",DEBT,0))
 | 
|---|
| 31 |  S Y=$P($G(^RC(341,+$P($G(^RCD(340,DEBT,0)),"^",2),1)),"^",11,15)
 | 
|---|
| 32 | Q5 Q Y
 | 
|---|