45 lines
1.7 KiB
Mathematica
45 lines
1.7 KiB
Mathematica
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
|