source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEUBI1.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1RCBEUBI1 ;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 ;
7DICW ; 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 ;
26LOOKUP ; 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
Note: See TracBrowser for help on using the repository browser.