PRCPRIT0.m

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 ---PRCPRIT0   968     printed  Apr 23, 2025@18:29:34                                                                                                                                                                                                     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