Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAUPD

PRCAUPD.m

Go to the documentation of this file.
PRCAUPD ;SF-ISC/YJK-DEBTOR/3RD PARTY ADDRESS UPDATE ;10/23/93  9:52 AM
V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;This updates the debtor's address and 3rd party address
 ;refer to COWC.
INSURN ;Edit 3rd party - insurance information data.
 K DIC,PRCAS("NONACTIVE") S DIC("S")="S Z0=$P(^(0),U,2) I +Z0>0,$P(^PRCA(430.2,Z0,0),U,6)[""T"""
 D BILLN^PRCAUTL G:'$D(PRCABN) END
 D CHECKST G:$D(PRCAS("NONACTIVE")) INSURN
 S RCDOJ=$$REFST^RCRCUTL(PRCABN)
 I RCDOJ W !!,?5,"<< Referred to ",$P(RCDOJ,U,2)," on ",$$FMTE^XLFDT(+RCDOJ)," for $",$P(RCDOJ,U,3)_" >>",!!
 S DR="[PRCAE INSURANCE DATA]" D DIE,KILLV G INSURN
LOCATE ;LOCATE THE DEBTOR'S ADDRESS.
 K PRCAS("NONACTIVE") S DIC("A")="ENTER AR BILL NUMBER OR DEBTOR NAME: " D BILLN^PRCAUTL G:'$D(PRCABN) END D CHECKST G:$D(PRCAS("NONACTIVE")) LOCATE D DISPL S DR="[PRCAC LOCATE DEBTOR]" D DIE
 D DISPL G LOCATE
COWC ;refer to COWC.
 K PRCAS("NONACTIVE") D BILL^PRCAUTL G:'$D(PRCABN) END D CHECKST G:$D(PRCAS("NONACTIVE")) COWC W "#" D COWC1 G COWC
COWC1 I $D(^PRCA(430,PRCABN,6)),$P(^(6),U,12)]"" W !,"This account has already been referred to the COWC !" D PRCOWC,COWC2 Q
COWC2 S DR="[PRCAC COWC REFER]" D DIE Q
PRCOWC S %=$E($P(^PRCA(430,PRCABN,6),U,12),4,5)_"/"_$E($P(^(6),U,12),6,7)_"/"_$E($P(^(6),U,12),2,3)
 W !!,"BILL #:",?8,$P(^PRCA(430,PRCABN,0),U,1),?23,"DATE REFERRED:",?38,%,?50,"AMOUNT REFERRED:",?67,$P(^(6),U,13),!! K % Q
 ;
DIE S DIC="^PRCA(430,",DIE=DIC,DA=PRCABN D LCK D:$D(DA) ^DIE
 K DR,DIC,DIE L -^PRCA(430,+$G(PRCABN)) Q  ;end of DIE
LCK L @("+"_DIC_DA_"):1") I '$T W !,*7,"ANOTHER USER IS EDITING THIS ENTRY !,TRY LATER. ",!! K DA
 Q  ;end of LCK
 ;
CHECKST Q:+PRCA("STATUS")'>0  I $P(^PRCA(430.3,+PRCA("STATUS"),0),U,3)'=102 S PRCAS("NONACTIVE")="" W !,*7,"This is not an Active Accounts Receivable !",!
 Q
DISPL S D0=PRCABN W:$D(IOF) @IOF K DXS D ^PRCATO9 K DXS W !!
 Q
KILLV ;
END K PRCABN,PRCA,PRCAT,PRCATY,PRCAMT,PRCAPB,RCDOJ,DIE,DIC,DR,DA,PRCAMIN,PRCAMAX,DLAYGO,PRCAS Q