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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAUPD 2053 printed Oct 16, 2024@17:42:51 Page 2
PRCAUPD ;SF-ISC/YJK-DEBTOR/3RD PARTY ADDRESS UPDATE ;10/23/93 9:52 AM
V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;This updates the debtor's address and 3rd party address
+3 ;refer to COWC.
INSURN ;Edit 3rd party - insurance information data.
+1 KILL DIC,PRCAS("NONACTIVE")
SET DIC("S")="S Z0=$P(^(0),U,2) I +Z0>0,$P(^PRCA(430.2,Z0,0),U,6)[""T"""
+2 DO BILLN^PRCAUTL
if '$DATA(PRCABN)
GOTO END
+3 DO CHECKST
if $DATA(PRCAS("NONACTIVE"))
GOTO INSURN
+4 SET RCDOJ=$$REFST^RCRCUTL(PRCABN)
+5 IF RCDOJ
WRITE !!,?5,"<< Referred to ",$PIECE(RCDOJ,U,2)," on ",$$FMTE^XLFDT(+RCDOJ)," for $",$PIECE(RCDOJ,U,3)_" >>",!!
+6 SET DR="[PRCAE INSURANCE DATA]"
DO DIE
DO KILLV
GOTO INSURN
LOCATE ;LOCATE THE DEBTOR'S ADDRESS.
+1 KILL PRCAS("NONACTIVE")
SET DIC("A")="ENTER AR BILL NUMBER OR DEBTOR NAME: "
DO BILLN^PRCAUTL
if '$DATA(PRCABN)
GOTO END
DO CHECKST
if $DATA(PRCAS("NONACTIVE"))
GOTO LOCATE
DO DISPL
SET DR="[PRCAC LOCATE DEBTOR]"
DO DIE
+2 DO DISPL
GOTO LOCATE
COWC ;refer to COWC.
+1 KILL PRCAS("NONACTIVE")
DO BILL^PRCAUTL
if '$DATA(PRCABN)
GOTO END
DO CHECKST
if $DATA(PRCAS("NONACTIVE"))
GOTO COWC
WRITE "#"
DO COWC1
GOTO COWC
COWC1 IF $DATA(^PRCA(430,PRCABN,6))
IF $PIECE(^(6),U,12)]""
WRITE !,"This account has already been referred to the COWC !"
DO PRCOWC
DO COWC2
QUIT
COWC2 SET DR="[PRCAC COWC REFER]"
DO DIE
QUIT
PRCOWC SET %=$EXTRACT($PIECE(^PRCA(430,PRCABN,6),U,12),4,5)_"/"_$EXTRACT($PIECE(^(6),U,12),6,7)_"/"_$EXTRACT($PIECE(^(6),U,12),2,3)
+1 WRITE !!,"BILL #:",?8,$PIECE(^PRCA(430,PRCABN,0),U,1),?23,"DATE REFERRED:",?38,%,?50,"AMOUNT REFERRED:",?67,$PIECE(^(6),U,13),!!
KILL %
QUIT
+2 ;
DIE SET DIC="^PRCA(430,"
SET DIE=DIC
SET DA=PRCABN
DO LCK
if $DATA(DA)
DO ^DIE
+1 ;end of DIE
KILL DR,DIC,DIE
LOCK -^PRCA(430,+$GET(PRCABN))
QUIT
LCK LOCK @("+"_DIC_DA_"):1")
IF '$TEST
WRITE !,*7,"ANOTHER USER IS EDITING THIS ENTRY !,TRY LATER. ",!!
KILL DA
+1 ;end of LCK
QUIT
+2 ;
CHECKST if +PRCA("STATUS")'>0
QUIT
IF $PIECE(^PRCA(430.3,+PRCA("STATUS"),0),U,3)'=102
SET PRCAS("NONACTIVE")=""
WRITE !,*7,"This is not an Active Accounts Receivable !",!
+1 QUIT
DISPL SET D0=PRCABN
if $DATA(IOF)
WRITE @IOF
KILL DXS
DO ^PRCATO9
KILL DXS
WRITE !!
+1 QUIT
KILLV ;
END KILL PRCABN,PRCA,PRCAT,PRCATY,PRCAMT,PRCAPB,RCDOJ,DIE,DIC,DR,DA,PRCAMIN,PRCAMAX,DLAYGO,PRCAS
QUIT
