PRCPRIT0 ;WISC/RFJ-display item ; 10/19/06 9:02am
;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
N %,INVPT,ITEMDA,ODIFLAG
S INVPT=PRCP("I") I $O(^PRCP(445,PRCP("I"),2,0))="" G ITEM
W !!,"Enter the DISTRIBUTION POINT to select an item from the distribution point, or",!,"Enter <RETURN> to select an item from the ",PRCP("IN")," inventory point."
S %=$$TO^PRCPUDPT(PRCP("I")) Q:%["^" I % S INVPT=%
ITEM S ODIFLAG="P"
I PRCP("DPTYPE")="W" D
.I %=0 S ODIFLAG="W"
F W ! S ITEMDA=$$ITEM^PRCPUITM(INVPT,0,"","") Q:'ITEMDA D
. S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. . S ZTDESC="Display Item Report",ZTRTN="DQ^PRCPRIT1"
. . S ZTSAVE("PRCP*")="",ZTSAVE("ITEMDA")="",ZTSAVE("INVPT")="",ZTSAVE("ZTREQ")="@",ZTSAVE("O*")=""
. W !!,"<*> please wait <*>"
. D DQ^PRCPRIT1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRIT0 968 printed Dec 13, 2024@02:15:04 Page 2
PRCPRIT0 ;WISC/RFJ-display item ; 10/19/06 9:02am
+1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+4 NEW %,INVPT,ITEMDA,ODIFLAG
+5 SET INVPT=PRCP("I")
IF $ORDER(^PRCP(445,PRCP("I"),2,0))=""
GOTO ITEM
+6 WRITE !!,"Enter the DISTRIBUTION POINT to select an item from the distribution point, or",!,"Enter <RETURN> to select an item from the ",PRCP("IN")," inventory point."
+7 SET %=$$TO^PRCPUDPT(PRCP("I"))
if %["^"
QUIT
IF %
SET INVPT=%
ITEM SET ODIFLAG="P"
+1 IF PRCP("DPTYPE")="W"
Begin DoDot:1
+2 IF %=0
SET ODIFLAG="W"
End DoDot:1
+3 FOR
WRITE !
SET ITEMDA=$$ITEM^PRCPUITM(INVPT,0,"","")
if 'ITEMDA
QUIT
Begin DoDot:1
+4 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:2
+5 SET ZTDESC="Display Item Report"
SET ZTRTN="DQ^PRCPRIT1"
+6 SET ZTSAVE("PRCP*")=""
SET ZTSAVE("ITEMDA")=""
SET ZTSAVE("INVPT")=""
SET ZTSAVE("ZTREQ")="@"
SET ZTSAVE("O*")=""
End DoDot:2
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+7 WRITE !!,"<*> please wait <*>"
+8 DO DQ^PRCPRIT1
End DoDot:1
+9 QUIT
