source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_RUM-KMPR/KMPRP1.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1KMPRP1 ;OAK/RAK - RUM Data by Option/Protocol/RPC ;11/29/04 08:47
2 ;;2.0;CAPACITY MANAGEMENT - RUM;**1**;May 28, 2003
3EN ;-- entry point.
4 ;
5 N %ZIS,CONT,KMPRDATE,KMPROPR,KMPROPT,OUT,POP
6 N X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
7 ;
8 S OUT=0
9 F D Q:OUT
10 .D HDR^KMPDUTL4(" RUM Data by Option/Protocol/RPC ")
11 .S KMPROPR=$$OPR I 'KMPROPR S OUT=1 Q
12 .; select option, protocol or rpc entry
13 .S KMPROPT=$$OPRSEL(KMPROPR) Q:'KMPROPT
14 .; determine start date from file 8971.1
15 .D RUMDATES^KMPRUTL(.KMPRDATE) Q:'KMPRDATE
16 .; select output device.
17 .S %ZIS="Q",%ZIS("A")="Device: ",%ZIS("B")="HOME"
18 .W ! D ^%ZIS I POP W !,"No action taken." Q
19 .; if queued.
20 .I $D(IO("Q")) K IO("Q") D Q
21 ..S ZTDESC="RUM Data by Option for '"_$P(KMPROPT,U,2)_"'."
22 ..S ZTRTN="EN1^KMPRP1"
23 ..S ZTSAVE("KMPRDATE")="",ZTSAVE("KMPROPR")="",ZTSAVE("KMPROPT")=""
24 ..D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
25 ..D EXIT
26 .;
27 .; if output to terminal display message.
28 .W:$E(IOST,1,2)="C-" !?3,"compiling data..."
29 .D EN1
30 ;
31 Q
32 ;
33EN1 ;-- entry point from taskman.
34 ;
35 Q:'$G(KMPRDATE)
36 Q:'$G(KMPROPR)
37 Q:$G(KMPROPT)=""
38 ;
39 N ELEMENT,KMPRARRY,KMPRDAYS
40 ;
41 ; set elements data into ELEMENT() array.
42 D ELEARRY^KMPRUTL("ELEMENT") Q:'$D(ELEMENT)
43 S KMPRARRY=$NA(^TMP("KMPR OPT DATA",$J))
44 K @KMPRARRY
45 D DATA,PRINT,EXIT
46 K @KMPRARRY
47 ;
48 Q
49 ;
50DATA ;-- set data into KMPRARRY
51 Q:'$D(ELEMENT)
52 Q:$G(KMPRARRY)=""
53 Q:'$G(KMPRDATE)
54 Q:'$G(KMPROPR)
55 Q:$G(KMPROPT)=""
56 ;
57 N DATE,END,I,IEN,OPTION,START
58 ;
59 ; start and end dates.
60 S START=$P(KMPRDATE,U),END=$P(KMPRDATE,U,2)
61 S DATE=START-.1,KMPRDAYS=0
62 F S DATE=$O(^KMPR(8971.1,"B",DATE)) Q:'DATE!(DATE>END) D
63 .S IEN=0,KMPRDAYS=KMPRDAYS+1
64 .F S IEN=$O(^KMPR(8971.1,"B",DATE,IEN)) Q:'IEN D
65 ..Q:'$D(^KMPR(8971.1,IEN,0)) S DATA(0)=^(0),DATA(1)=$G(^(1)),DATA(2)=$G(^(2))
66 ..S OPTION=$$OPRCHK(KMPROPR,KMPROPT,DATA(0)) Q:OPTION=""
67 ..F I=1:1:8 D
68 ...S $P(@KMPRARRY@(OPTION),U,I)=$P($G(@KMPRARRY@(OPTION)),U,I)+$P(DATA(1),U,I)
69 ...S $P(@KMPRARRY@(OPTION),U,I)=$P($G(@KMPRARRY@(OPTION)),U,I)+$P(DATA(2),U,I)
70 ;
71 Q
72 ;
73EXIT ;
74 S:$D(ZTQUEUED) ZTREQ="@"
75 D ^%ZISC
76 K KMPUDATE,KMPUNAM
77 ;
78 Q
79 ;
80PRINT ;-- print data from KMPRARRY.
81 Q:'$D(ELEMENT)
82 Q:$G(KMPRARRY)=""
83 ;
84 U IO
85 ;
86 N DATA,OCCUR,I,NUMBER,PIECE,SITE
87 ;
88 ; facility name.
89 S SITE=$$SITE^VASITE
90 S SITE=$P(SITE,U,2)_" ("_$P(SITE,U,3)_")"
91 ;
92 I '$D(@KMPRARRY) D Q
93 .D HDR
94 .W !!!?28,"<<<No Data to Report>>>"
95 .D CONTINUE^KMPDUTL4("Press RETURN to continue",2,.CONT)
96 ;
97 S OPTION=""
98 F S OPTION=$O(@KMPRARRY@(OPTION)) Q:OPTION="" D
99 .D HDR S DATA=@KMPRARRY@(OPTION),I=0,OCCUR=$P(DATA,U,8)
100 .F S I=$O(ELEMENT(I)) Q:'I D
101 ..W !,$P(ELEMENT(I),U) S PIECE=$P(ELEMENT(I),U,2)
102 ..W $$REPEAT^XLFSTR(".",25-$X)
103 ..S NUMBER=$P(DATA,U,PIECE)
104 ..; per occurrence.
105 ..W:OCCUR&(PIECE'=8) ?28,$J($FN(NUMBER/OCCUR,",",$S(I<3:2,1:0)),$S(I<3:14,1:11))
106 ..W ?50,$J($FN(NUMBER,",",$S(I<3:2,1:0)),$S(I<3:18,1:15))
107 ;
108 D CONTINUE^KMPDUTL4("Press RETURN to continue",2,.CONT)
109 ;
110 Q
111 ;
112HDR ;
113 N TITLE
114 W:$Y @IOF
115 S TITLE="RUM Data for Option: "_$P(KMPROPT,U,2)
116 W !?(80-$L(TITLE)\2),TITLE
117 W !?(80-$L($G(SITE))\2),$G(SITE)
118 W !?23,"For "_$P($G(KMPRDATE),U,3)_" to "_$P($G(KMPRDATE),U,4)
119 W !
120 W !?28,"per Occurrence",?50," Totals"
121 W !
122 ;
123 Q
124 ;
125OPR() ;-- extrinsic function - select option, protocol or rpc
126 ;-----------------------------------------------------------------------
127 ; Return: 1 - Option
128 ; 2 - Protocol
129 ; 3 - RPC
130 ; "" - No selection made
131 ;-----------------------------------------------------------------------
132 N DIR,X,Y
133 S DIR(0)="SO^1:Option;2:Protocol;3:RPC"
134 D ^DIR
135 Q $S(Y:Y_"^"_$G(Y(0)),1:"")
136 ;
137OPRCHK(OPR,OPT,DATA) ;-- extrinsic function - check to see if option, protocol or rpc matches
138 ;-----------------------------------------------------------------------
139 ; OPR.... Results from $$OPR above.
140 ; OPT.... Option, protocol or rpc name to be matched
141 ; DATA... Zero node of file 8971.1 (RESOURCE USAGE MONITOR)
142 ;
143 ; Return: OptionName - match
144 ; "" - no match
145 ;-----------------------------------------------------------------------
146 Q:$G(OPR)="" ""
147 Q:'OPR!($P(OPR,U,2)="") ""
148 Q:'$D(DATA) ""
149 Q:(+OPR)<1!((+OPR)>3) ""
150 N OPTION
151 ; option - piece 4, protocol - piece 5, rpc - piece7
152 S OPTION=$S((+OPR)=1:$P(DATA,U,4),(+OPR)=2:$P(DATA,U,5),1:$P(DATA,U,7))
153 Q $S(OPTION="":"",OPTION'=$P(OPT,U,2):"",1:OPTION)
154 ;
155OPRSEL(OPR) ;-- extrinsic function - select entry
156 ;-----------------------------------------------------------------------
157 ; OPT.... Results from $$OPR above.
158 ;
159 ; Return: IEN^Name - this will be from the Option file, Protocol file,
160 ; or RPC file, depending on the value of OPR.
161 ; "" - no selection made
162 ;-----------------------------------------------------------------------
163 Q:'$G(OPR) ""
164 Q:OPR<1!(OPR>3) ""
165 N DIC,X,Y
166 ; 1 - option, 2 - protocol, 3 - rpc
167 S DIC=$S((+OPR)=1:19,(+OPR)=2:101,1:8994)
168 S DIC(0)="AEMQZ",DIC("A")="Select "_$P(OPR,U,2)_": "
169 W ! D ^DIC
170 Q $S(Y<0:"",1:+Y_"^"_Y(0,0))
Note: See TracBrowser for help on using the repository browser.