source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBEUDEB.m@ 1150

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

initial load of WorldVistAEHR

File size: 826 bytes
RevLine 
[613]1RCBEUDEB ;WISC/RFJ-utilties for debtors (in file 340) ;1 Jun 00
2 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7EDIT340(RCDEBTDA,DR) ; edit the field in 340 with the DR string passed
8 I '$D(^RCD(340,RCDEBTDA)) Q
9 N %,D,D0,D1,DA,DDH,DI,DIC,DIE,DQ,J,X,Y
10 S (DIC,DIE)="^RCD(340,",DA=RCDEBTDA
11 D ^DIE
12 ; user pressed up-arrow
13 I $D(Y) Q "0^DEBTOR FIELDS NOT UPDATED"
14 Q 1
15 ;
16 ;
17TOPAMT(RCBILLDA,AMOUNT) ; increase or decrease current top debt amount
18 ; field 4.03
19 ; pass the bill number and amount, - to decrease.
20 N RCDEBTDA,TOPAMT
21 S RCDEBTDA=+$P($G(^PRCA(430,RCBILLDA,0)),"^",9)
22 I '$D(^RCD(340,RCDEBTDA,0)) Q
23 S TOPAMT=$P($G(^RCD(340,RCDEBTDA,4)),"^",3)+AMOUNT
24 I TOPAMT<0 S TOPAMT=0
25 S $P(^RCD(340,RCDEBTDA,4),"^",3)=TOPAMT
26 Q
Note: See TracBrowser for help on using the repository browser.