| [613] | 1 | PRCAEA1 ;SF-ISC/LJP-IN/REACTIVATE VENDOR ;3/17/93 1:42 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN0 ;REACTIVATE VENDOR
|
|---|
| 5 | S PRCHREAV="I $D(^(10)),$P(^(10),U,5)",DIC="^PRC(440,",DIE=DIC,DIC(0)="AEMQZ" D ^DIC G Q:Y<0 S DA=+Y D LCK^PRCAEA G Q:'$D(DA)
|
|---|
| 6 | S PRCHY=$P(Y(0),U,1) I $E(PRCHY,1,2)="**" S PRCHY=$E(PRCHY,3,99)
|
|---|
| 7 | W !,"Sure you want to RE-activate Vendor number ",DA S %=2 D YN^DICN I %=1 S DR=".01////^S X=PRCHY;15////@;31.5////@" D ^DIE
|
|---|
| 8 | D Q G EN0
|
|---|
| 9 | EN1 ;INACTIVATE VENDOR
|
|---|
| 10 | K PRCHREAV I '$D(DT) D NOW^%DTC S DT=$P(%,".",1)
|
|---|
| 11 | S DIC="^PRC(440,",DIE=DIC,DIC(0)="AEMQZ" D ^DIC G Q:Y<0 S DA=+Y D LCK^PRCAEA G Q:'$D(DA)
|
|---|
| 12 | W !,"Enter the Vendor you want to substitute for the incorrect vendor " S PRCHX="",PRCHY="**"_$E($P(Y(0),U,1),1,34) D ^DIC S:Y>0 PRCHX=+Y
|
|---|
| 13 | W !,"Sure you want to inactivate Vendor number ",DA W:PRCHX " and use vendor number ",PRCHX S %=2 D YN^DICN I %=1 S DR=".01////^S X=PRCHY;15////^S X=PRCHX;31.5////^S X=1" D ^DIE
|
|---|
| 14 | D Q G EN1
|
|---|
| 15 | Q L -^PRC(440,+$G(DA)) K %,%Y,DIC,DIE,DR,DA,PRCHREAV,PRCHX,PRCHY,PRCHZ W ! Q
|
|---|
