source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRNON.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PRCPRNON ;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 ;
16DQ ;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 ;
41H 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 ;
50BUILD ; 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
Note: See TracBrowser for help on using the repository browser.