source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIFD.m@ 1765

Last change on this file since 1765 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1RMPRPIFD ;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.
6DEL1 ;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 ;
12DEL1A ;ASK IF INACTIVE ITEM
13 S ITEMSTA=$P(R1(0),U,10),ITEMLOC=$P(R1(1),U,5)
14DEL1B 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 ;
30DEL2 ;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
41EXIT ;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 ;
Note: See TracBrowser for help on using the repository browser.