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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAWO 1820 printed Dec 13, 2024@01:42:04 Page 2
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
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ;
+4 ;
BEGIN ;Get Bill
+1 NEW RCCAT
+2 KILL PRCATERM,PRCABN,PRCAEN,PRCACAT,PRCA("CKSITE")
DO BILL^PRCAUTL
if ('$DATA(PRCABN))
QUIT
+3 IF PRCA("STATUS")'=$ORDER(^PRCA(430.3,"AC",102,""))
IF PRCA("STATUS")'=$ORDER(^PRCA(430.3,"AC",112,""))
WRITE !,*7,"THIS IS NOT AN ACTIVE BILL !",!
SET Y=-1
GOTO BEGIN
+4 SET PRCACAT=+$PIECE(^PRCA(430,PRCABN,0),U,2)
DO RCCAT^RCRCUTL(.RCCAT)
+5 IF +$GET(RCCAT(PRCACAT))=1
IF $$REFST^RCRCUTL(PRCABN)
WRITE !!,"YOU CANNOT USE THIS OPTION TO ADJUST REFERRED "_$PIECE($GET(RCCAT(PRCACAT)),U,2)_" BILLS !",!
SET Y=-1
GOTO BEGIN
+6 IF PRCACAT=$ORDER(^PRCA(430.2,"AC",33,""))
WRITE !,"YOU CANNOT ADJUST A PREPAYMENT BILL !",!
SET Y=-1
GOTO BEGIN
+7 IF ",8,9,10,19,"[(","_$GET(PRCATYPE)_",")
IF '$GET(^PRCA(430,PRCABN,7))
WRITE !,"THIS BILL HAS NO PRINCIPAL BALANCE !",!
SET Y=-Y
GOTO BEGIN
RR DO SETTR^PRCAUTL
DO PATTR^PRCAUTL
+1 SET DIC="^PRCA(433,"
KILL PRCAMT,PRCAD("DELETE")
+2 QUIT
+3 ;
+4 ;
SETDCJ ;Set 430 and 433 rc/doj code fields
+1 NEW RCCODE
+2 SET RCCODE=$PIECE($GET(^PRCA(430,PRCABN,6)),U,5)
+3 IF RCCODE=""
QUIT
+4 IF RCCODE="DC"
SET RCCODE="RC"
+5 SET $PIECE(^PRCA(430,PRCABN,6),U,5)=RCCODE
+6 SET $PIECE(^PRCA(433,PRCAEN,0),U,7)=RCCODE
+7 QUIT
+8 ;
CKDCDOJ ;check if the account has been referred to RC/DOJ.
+1 if '$DATA(PRCABN)
QUIT
KILL PRCANODC
+2 IF $PIECE($GET(^PRCA(430,PRCABN,6)),U,4)=""
WRITE !,*7,"This account is not referred to RC/DOJ !",!
SET PRCANODC=1
+3 QUIT
+4 ;
DIE ;Update 433 fields
+1 SET DIC="^PRCA(433,"
SET DIE=DIC
SET DA=PRCAEN
DO LOCKF^PRCAWO1
if '$DATA(DA)
QUIT
+2 DO ^DIE
KILL DIE
+3 QUIT
UPCALM ;
+1 QUIT
END ;
+1 LOCK -^PRCA(433,+$GET(PRCAEN))
KILL %,X,Y,DIE,DR,DA,DIC,DLAYGO,DATE,RCCAT,TRANS
+2 KILL PRCA,PRCAMT,PRCABN,PRCADOJ,PRCAEN,PRCAPREV,PRCATERM,PRCA,PRCACAT,PRCATL
+3 KILL PRCATY,PRCAS,PRCATYPE,PRCANODC,PRCAPB,PRCAMT1,PAYDT,PRCAMT1,PRCAPB,PRCATL1,DATE,RCCAT,TRANS
+4 QUIT
