PRCAWO.m

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 ---PRCAWO   1820     printed  Apr 09, 2024@20:47:52                                                                                                                                                                                                      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