Routine: PRCPRNON

PRCPRNON ;WISC/RFJ-nonissuable item report                          ;20 Apr 92

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;  option to print non-issuable item report

 D ^PRCPUSEL Q:'$D(PRCP("I"))  I PRCP("DPTYPE")'="W" W !,"ONLY THE WAREHOUSE CAN USE THIS OPTION." Q

 N %,PRCPALLI,X,Y

 D ITEMSEL^PRCPURS4 I '$O(^TMP($J,"PRCPURS4",0)),'$D(PRCPALLI) Q

 S %ZIS="Q" W ! D ^%ZIS Q:POP  I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q"),ZTSK,^TMP($J,"PRCPURS4") Q

 .   S ZTDESC="Non-issuable Stock Report",ZTRTN="DQ^PRCPRNON"

 .   S ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,""PRCPURS4"",")="",ZTSAVE("ZTREQ")="@"

 W !!,"<*> please wait <*>"

DQ ;queue comes here

 N %I,DATA,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,SCREEN

 K ^TMP($J,"NONISS") S ITEMDA=0

 ;  if $g(prcpalli) then all items selected, loop inventory point.

 I $G(PRCPALLI) F  S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA  D BUILD

 ;  loop specific items selected.

 I '$G(PRCPALLI) F  S ITEMDA=$O(^TMP($J,"PRCPURS4",ITEMDA)) Q:'ITEMDA  D BUILD

 ;  start printing report

 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H

 S NSN="" F  S NSN=$O(^TMP($J,"NONISS",NSN)) Q:NSN=""  S ITEMDA=0 F  S ITEMDA=$O(^TMP($J,"NONISS",NSN,ITEMDA)) Q:'ITEMDA  S DATA=^(ITEMDA) D

 .   W !!,$S(NSN=" ":"** NO NSN **",1:NSN),?19,$E($P(DATA,"^"),1,25),?47,"[#",ITEMDA,"]",?57,$J($P(DATA,"^",3),9),$J($P(DATA,"^",2),14),!?30,"QUANTITY IN NON-ISSUABLE: ",$J($P(DATA,"^",4),10)

 .   I $Y>(IOSL-6) D:$G(SCREEN) P^PRCPUREP Q:$D(PRCPFLAG)  D H

 .   I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"

 I '$G(PRCPFLAG) D END^PRCPUREP

 D ^%ZISC K ^TMP($J,"PRCPURS4"),^TMP($J,"NONISS") Q

H S %=NOW_"  PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF

 W $C(13),"NON-ISSUABLE STOCK REPORT FOR ",PRCP("IN"),?(80-$L(%)),%

 W !,"NSN",?19,"DESCRIPTION",?47,"[#MI]",?55,"QTY ON-HAND",?77,"U/I"

 S %="",$P(%,"-",81)="" W !,%

BUILD ;  set up tmp global for printing

 ;  tmp($j,"noniss",nsn,item number) = description ^ unit per

 ;      issue ^ quantity on-hand ^ quantity non-issuable.

 S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)) I '$P(DATA,"^",19) Q

 S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "

 S ^TMP($J,"NONISS",NSN,ITEMDA)=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)_"^"_$$UNITVAL^PRCPUX1($P(DATA,"^",14),$P(DATA,"^",5)," per ")_"^"_$P(DATA,"^",7)_"^"_$P(DATA,"^",19)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRNON   2500     printed  Mar 13, 2025@21:19:55                                                                                                                                                                                                    Page 2

PRCPRNON  ;WISC/RFJ-nonissuable item report                          ;20 Apr 92

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;  option to print non-issuable item report

 +5       ;

 +6        DO ^PRCPUSEL

           if '$DATA(PRCP("I"))

               QUIT

           IF PRCP("DPTYPE")'="W"

               WRITE !,"ONLY THE WAREHOUSE CAN USE THIS OPTION."

               QUIT

 +7        NEW %,PRCPALLI,X,Y

 +8        DO ITEMSEL^PRCPURS4

           IF '$ORDER(^TMP($JOB,"PRCPURS4",0))

               IF '$DATA(PRCPALLI)

                   QUIT

 +9       ;

 +10       SET %ZIS="Q"

           WRITE !

           DO ^%ZIS

           if POP

               QUIT

           IF $DATA(IO("Q"))

               Begin DoDot:1

 +11               SET ZTDESC="Non-issuable Stock Report"

                   SET ZTRTN="DQ^PRCPRNON"

 +12               SET ZTSAVE("PRCP*")=""

                   SET ZTSAVE("^TMP($J,""PRCPURS4"",")=""

                   SET ZTSAVE("ZTREQ")="@"

               End DoDot:1

               DO ^%ZTLOAD

               KILL IO("Q"),ZTSK,^TMP($JOB,"PRCPURS4")

               QUIT

 +13       WRITE !!,"<*> please wait <*>"

 +14      ;

