RMPRPIFD	;PHX/RFM,RGB-DELETE ISSUE FROM STOCK ;8/27/07  07:27
	;;3.0;PROSTHETICS;**139**;Feb 09, 1996;Build 4
	; RVD #61 - phase III of PIP enhancement.
	;
	;Per VHA Directive 10-93-142, this routine should not be modified.
DEL1	;ENTRY POINT TO DELETE AN ISSUE FROM STOCK
	K DIR N ITEMIEN,RITEM,ITEMCK,ITEMSTA,ITEMLOC
	S DIR("A")="Are you sure you want to DELETE this entry",DIR("B")="N",DIR(0)="Y"
	D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) G EXIT
	I Y'=1 G CO^RMPRPIYE
	;
DEL1A	;ASK IF INACTIVE ITEM
	S ITEMSTA=$P(R1(0),U,10),ITEMLOC=$P(R1(1),U,5)
DEL1B	S ITEMIEN=$O(^RMPR(661.11,"ASHI",ITEMSTA,$P(RMIT,"-"),$P(RMIT,"-",2),0)) G:ITEMIEN="" DEL2 D  G:ITEMCK=0 EXIT G:ITEMCK=1 DEL2
	. S ITEMCK=0,RITEM=^RMPR(661.11,ITEMIEN,0)
	. I $P(RITEM,U,9)'=1 S ITEMCK=1 Q
	. S DIR("A")="Scanned item is inactive, reactivate?",DIR("B")="N",DIR(0)="Y"
	. D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) S ITEMCK=0 Q
	. I Y'=1 S ITEMCK=1 Q
	. S $P(^RMPR(661.11,ITEMIEN,0),U,9)=0,$P(^RMPR(661.11,ITEMIEN,0),U,10)="",ITEMCK=2
	;ask to reset ROP to zero
	S DIR("A")="Scanned item Is now ACTIVE, set ROP to zero?",DIR("B")="N",DIR(0)="Y"
	D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) G DEL2
	I Y'=1 G DEL2
	I 'ITEMSTA!'ITEMLOC G DEL2
	S ITEMLOC=$P($G(^RMPR(661.6,ITEMLOC,0)),U,14) G:'ITEMLOC DEL2
	S ITEMIEN=$O(^RMPR(661.4,"ASLHI",ITEMSTA,ITEMLOC,$P(RMIT,"-"),$P(RMIT,"-",2),0)) G:'ITEMIEN DEL2
	S $P(^RMPR(661.4,ITEMIEN,0),U,4)=0
	;
DEL2	;call API for returning item to PIP
	K RITEM,ITEMCK,ITEMIEN,ITEMSTA,ITEMLOC
	S (RMCHK,RMERPCE)=0
	S RMI68=$P($G(^RMPR(660,RMPRIEN,10)),U,1) I RMI68>0 D  I RMERPCE W !!,"** STOCK ISSUE DELETE ABORTED",!! G EXIT
	.S RMCHK=$$DEL^RMPRPCED(RMPRIEN)
	.I RMCHK'=0 W !!,"*** ERROR in PCE DELETE, Please notify your IRM..660 IEN = ",RMPRIEN,!! S RMERPCE=1 H 3
	S RMPR60("IEN")=RMPRIEN
	S RMCHK=$$DEL^RMPRPIU3(.RMPR60)
	I $G(RMCHK) W !,"*** Error in API RMPRPIU3, ERROR = ",RMCHK,!,"*** Please inform your IRM !!",! G EXIT
	;
	W $C(7),!?10,"Deleted..." H 1
EXIT	;KILL VARIABLES AND EXIT ROUTINE
	I $G(RMPRIEN),$D(^RMPR(660,RMPRIEN)) L -^RMPR(660,RMPRIEN)
	K ^TMP($J) N RMPRSITE,RMPR D KILL^XUSCLEAN
	Q
	;