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 Dec 13, 2024@02:07:12 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
