- 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 Jan 18, 2025@02:43:13 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