- PRCHEF ;ID/RSD,SF-ISC/TKW-EDIT ROUTINES FOR SUPPLY SYSTEM ;6/10/97 9:34
- V ;;5.1;IFCAP;**107,202**;Oct 20, 2000;Build 27
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- EN80 ;DELETE A RECEIVING REPORT (CONT.FROM PRCHE)
- K PRCHNRQ D PO^PRCHE G:'$D(PRCHPO) Q^PRCHE
- I $P($G(^PRC(442,PRCHPO,23)),U,11)="S"!($P($G(^(23)),U,11)="P") W !!,?5,"Please create an adjustment voucher to delete",!,?5,"receiving reports for purchase card orders.",! G EN80
- I $P($G(^PRC(442,PRCHPO,23)),U,11)="D" W !!,?5,"Please create an adjustment voucher to delete",!,?5,"receiving reports for delivery orders.",! G EN80
- I X<25!(X>33) W $C(7)," Receiving Report cannot be deleted, please create an adjustment voucher." G EN80
- I '$O(^PRC(442,PRCHPO,11,0)) W !?3,"Order has no Receiving Reports !",$C(7) G EN80
- D LCK1^PRCHE G:'$D(DA) EN80 S:$P(^PRC(442,PRCHPO,0),U,2)=8 PRCHNRQ=1
- S DIC="^PRC(442,PRCHPO,11,",DIC(0)="QEANZ" D ^DIC I Y<0 L G EN80
- I $P(Y(0),U,6)="Y" W !?3,"Receiving Report has already been processed by Fiscal.",!?3,"You must create an Adjustment Voucher to edit this Receiving Report.",! L G EN80
- S (PRCHRPT,PRCHDPT)=+Y,(PRCHRD,PRCHDRD)=$P(Y(0),U,1),(PRCHRDEL,PRCHDTP)=1,PRCHEX=$P(Y(0),U,3)+$P(Y(0),U,5)
- D ^PRCHDP3,DEL^PRCHREC2 K PRCHRDEL I $D(PRCHRD) L D Q^PRCHE G EN80
- ;S PRCHREC=$S($O(^PRC(442,PRCHPO,11,0)):1,1:0),X=$S($D(^PRC(442,PRCHPO,7)):$P(^(7),U,2),1:"")
- ;THE SUPPLY STATUS CODE HAS BEEN MOVED TO PRCHREC2 AS OF PRC*5.1*202
- G EN80
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHEF 1476 printed Feb 18, 2025@23:33:35 Page 2
- PRCHEF ;ID/RSD,SF-ISC/TKW-EDIT ROUTINES FOR SUPPLY SYSTEM ;6/10/97 9:34
- V ;;5.1;IFCAP;**107,202**;Oct 20, 2000;Build 27
- +1 ;Per VA Directive 6402, this routine should not be modified.
- +2 ;
- EN80 ;DELETE A RECEIVING REPORT (CONT.FROM PRCHE)
- +1 KILL PRCHNRQ
- DO PO^PRCHE
- if '$DATA(PRCHPO)
- GOTO Q^PRCHE
- +2 IF $PIECE($GET(^PRC(442,PRCHPO,23)),U,11)="S"!($PIECE($GET(^(23)),U,11)="P")
- WRITE !!,?5,"Please create an adjustment voucher to delete",!,?5,"receiving reports for purchase card orders.",!
- GOTO EN80
- +3 IF $PIECE($GET(^PRC(442,PRCHPO,23)),U,11)="D"
- WRITE !!,?5,"Please create an adjustment voucher to delete",!,?5,"receiving reports for delivery orders.",!
- GOTO EN80
- +4 IF X<25!(X>33)
- WRITE $CHAR(7)," Receiving Report cannot be deleted, please create an adjustment voucher."
- GOTO EN80
- +5 IF '$ORDER(^PRC(442,PRCHPO,11,0))
- WRITE !?3,"Order has no Receiving Reports !",$CHAR(7)
- GOTO EN80
- +6 DO LCK1^PRCHE
- if '$DATA(DA)
- GOTO EN80
- if $PIECE(^PRC(442,PRCHPO,0),U,2)=8
- SET PRCHNRQ=1
- +7 SET DIC="^PRC(442,PRCHPO,11,"
- SET DIC(0)="QEANZ"
- DO ^DIC
- IF Y<0
- LOCK
- GOTO EN80
- +8 IF $PIECE(Y(0),U,6)="Y"
- WRITE !?3,"Receiving Report has already been processed by Fiscal.",!?3,"You must create an Adjustment Voucher to edit this Receiving Report.",!
- LOCK
- GOTO EN80
- +9 SET (PRCHRPT,PRCHDPT)=+Y
- SET (PRCHRD,PRCHDRD)=$PIECE(Y(0),U,1)
- SET (PRCHRDEL,PRCHDTP)=1
- SET PRCHEX=$PIECE(Y(0),U,3)+$PIECE(Y(0),U,5)
- +10 DO ^PRCHDP3
- DO DEL^PRCHREC2
- KILL PRCHRDEL
- IF $DATA(PRCHRD)
- LOCK
- DO Q^PRCHE
- GOTO EN80
- +11 ;S PRCHREC=$S($O(^PRC(442,PRCHPO,11,0)):1,1:0),X=$S($D(^PRC(442,PRCHPO,7)):$P(^(7),U,2),1:"")
- +12 ;THE SUPPLY STATUS CODE HAS BEEN MOVED TO PRCHREC2 AS OF PRC*5.1*202
- +13 GOTO EN80