PRCAWO ;ALB-ISC/CMS - WAIVED IN FULL,TERMINATE AR ;8/27/97  11:01 AM
V ;;4.5;Accounts Receivable;**42,67,63,168**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
 ;
 ;
BEGIN ;Get Bill
 N RCCAT
 K PRCATERM,PRCABN,PRCAEN,PRCACAT,PRCA("CKSITE") D BILL^PRCAUTL Q:('$D(PRCABN))
 I PRCA("STATUS")'=$O(^PRCA(430.3,"AC",102,"")),PRCA("STATUS")'=$O(^PRCA(430.3,"AC",112,"")) W !,*7,"THIS IS NOT AN ACTIVE BILL !",! S Y=-1 G BEGIN
 S PRCACAT=+$P(^PRCA(430,PRCABN,0),U,2) D RCCAT^RCRCUTL(.RCCAT)
 I +$G(RCCAT(PRCACAT))=1,$$REFST^RCRCUTL(PRCABN) W !!,"YOU CANNOT USE THIS OPTION TO ADJUST REFERRED "_$P($G(RCCAT(PRCACAT)),U,2)_" BILLS !",! S Y=-1 G BEGIN
 I PRCACAT=$O(^PRCA(430.2,"AC",33,"")) W !,"YOU CANNOT ADJUST A PREPAYMENT BILL !",! S Y=-1 G BEGIN
 I ",8,9,10,19,"[(","_$G(PRCATYPE)_","),'$G(^PRCA(430,PRCABN,7)) W !,"THIS BILL HAS NO PRINCIPAL BALANCE !",! S Y=-Y G BEGIN
RR D SETTR^PRCAUTL,PATTR^PRCAUTL
 S DIC="^PRCA(433," K PRCAMT,PRCAD("DELETE")
 Q
 ;
 ;
SETDCJ ;Set 430 and 433 rc/doj code fields
 N RCCODE
 S RCCODE=$P($G(^PRCA(430,PRCABN,6)),U,5)
 I RCCODE="" Q
 I RCCODE="DC" S RCCODE="RC"
 S $P(^PRCA(430,PRCABN,6),U,5)=RCCODE
 S $P(^PRCA(433,PRCAEN,0),U,7)=RCCODE
 Q
 ;
CKDCDOJ ;check if the account has been referred to RC/DOJ.
 Q:'$D(PRCABN)  K PRCANODC
 I $P($G(^PRCA(430,PRCABN,6)),U,4)="" W !,*7,"This account is not referred to RC/DOJ !",! S PRCANODC=1
 Q
 ;
DIE ;Update 433 fields
 S DIC="^PRCA(433,",DIE=DIC,DA=PRCAEN D LOCKF^PRCAWO1 Q:'$D(DA)
 D ^DIE K DIE
 Q
UPCALM ;
 Q
END ;
 L -^PRCA(433,+$G(PRCAEN)) K %,X,Y,DIE,DR,DA,DIC,DLAYGO,DATE,RCCAT,TRANS
 K PRCA,PRCAMT,PRCABN,PRCADOJ,PRCAEN,PRCAPREV,PRCATERM,PRCA,PRCACAT,PRCATL
 K PRCATY,PRCAS,PRCATYPE,PRCANODC,PRCAPB,PRCAMT1,PAYDT,PRCAMT1,PRCAPB,PRCATL1,DATE,RCCAT,TRANS
 Q