source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAUPD.m@ 1556

Last change on this file since 1556 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRCAUPD ;SF-ISC/YJK-DEBTOR/3RD PARTY ADDRESS UPDATE ;10/23/93 9:52 AM
2V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This updates the debtor's address and 3rd party address
5 ;refer to COWC.
6INSURN ;Edit 3rd party - insurance information data.
7 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"""
8 D BILLN^PRCAUTL G:'$D(PRCABN) END
9 D CHECKST G:$D(PRCAS("NONACTIVE")) INSURN
10 S RCDOJ=$$REFST^RCRCUTL(PRCABN)
11 I RCDOJ W !!,?5,"<< Referred to ",$P(RCDOJ,U,2)," on ",$$FMTE^XLFDT(+RCDOJ)," for $",$P(RCDOJ,U,3)_" >>",!!
12 S DR="[PRCAE INSURANCE DATA]" D DIE,KILLV G INSURN
13LOCATE ;LOCATE THE DEBTOR'S ADDRESS.
14 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
15 D DISPL G LOCATE
16COWC ;refer to COWC.
17 K PRCAS("NONACTIVE") D BILL^PRCAUTL G:'$D(PRCABN) END D CHECKST G:$D(PRCAS("NONACTIVE")) COWC W "#" D COWC1 G COWC
18COWC1 I $D(^PRCA(430,PRCABN,6)),$P(^(6),U,12)]"" W !,"This account has already been referred to the COWC !" D PRCOWC,COWC2 Q
19COWC2 S DR="[PRCAC COWC REFER]" D DIE Q
20PRCOWC 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)
21 W !!,"BILL #:",?8,$P(^PRCA(430,PRCABN,0),U,1),?23,"DATE REFERRED:",?38,%,?50,"AMOUNT REFERRED:",?67,$P(^(6),U,13),!! K % Q
22 ;
23DIE S DIC="^PRCA(430,",DIE=DIC,DA=PRCABN D LCK D:$D(DA) ^DIE
24 K DR,DIC,DIE L -^PRCA(430,+$G(PRCABN)) Q ;end of DIE
25LCK L @("+"_DIC_DA_"):1") I '$T W !,*7,"ANOTHER USER IS EDITING THIS ENTRY !,TRY LATER. ",!! K DA
26 Q ;end of LCK
27 ;
28CHECKST 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 !",!
29 Q
30DISPL S D0=PRCABN W:$D(IOF) @IOF K DXS D ^PRCATO9 K DXS W !!
31 Q
32KILLV ;
33END K PRCABN,PRCA,PRCAT,PRCATY,PRCAMT,PRCAPB,RCDOJ,DIE,DIC,DR,DA,PRCAMIN,PRCAMAX,DLAYGO,PRCAS Q
Note: See TracBrowser for help on using the repository browser.