| 1 | PRCPRSTK ;WISC/RFJ/VAC-where is an item stocked                         ; 2/19/07 12:51pm | 
|---|
| 2 | ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37 | 
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified. | 
|---|
| 4 | ;*98  Modified to accommodate On Demand Items. | 
|---|
| 5 | D ^PRCPUSEL Q:'$G(PRCP("I")) | 
|---|
| 6 | N %,DATA,DATE,DESC,I,INVPT,ITEMDA,NSN,PAGE,PRCPFLAG,SCREEN,TYPE,X,Y | 
|---|
| 7 | N ODITEM,ODINVPT | 
|---|
| 8 | ITEM S ITEMDA=$$ITEM^PRCPUITM(PRCP("I"),0,"","") Q:'ITEMDA | 
|---|
| 9 | S %ZIS="Q" D ^%ZIS Q:POP  I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q"),ZTSK W !! G ITEM | 
|---|
| 10 | .   S ZTDESC="Display Where an Item is Stocked",ZTRTN="DQ^PRCPRSTK" | 
|---|
| 11 | .   S ZTSAVE("PRCP*")="",ZTSAVE("ITEMDA")="",ZTSAVE("ZTREQ")="@" | 
|---|
| 12 | W !!,"<*> please wait <*>" | 
|---|
| 13 | DQ ;queue comes here | 
|---|
| 14 | K ^TMP($J,"PRCPRSTK"),PRCPFLAG S INVPT=0 F  S INVPT=$O(^PRCP(445,"AE",ITEMDA,INVPT)) Q:'INVPT  S %=$G(^PRCP(445,INVPT,0)) I %'="" S I=$P(%,"^"),TYPE=$P(%,"^",3) S:I="" I="??" S %=$G(^PRCP(445,INVPT,1,ITEMDA,0)) I %'="" D | 
|---|
| 15 | .   S TYPE=$S(TYPE="W":"WAREHOUSE",TYPE="P":"PRIMARY",TYPE="S":"SECONDARY",1:" "),^TMP($J,"PRCPRSTK",TYPE,I)=+$P(%,"^",7)_"^"_$J($$UNITVAL^PRCPUX1($P(%,"^",14),$P(%,"^",5)," / "),12)_"^"_INVPT | 
|---|
| 16 | D NOW^%DTC S Y=% D DD^%DT S DATE=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP,NSN=$$NSN^PRCPUX1(ITEMDA),DESC=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA) U IO D H | 
|---|
| 17 | S TYPE="" F  S TYPE=$O(^TMP($J,"PRCPRSTK",TYPE)) Q:TYPE=""  S I="" F  S I=$O(^TMP($J,"PRCPRSTK",TYPE,I)) Q:I=""  S DATA=^(I) D | 
|---|
| 18 | .   S ODINVPT=$P(DATA,"^",3),ODITEM=$$ODITEM^PRCPUX2(ODINVPT,ITEMDA) | 
|---|
| 19 | .   I ODITEM="W" S ODITEM="" | 
|---|
| 20 | .   I ODITEM="Y" S ODITEM="D" | 
|---|
| 21 | .   W !,$E(TYPE,1,4),?12,I,?48,ODITEM,?50,$J($P(DATA,"^"),10),?66,$P(DATA,"^",2) | 
|---|
| 22 | .   I $Y>(IOSL-4) D:SCREEN P^PRCPUREP S:$D(PRCPFLAG) (I,TYPE)="zzzzzz" Q:$D(PRCPFLAG)  D H | 
|---|
| 23 | I '$D(PRCPFLAG) D END^PRCPUREP | 
|---|
| 24 | D ^%ZISC K ^TMP($J,"PRCPRSTK") | 
|---|
| 25 | I '$D(ZTQUEUED) W !! G ITEM | 
|---|
| 26 | Q | 
|---|
| 27 | ; | 
|---|
| 28 | H S %=DATE_"  PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF | 
|---|
| 29 | W $C(13),"DISPLAY WHERE AN ITEM IS STOCKED",?(80-$L(%)),%,!?4,"PRINTED BY INVENTORY POINT: ",PRCP("IN") | 
|---|
| 30 | W !?4,"NSN: ",NSN,?30,$E(DESC,1,30),?62,"[#",ITEMDA,"]" | 
|---|
| 31 | W !,?48,"O" | 
|---|
| 32 | W ?55,"QTY",?72,"UNIT PER" | 
|---|
| 33 | W !,"TYPE",?12,"SITE-DISTRIBUTION POINT" | 
|---|
| 34 | W ?48,"D" | 
|---|
| 35 | W ?53,"ON-HAND",?73,"ISSUE" | 
|---|
| 36 | S %="",$P(%,"-",81)="" W !,% Q | 
|---|