source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSMSD.m@ 1156

PRCPSMSD ;WISC/RFJ-delete inventory item                            ;21 Oct 91
 ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 D ^PRCPUSEL Q:'$G(PRCP("I"))
 I PRCP("DPTYPE")'="W" W !,"THIS OPTION SHOULD ONLY BE USED BY THE WAREHOUSE INVENTORY POINT." Q
 I $$ISMSFLAG^PRCPUX2(PRC("SITE"))'=2 W !,"YOU NEED TO TURN THE ISMS SWITCH 'ON' BEFORE YOU CAN USE THIS OPTION." Q
 N %,%DT,COUNT,ITEMDA,PRCPFLAG,STRING,X,Y
 S IOP="HOME" D ^%ZIS K IOP,^TMP($J,"DELETE"),^TMP($J,"STRING")
 F  W !! S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") Q:'$G(ITEMDA)  S %=$G(^PRC(441,+ITEMDA,0)) D
 .   K ^TMP($J,"DELETE",ITEMDA) I $P(%,"^",5)="" W !,"ITEM DOES NOT HAVE AN NSN!" Q
 .   D DELETE^PRCPSMS0(ITEMDA) I STRING("ID")="" W !,"UNABLE TO CREATE CODE SHEET!" Q
 .   S XP="    ARE YOU SURE YOU WANT TO DELETE THIS ITEM FROM ISMS",XH="    ENTER 'YES' TO MARK THIS ITEM FOR DELETION FROM ISMS."
 .   W !! I $$YN^PRCPUYN(1)'=1 Q
 .   S ^TMP($J,"DELETE",ITEMDA)=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)_"^"_$P(%,"^",5),^TMP($J,"DELETE",ITEMDA,"CS")=STRING("ID") W !,"CS: ",STRING("ID")
 I ITEMDA["^" D Q Q
 I '$O(^TMP($J,"DELETE",0)) W !,"NO ITEMS SELECTED." D Q Q
 W @IOF,!,"YOU HAVE SELECTED THE FOLLOWING ITEMS TO DELETE:" S ITEMDA=0,COUNT=1 F  S ITEMDA=$O(^TMP($J,"DELETE",ITEMDA)) Q:'ITEMDA!($D(PRCPFLAG))  S %=^(ITEMDA) D
 .   W !,ITEMDA,?7,$E($P(%,"^"),1,50),?60,$P(%,"^",2) S ^TMP($J,"STRING",COUNT)=^TMP($J,"DELETE",ITEMDA,"CS"),COUNT=COUNT+1 I $Y>(IOSL-5) D P^PRCPUREP
 I $D(PRCPFLAG) D Q Q
 I '$O(^TMP($J,"STRING",0)) W !!,"NO CODE SHEETS CREATED." D Q Q
 S XP="*** ARE YOU SURE YOU WANT TO CREATE THE ISMS TRANSACTION",XP(1)="    AND TRANSMIT IT TO AUSTIN",XH="ENTER 'YES' TO CREATE THE ISMS TRANSACTION AND TRANSMIT IT TO AUSTIN",XH(1)="ENTER 'NO' OR '^' TO EXIT."
 W !! I $$YN^PRCPUYN(1)'=1 D Q Q
 D CODESHT^PRCPSMGO(PRC("SITE"),"IVD","")
Q K ^TMP($J,"DELETE"),^TMP($J,"STRING") Q