DQ        ;queue comes here

 +1        NEW %I,DATA,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,SCREEN

 +2        KILL ^TMP($JOB,"NONISS")

           SET ITEMDA=0

 +3       ;

 +4       ;  if $g(prcpalli) then all items selected, loop inventory point.

 +5       ;

 +6        IF $GET(PRCPALLI)

FOR

                   SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))

                   if 'ITEMDA

                       QUIT

                   DO BUILD

 +7       ;

 +8       ;  loop specific items selected.

 +9       ;

 +10       IF '$GET(PRCPALLI)

FOR

                   SET ITEMDA=$ORDER(^TMP($JOB,"PRCPURS4",ITEMDA))

                   if 'ITEMDA

                       QUIT

                   DO BUILD

 +11      ;

 +12      ;  start printing report

 +13      ;

 +14       DO NOW^%DTC

           SET Y=%

           DO DD^%DT

           SET NOW=Y

           SET PAGE=1

           SET SCREEN=$$SCRPAUSE^PRCPUREP

           USE IO

           DO H

 +15       SET NSN=""

FOR

               SET NSN=$ORDER(^TMP($JOB,"NONISS",NSN))

               if NSN=""

                   QUIT

               SET ITEMDA=0

FOR

                   SET ITEMDA=$ORDER(^TMP($JOB,"NONISS",NSN,ITEMDA))

                   if 'ITEMDA

                       QUIT

                   SET DATA=^(ITEMDA)

                   Begin DoDot:1

 +16                   WRITE !!,$SELECT(NSN=" ":"** NO NSN **",1:NSN),?19,$EXTRACT($PIECE(DATA,"^"),1,25),?47,"[#",ITEMDA,"]",?57,$JUSTIFY($PIECE(DATA,"^",3),9),$JUSTIFY($PIECE(DATA,"^",2),14),!?30,"QUANTITY IN NON-ISSUABLE: ",$JUSTIFY($PIECE(DATA,"^",4),

10)

 +17                   IF $Y>(IOSL-6)

                           if $GET(SCREEN)

                               DO P^PRCPUREP

                           if $DATA(PRCPFLAG)

                               QUIT

                           DO H

 +18                   IF $GET(ZTQUEUED)

                           IF $$S^%ZTLOAD

                               SET PRCPFLAG=1

                               WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"

                   End DoDot:1

 +19       IF '$GET(PRCPFLAG)

               DO END^PRCPUREP

 +20       DO ^%ZISC

           KILL ^TMP($JOB,"PRCPURS4"),^TMP($JOB,"NONISS")

           QUIT

 +21      ;

 +22      ;

 +23      ;

 +24      ;

H          SET %=NOW_"  PAGE "_PAGE

           SET PAGE=PAGE+1

           IF PAGE'=2!(SCREEN)

               WRITE @IOF

 +1        WRITE $CHAR(13),"NON-ISSUABLE STOCK REPORT FOR ",PRCP("IN"),?(80-$LENGTH(%)),%

 +2        WRITE !,"NSN",?19,"DESCRIPTION",?47,"[#MI]",?55,"QTY ON-HAND",?77,"U/I"

 +3        SET %=""

           SET $PIECE(%,"-",81)=""

           WRITE !,%

 +4        QUIT

 +5       ;

 +6       ;

 +7       ;

 +8       ;

BUILD     ;  set up tmp global for printing

 +1       ;  tmp($j,"noniss",nsn,item number) = description ^ unit per

 +2       ;      issue ^ quantity on-hand ^ quantity non-issuable.

 +3       ;

 +4        SET DATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))

           IF '$PIECE(DATA,"^",19)

               QUIT

 +5        SET NSN=$$NSN^PRCPUX1(ITEMDA)

           if NSN=""

               SET NSN=" "

 +6        SET ^TMP($JOB,"NONISS",NSN,ITEMDA)=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)_"^"_$$UNITVAL^PRCPUX1($PIECE(DATA,"^",14),$PIECE(DATA,"^",5)," per ")_"^"_$PIECE(DATA,"^",7)_"^"_$PIECE(DATA,"^",19)

 +7        QUIT

PRCPRNON.m