| [613] | 1 | PRCPRNON ;WISC/RFJ-nonissuable item report ;20 Apr 92
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; option to print non-issuable item report
|
|---|
| 6 | ;
|
|---|
| 7 | D ^PRCPUSEL Q:'$D(PRCP("I")) I PRCP("DPTYPE")'="W" W !,"ONLY THE WAREHOUSE CAN USE THIS OPTION." Q
|
|---|
| 8 | N %,PRCPALLI,X,Y
|
|---|
| 9 | D ITEMSEL^PRCPURS4 I '$O(^TMP($J,"PRCPURS4",0)),'$D(PRCPALLI) Q
|
|---|
| 10 | ;
|
|---|
| 11 | S %ZIS="Q" W ! D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK,^TMP($J,"PRCPURS4") Q
|
|---|
| 12 | . S ZTDESC="Non-issuable Stock Report",ZTRTN="DQ^PRCPRNON"
|
|---|
| 13 | . S ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,""PRCPURS4"",")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 14 | W !!,"<*> please wait <*>"
|
|---|
| 15 | ;
|
|---|
| 16 | DQ ;queue comes here
|
|---|
| 17 | N %I,DATA,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,SCREEN
|
|---|
| 18 | K ^TMP($J,"NONISS") S ITEMDA=0
|
|---|
| 19 | ;
|
|---|
| 20 | ; if $g(prcpalli) then all items selected, loop inventory point.
|
|---|
| 21 | ;
|
|---|
| 22 | I $G(PRCPALLI) F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D BUILD
|
|---|
| 23 | ;
|
|---|
| 24 | ; loop specific items selected.
|
|---|
| 25 | ;
|
|---|
| 26 | I '$G(PRCPALLI) F S ITEMDA=$O(^TMP($J,"PRCPURS4",ITEMDA)) Q:'ITEMDA D BUILD
|
|---|
| 27 | ;
|
|---|
| 28 | ; start printing report
|
|---|
| 29 | ;
|
|---|
| 30 | D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|---|
| 31 | 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
|
|---|
| 32 | . 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)
|
|---|
| 33 | . I $Y>(IOSL-6) D:$G(SCREEN) P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 34 | . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|---|
| 35 | I '$G(PRCPFLAG) D END^PRCPUREP
|
|---|
| 36 | D ^%ZISC K ^TMP($J,"PRCPURS4"),^TMP($J,"NONISS") Q
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 42 | W $C(13),"NON-ISSUABLE STOCK REPORT FOR ",PRCP("IN"),?(80-$L(%)),%
|
|---|
| 43 | W !,"NSN",?19,"DESCRIPTION",?47,"[#MI]",?55,"QTY ON-HAND",?77,"U/I"
|
|---|
| 44 | S %="",$P(%,"-",81)="" W !,%
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | BUILD ; set up tmp global for printing
|
|---|
| 51 | ; tmp($j,"noniss",nsn,item number) = description ^ unit per
|
|---|
| 52 | ; issue ^ quantity on-hand ^ quantity non-issuable.
|
|---|
| 53 | ;
|
|---|
| 54 | S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)) I '$P(DATA,"^",19) Q
|
|---|
| 55 | S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
|
|---|
| 56 | 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)
|
|---|
| 57 | Q
|
|---|
