| [613] | 1 | RMPRPIFD ;PHX/RFM,RGB-DELETE ISSUE FROM STOCK ;8/27/07 07:27
|
|---|
| 2 | ;;3.0;PROSTHETICS;**139**;Feb 09, 1996;Build 4
|
|---|
| 3 | ; RVD #61 - phase III of PIP enhancement.
|
|---|
| 4 | ;
|
|---|
| 5 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 6 | DEL1 ;ENTRY POINT TO DELETE AN ISSUE FROM STOCK
|
|---|
| 7 | K DIR N ITEMIEN,RITEM,ITEMCK,ITEMSTA,ITEMLOC
|
|---|
| 8 | S DIR("A")="Are you sure you want to DELETE this entry",DIR("B")="N",DIR(0)="Y"
|
|---|
| 9 | D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) G EXIT
|
|---|
| 10 | I Y'=1 G CO^RMPRPIYE
|
|---|
| 11 | ;
|
|---|
| 12 | DEL1A ;ASK IF INACTIVE ITEM
|
|---|
| 13 | S ITEMSTA=$P(R1(0),U,10),ITEMLOC=$P(R1(1),U,5)
|
|---|
| 14 | 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
|
|---|
| 15 | . S ITEMCK=0,RITEM=^RMPR(661.11,ITEMIEN,0)
|
|---|
| 16 | . I $P(RITEM,U,9)'=1 S ITEMCK=1 Q
|
|---|
| 17 | . S DIR("A")="Scanned item is inactive, reactivate?",DIR("B")="N",DIR(0)="Y"
|
|---|
| 18 | . D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) S ITEMCK=0 Q
|
|---|
| 19 | . I Y'=1 S ITEMCK=1 Q
|
|---|
| 20 | . S $P(^RMPR(661.11,ITEMIEN,0),U,9)=0,$P(^RMPR(661.11,ITEMIEN,0),U,10)="",ITEMCK=2
|
|---|
| 21 | ;ask to reset ROP to zero
|
|---|
| 22 | S DIR("A")="Scanned item Is now ACTIVE, set ROP to zero?",DIR("B")="N",DIR(0)="Y"
|
|---|
| 23 | D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) G DEL2
|
|---|
| 24 | I Y'=1 G DEL2
|
|---|
| 25 | I 'ITEMSTA!'ITEMLOC G DEL2
|
|---|
| 26 | S ITEMLOC=$P($G(^RMPR(661.6,ITEMLOC,0)),U,14) G:'ITEMLOC DEL2
|
|---|
| 27 | S ITEMIEN=$O(^RMPR(661.4,"ASLHI",ITEMSTA,ITEMLOC,$P(RMIT,"-"),$P(RMIT,"-",2),0)) G:'ITEMIEN DEL2
|
|---|
| 28 | S $P(^RMPR(661.4,ITEMIEN,0),U,4)=0
|
|---|
| 29 | ;
|
|---|
| 30 | DEL2 ;call API for returning item to PIP
|
|---|
| 31 | K RITEM,ITEMCK,ITEMIEN,ITEMSTA,ITEMLOC
|
|---|
| 32 | S (RMCHK,RMERPCE)=0
|
|---|
| 33 | S RMI68=$P($G(^RMPR(660,RMPRIEN,10)),U,1) I RMI68>0 D I RMERPCE W !!,"** STOCK ISSUE DELETE ABORTED",!! G EXIT
|
|---|
| 34 | .S RMCHK=$$DEL^RMPRPCED(RMPRIEN)
|
|---|
| 35 | .I RMCHK'=0 W !!,"*** ERROR in PCE DELETE, Please notify your IRM..660 IEN = ",RMPRIEN,!! S RMERPCE=1 H 3
|
|---|
| 36 | S RMPR60("IEN")=RMPRIEN
|
|---|
| 37 | S RMCHK=$$DEL^RMPRPIU3(.RMPR60)
|
|---|
| 38 | I $G(RMCHK) W !,"*** Error in API RMPRPIU3, ERROR = ",RMCHK,!,"*** Please inform your IRM !!",! G EXIT
|
|---|
| 39 | ;
|
|---|
| 40 | W $C(7),!?10,"Deleted..." H 1
|
|---|
| 41 | EXIT ;KILL VARIABLES AND EXIT ROUTINE
|
|---|
| 42 | I $G(RMPRIEN),$D(^RMPR(660,RMPRIEN)) L -^RMPR(660,RMPRIEN)
|
|---|
| 43 | K ^TMP($J) N RMPRSITE,RMPR D KILL^XUSCLEAN
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
