- PRCAEA1 ;SF-ISC/LJP-IN/REACTIVATE VENDOR ;3/17/93 1:42 PM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN0 ;REACTIVATE VENDOR
- 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)
- S PRCHY=$P(Y(0),U,1) I $E(PRCHY,1,2)="**" S PRCHY=$E(PRCHY,3,99)
- 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
- D Q G EN0
- EN1 ;INACTIVATE VENDOR
- K PRCHREAV I '$D(DT) D NOW^%DTC S DT=$P(%,".",1)
- 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)
- 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
- 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
- D Q G EN1
- Q L -^PRC(440,+$G(DA)) K %,%Y,DIC,DIE,DR,DA,PRCHREAV,PRCHX,PRCHY,PRCHZ W ! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAEA1 1107 printed Feb 18, 2025@23:05:47 Page 2
- PRCAEA1 ;SF-ISC/LJP-IN/REACTIVATE VENDOR ;3/17/93 1:42 PM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN0 ;REACTIVATE VENDOR
- +1 SET PRCHREAV="I $D(^(10)),$P(^(10),U,5)"
- SET DIC="^PRC(440,"
- SET DIE=DIC
- SET DIC(0)="AEMQZ"
- DO ^DIC
- if Y<0
- GOTO Q
- SET DA=+Y
- DO LCK^PRCAEA
- if '$DATA(DA)
- GOTO Q
- +2 SET PRCHY=$PIECE(Y(0),U,1)
- IF $EXTRACT(PRCHY,1,2)="**"
- SET PRCHY=$EXTRACT(PRCHY,3,99)
- +3 WRITE !,"Sure you want to RE-activate Vendor number ",DA
- SET %=2
- DO YN^DICN
- IF %=1
- SET DR=".01////^S X=PRCHY;15////@;31.5////@"
- DO ^DIE
- +4 DO Q
- GOTO EN0
- EN1 ;INACTIVATE VENDOR
- +1 KILL PRCHREAV
- IF '$DATA(DT)
- DO NOW^%DTC
- SET DT=$PIECE(%,".",1)
- +2 SET DIC="^PRC(440,"
- SET DIE=DIC
- SET DIC(0)="AEMQZ"
- DO ^DIC
- if Y<0
- GOTO Q
- SET DA=+Y
- DO LCK^PRCAEA
- if '$DATA(DA)
- GOTO Q
- +3 WRITE !,"Enter the Vendor you want to substitute for the incorrect vendor "
- SET PRCHX=""
- SET PRCHY="**"_$EXTRACT($PIECE(Y(0),U,1),1,34)
- DO ^DIC
- if Y>0
- SET PRCHX=+Y
- +4 WRITE !,"Sure you want to inactivate Vendor number ",DA
- if PRCHX
- WRITE " and use vendor number ",PRCHX
- SET %=2
- DO YN^DICN
- IF %=1
- SET DR=".01////^S X=PRCHY;15////^S X=PRCHX;31.5////^S X=1"
- DO ^DIE
- +5 DO Q
- GOTO EN1
- Q LOCK -^PRC(440,+$GET(DA))
- KILL %,%Y,DIC,DIE,DR,DA,PRCHREAV,PRCHX,PRCHY,PRCHZ
- WRITE !
- QUIT
