| 1 | RCBEUBI1 ;WISC/RFJ-utilties for bills (in file 430) ;1 Jun 00
|
|---|
| 2 | ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DICW ; write identifier code for bill lookup
|
|---|
| 8 | N DATA,DATA6,RCX
|
|---|
| 9 | S DATA=$G(^PRCA(430,Y,0)) I DATA="" Q
|
|---|
| 10 | S DATA6=$G(^PRCA(430,Y,6))
|
|---|
| 11 | ; category
|
|---|
| 12 | W ?12," ",$E($P($G(^PRCA(430.2,+$P(DATA,"^",2),0)),"^")_" ",1,15)
|
|---|
| 13 | ; date active
|
|---|
| 14 | I '$P(DATA6,"^",21) S $P(DATA6,"^",21)="???????"
|
|---|
| 15 | W ?35," ",$E($P(DATA6,"^",21),4,5),"/",$E($P(DATA6,"^",21),6,7),"/",$E($P(DATA6,"^",21),2,3)
|
|---|
| 16 | ; debtor
|
|---|
| 17 | S RCX=$X
|
|---|
| 18 | S %=$P(DATA,"^",9)
|
|---|
| 19 | I %,$D(^RCD(340,%,0)) S %=U_$P($P(^RCD(340,%,0),"^"),";",2)_+^(0)_",0)",%=$S($D(@%):$P(@%,"^"),1:"")
|
|---|
| 20 | W ?46," ",$E($S(%="":"NO DEBTOR NAME",1:%),1,$S(RCX<46:20,1:10)_" ")
|
|---|
| 21 | ; status
|
|---|
| 22 | W ?68," ",$E($P($G(^PRCA(430.3,+$P(DATA,"^",8),0)),"^"),1,9)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | ;
|
|---|
| 26 | LOOKUP ; special lookup on bills, called from ^dd(430,.01,7.5)
|
|---|
| 27 | ; if rcbeflup flag not set, do not use special lookup
|
|---|
| 28 | I '$D(RCBEFLUP) Q
|
|---|
| 29 | ; user entered A.? for lookup on active bills
|
|---|
| 30 | I X["A."!(X["a.") S DIC("S")="I $P(^(0),U,8)=16" S X="?" Q
|
|---|
| 31 | ; user entered S.? for lookup on suspended bills
|
|---|
| 32 | I X["S."!(X["s.") S DIC("S")="I $P(^(0),U,8)=40" S X="?" Q
|
|---|
| 33 | ; user entered O.? for lookup on open bills
|
|---|
| 34 | I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,8)=42" S X="?" Q
|
|---|
| 35 | ; user entered N.? for lookup on new bills
|
|---|
| 36 | I X["N."!(X["n.") S DIC("S")="I $P(^(0),U,8)=18" S X="?" Q
|
|---|
| 37 | ; user entered R.? for lookup on refund review bills
|
|---|
| 38 | I X["R."!(X["r.") S DIC("S")="I $P(^(0),U,8)=44" S X="?" Q
|
|---|
| 39 | K DIC("S")
|
|---|
| 40 | Q
|
|---|
