source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRUSP.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1PRCPRUSP ;WISC/RFJ/VAC-usage demand item report (print report) ; 3/6/07 9:00am
2V ;;5.1;IFCAP;**1,98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;*98 Modified to accommodate On-Demand Items
5 Q
6 ;
7 ;
8PRINT ; print report
9 D NOW^%DTC S Y=% D DD^%DT S NOW=Y
10 S PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
11 ;
12 ; whse
13 I PRCP("DPTYPE")="W" D
14 . S NSN=""
15 . F S NSN=$O(^TMP($J,"PRCPRUSE",NSN)) Q:NSN="" D Q:$D(PRCPFLAG)
16 . . S DESCR=0
17 . . F S DESCR=$O(^TMP($J,"PRCPRUSE",NSN,DESCR)) Q:DESCR']"" D Q:$D(PRCPFLAG)
18 . . . S ITEMDA=0
19 . . . F S ITEMDA=$O(^TMP($J,"PRCPRUSE",NSN,DESCR,ITEMDA)) Q:'ITEMDA D Q:$D(PRCPFLAG)
20 . . . . S DATA=^TMP($J,"PRCPRUSE",NSN,DESCR,ITEMDA)
21 . . . . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
22 . . . . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
23 . . . . W !,$TR(NSN,"-"),?15,$E($P(DATA,"^"),1,15)
24 . . . . D USAGE
25 . . . . Q:$D(PRCPFLAG)
26 ;
27 Q:$D(PRCPFLAG)
28 ; primary and secondary
29 I PRCP("DPTYPE")'="W" D
30 . S GROUP=""
31 . F S GROUP=$O(^TMP($J,"PRCPRUSE",GROUP)) Q:GROUP="" D Q:$D(PRCPFLAG)
32 . . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
33 . . Q:$D(PRCPFLAG)
34 . . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
35 . . W !!?5,"GROUP: ",$S(GROUP=" ":"<<NONE>>",1:GROUP)
36 . . S DESCR=""
37 . . F S DESCR=$O(^TMP($J,"PRCPRUSE",GROUP,DESCR)) Q:DESCR="" D Q:$D(PRCPFLAG)
38 . . . S ITEMDA=0
39 . . . F S ITEMDA=$O(^TMP($J,"PRCPRUSE",GROUP,DESCR,ITEMDA)) Q:'ITEMDA D Q:$D(PRCPFLAG)
40 . . . . S DATA=^TMP($J,"PRCPRUSE",GROUP,DESCR,ITEMDA)
41 . . . . S ODITEM=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
42 . . . . Q:ODITEM="Y"&(ODIFLG=1)
43 . . . . Q:ODITEM=""&(ODIFLG=2)
44 . . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
45 . . . . W !,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,25)
46 . . . . D USAGE
47 . . . . Q:$D(PRCPFLAG)
48 . . . Q:$D(PRCPFLAG)
49 . . Q:$D(PRCPFLAG)
50 . Q:$D(PRCPFLAG)
51 ;
52 I '$D(PRCPFLAG) D END^PRCPUREP
53 K ^TMP($J,"PRCPRUSE"),^TMP($J,"PRCPURS1")
54 D ^%ZISC
55 Q
56 ;
57 ;
58USAGE ; display usage
59 I PRCP("DPTYPE")="W" D
60 .W ?31,ITEMDA
61 .W ?38,$J($P(DATA,"^",2),8)
62 .W $J($P(DATA,"^",3),12,3)
63 .W $J($P(DATA,"^",4),12,3)
64 .W $J($P(DATA,"^",5),9)
65 I PRCP("DPTYPE")'="W" D
66 .S ODITEM=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
67 .W ?27,ITEMDA
68 .I ODITEM="Y" W ?35,"D"
69 .W ?38,$J($P(DATA,"^",2),8)
70 .W ?47,$J($P(DATA,"^",3),12,3)
71 .W $J($P(DATA,"^",4),12,3)
72 .W $J($P(DATA,"^",5),9),!
73 .I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H W !
74 .S REORDER=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
75 .W ?4,"NORM: ",$P(REORDER,"^",9)
76 .W ?26,"REORD: ",$P(REORDER,"^",10)
77 .W ?48,"OPT: ",$P(REORDER,"^",4)
78 .W ?67,"EMER: ",$P(REORDER,"^",11)
79 .I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
80 Q:$D(PRCPFLAG)
81 S (COLUMN,TOTUSED,TOTCOST,TTOTUSED,TTOTCOST)=0
82 S DATE=$E(DATESTRT,1,5)-1
83 F S DATE=DATE+1 S:$E(DATE,4,5)=13 DATE=($E(DATE,1,3)+1)_"01" Q:DATE>$E(DATEEND,1,5)!($D(PRCPFLAG)) D
84 . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
85 . S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE,0))
86 . S MONYR=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(DATE,4,5))_$E(DATE,2,3)
87 . S TOTUSED=TOTUSED+$P(DATA,"^",2),TOTCOST=TOTCOST+$P(DATA,"^",3)
88 . S COLUMN=COLUMN+1
89 . W:COLUMN=1 !?4 W:COLUMN=2 ?31 W:COLUMN=3 ?58
90 . W MONYR,$J(+$P(DATA,"^",2),7),$J(+$P(DATA,"^",3),10,2)
91 . I COLUMN=3 S COLUMN=0
92 Q:$D(PRCPFLAG)
93 S TTOTUSED=TTOTUSED+TOTUSED,TTOTCOST=TTOTCOST+TOTCOST
94 W !?4,"---------------------------------------- CUMULATIVE TOTAL"
95 W ?63,$J(TTOTUSED,7),$J(TTOTCOST,10,2),!
96 Q
97 ;
98 ;
99H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
100 W $C(13),"USAGE DEMAND ITEM REPORT: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
101 S %="",$P(%,"-",81)=""
102 W !?5,"USAGE DATE RANGE FROM ",DATESTRD," TO ",DATEENDD," (",TOTALDAY," DAYS)"
103 I PRCP("DPTYPE")'="W" D
104 .I ODIFLG=1 W !,?5,"STANDARD ITEMS ONLY"
105 .I ODIFLG=2 W !,?5,"ON-DEMAND ITEMS ONLY"
106 .I ODIFLG=3 W !,?5,"ALL ITEMS (STANDARD AND ON-DEMAND)"
107 I PRCP("DPTYPE")="W" W !,"NSN",?15,"DESCRIPTION"
108 E W !,"DESCRIPTION"
109 I PRCP("DPTYPE")'="W" D
110 . W ?27,"IM",?35,"OD",?40,"UNIT/IS",?53,"LAST $",?66,"AVG $",?73,"ON-HAND",!,%
111 I PRCP("DPTYPE")="W" D
112 . W ?31,"IM",?38,$J("UNIT/IS",8),$J("LAST $",12),$J("AVG $",12),$J("ON-HAND",9),!,%
113 Q
Note: See TracBrowser for help on using the repository browser.