source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSMSD.m@ 623

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PRCPSMSD ;WISC/RFJ-delete inventory item ;21 Oct 91
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 I PRCP("DPTYPE")'="W" W !,"THIS OPTION SHOULD ONLY BE USED BY THE WAREHOUSE INVENTORY POINT." Q
6 I $$ISMSFLAG^PRCPUX2(PRC("SITE"))'=2 W !,"YOU NEED TO TURN THE ISMS SWITCH 'ON' BEFORE YOU CAN USE THIS OPTION." Q
7 N %,%DT,COUNT,ITEMDA,PRCPFLAG,STRING,X,Y
8 S IOP="HOME" D ^%ZIS K IOP,^TMP($J,"DELETE"),^TMP($J,"STRING")
9 F W !! S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") Q:'$G(ITEMDA) S %=$G(^PRC(441,+ITEMDA,0)) D
10 . K ^TMP($J,"DELETE",ITEMDA) I $P(%,"^",5)="" W !,"ITEM DOES NOT HAVE AN NSN!" Q
11 . D DELETE^PRCPSMS0(ITEMDA) I STRING("ID")="" W !,"UNABLE TO CREATE CODE SHEET!" Q
12 . S XP=" ARE YOU SURE YOU WANT TO DELETE THIS ITEM FROM ISMS",XH=" ENTER 'YES' TO MARK THIS ITEM FOR DELETION FROM ISMS."
13 . W !! I $$YN^PRCPUYN(1)'=1 Q
14 . S ^TMP($J,"DELETE",ITEMDA)=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)_"^"_$P(%,"^",5),^TMP($J,"DELETE",ITEMDA,"CS")=STRING("ID") W !,"CS: ",STRING("ID")
15 I ITEMDA["^" D Q Q
16 I '$O(^TMP($J,"DELETE",0)) W !,"NO ITEMS SELECTED." D Q Q
17 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
18 . 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
19 I $D(PRCPFLAG) D Q Q
20 I '$O(^TMP($J,"STRING",0)) W !!,"NO CODE SHEETS CREATED." D Q Q
21 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."
22 W !! I $$YN^PRCPUYN(1)'=1 D Q Q
23 D CODESHT^PRCPSMGO(PRC("SITE"),"IVD","")
24Q K ^TMP($J,"DELETE"),^TMP($J,"STRING") Q
Note: See TracBrowser for help on using the repository browser.