source: FOIAVistA/trunk/r/CAPACITY_MANAGEMENT_RUM-KMPR/KMPRP2.m@ 1250

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1KMPRP2 ;OAK/KAK - RUM Hourly Occurrences Distribution ;11/29/04 11:57
2 ;;2.0;CAPACITY MANAGEMENT - RUM;**1**;May 28, 2003
3 ;
4EN ;-- entry point
5 ;
6 N %ZIS,CONT,DATA,DIR,HR,KMPRDATE,KMPROPR,KMPROPT,OUT,POP
7 N STRT,USER,X,Y
8 ;
9 S OUT=0
10 F D Q:OUT
11 .D HDR^KMPDUTL4(" Hourly Occurrence Distribution ") W !
12 .S KMPROPR=$$OPR
13 .I 'KMPROPR S OUT=1 Q
14 .;
15 .; select option, protocol or rpc entry
16 .S KMPROPT=$$OPRSEL(KMPROPR) Q:'KMPROPT
17 .;
18 .; determine date from file 8971.1
19 .S STRT=$O(^KMPR(8971.1,"B",0))
20 .S DIR(0)="DO^"_STRT_":"_DT
21 .S DIR("A")="Select DATE ",DIR("?")=" ",DIR("?",1)="Enter a date."
22 .W !
23 .D ^DIR
24 .I $D(DIRUT) Q
25 .S KMPRDATE=Y
26 .S $P(KMPRDATE,U,2)=$$FMTE^XLFDT(Y)
27 .;
28 .; select output device
29 .S %ZIS="Q",%ZIS("A")="Device: "
30 .W ! D ^%ZIS I POP W !,"No action taken." Q
31 .; if queued
32 .I $D(IO("Q")) D Q
33 ..N ZTDESC,ZTRTN,ZTSAVE
34 ..K IO("Q")
35 ..S ZTDESC="RUM Hourly Occurrence Distribution"
36 ..S ZTRTN="EN1^KMPRP2"
37 ..S ZTSAVE("KMPRDATE")="",ZTSAVE("KMPROPR")="",ZTSAVE("KMPROPT")=""
38 ..D ^%ZTLOAD
39 ..W:$G(ZTSK) !,"Task #",ZTSK
40 ..D EXIT
41 .;
42 .D EN1
43 Q
44 ;
45EN1 ;-- entry point from taskman
46 ;
47 Q:'$G(KMPRDATE)
48 Q:'$G(KMPROPR)
49 Q:$G(KMPROPT)=""
50 ;
51 D DATA,PRINT,EXIT
52 ;
53 Q
54 ;
55DATA ;-- set data
56 Q:'$G(KMPRDATE)
57 Q:'$G(KMPROPR)
58 Q:$G(KMPROPT)=""
59 ;
60 N DATA,DOT,END,I,IEN,JOB,NODE,OCCUR,OPT,OPT1,OPTION,PT
61 K ^TMP($J)
62 ;
63 S CONT=1,DOT=0
64 W:$E(IOST,1,2)="C-" !?2,"Compiling data..."
65 ;
66 I +KMPRDATE=DT D TODAY,EXIT Q
67 ;
68 S IEN=0
69 F S IEN=$O(^KMPR(8971.1,"B",+KMPRDATE,IEN)) Q:'IEN D
70 .S DOT=DOT+1
71 .W:'(DOT#100)&($E(IOST,1,2)="C-") "."
72 .;
73 .Q:'$D(^KMPR(8971.1,IEN,0))
74 .;
75 .S DATA(0)=^KMPR(8971.1,IEN,0),NODE=$P(DATA(0),U,3)
76 .;I DATA(0)["SCMC PCMM GUI WORKSTATION" W DATA(0),!
77 .S OPTION=$$OPRCHK(KMPROPR,KMPROPT,DATA(0))
78 .Q:OPTION=""
79 .;
80 .S DATA(1.1)=$G(^KMPR(8971.1,IEN,1.1)),DATA(1.2)=$G(^(1.2)),DATA(2.1)=$G(^(2.1)),DATA(2.2)=$G(^(2.2))
81 .;I DATA(0)["SCMC PCMM GUI WORKSTATION" W DATA(0),!
82 .;
83 .F I=1:1:24 D
84 ..S $P(^TMP($J,"HR",NODE),U,I)=$P($G(^TMP($J,"HR",NODE)),U,I)+$P(DATA(1.1),U,I)+$P(DATA(2.1),U,I)
85 ..S $P(^TMP($J,"HR",NODE,"USER"),U,I)=$P($G(^TMP($J,"HR",NODE,"USER")),U,I)+$P(DATA(1.2),U,I)+$P(DATA(2.2),U,I)
86 ;
87 Q
88 ;
89TODAY ;
90 ; 1 - option, 2 - protocol, 3 - rpc
91 I +KMPROPR=1 S OPT1=$P(KMPROPT,U,2)_"***"
92 I +KMPROPR=2 S OPT1="***"_$P(KMPROPT,U,2)
93 I +KMPROPR=3 S OPT1="`"_$P(KMPROPT,U,2)_"***"
94 ;
95 S NODE=""
96 F S NODE=$O(^KMPTMP("KMPR","DLY",NODE)) Q:NODE="" D
97 .S ^TMP($J,"HR",NODE)=""
98 .S OPT=""
99 .F S OPT=$O(^KMPTMP("KMPR","DLY",NODE,+$H,OPT)) Q:OPT="" D
100 ..S DOT=DOT+1
101 ..W:'(DOT#100)&($E(IOST,1,2)="C-") "."
102 ..;
103 ..I OPT[OPT1!((+KMPROPR=1)&(OPT[("!"_OPT1))) D
104 ...;W OPT,!
105 ...; if searching options do not count option***protocol
106 ...I (+KMPROPR=1)&($P(OPT,"***",2)'="") Q
107 ...;
108 ...S JOB=""
109 ...F S JOB=$O(^KMPTMP("KMPR","DLY",NODE,+$H,OPT,JOB)) Q:JOB="" D
110 ....S PT=""
111 ....F S PT=$O(^KMPTMP("KMPR","DLY",NODE,+$H,OPT,JOB,PT)) Q:PT="" S DATA=^(PT) D
112 .....F I=10:1:33 S OCCUR=$P(DATA,U,I) I +OCCUR D
113 ......S $P(^TMP($J,"HR",NODE),U,I-9)=$P(^TMP($J,"HR",NODE),U,I-9)+OCCUR
114 ......S $P(^TMP($J,"HR",NODE,"USER"),U,I-9)=$P($G(^TMP($J,"HR",NODE,"USER")),U,I-9)+1
115 ;
116 Q
117 ;
118EXIT ;
119 S:$D(ZTQUEUED) ZTREQ="@"
120 D ^%ZISC
121 K ^TMP($J)
122 ;
123 Q
124 ;
125PRINT ;-- print data
126 ;
127 U IO
128 ;
129 N LINE,NODE,NOWFM,NOWHR,OCCUR,SITE,TIME,TOTOCC,TOTUSR,USER
130 ;
131 ; facility name
132 S SITE=$$SITE^VASITE
133 S SITE=$P(SITE,U,2)_" ("_$P(SITE,U,3)_")"
134 ;
135 S $P(LINE,"=",IOM)="="
136 ;
137 D HDR
138 ;
139 I '$D(^TMP($J,"HR")) D Q
140 .W !,?28,"<<<No Data to Report>>>",!!
141 .D CONTINUE^KMPDUTL4("Press RETURN to continue",1,.CONT)
142 ;
143 I +KMPRDATE=DT D
144 .S NOWFM=$$HTFM^XLFDT($H)
145 .S NOWHR=+$E($P(NOWFM,".",2),1,2)
146 F TIME=0:1:23 D Q:'CONT
147 .W ?2,$S(TIME<10:"0",1:""),TIME,?7
148 .I +KMPRDATE=DT I TIME>NOWHR D Q
149 ..W ?10,"<<<No Data>>>",!
150 ..I $Y>(IOSL-3) D
151 ...D CONTINUE^KMPDUTL4("Press RETURN to continue or '^' to exit",1,.CONT)
152 ...D:CONT HDR
153 .S NODE="",(TOTOCC,TOTUSR)=0
154 .F S NODE=$O(^TMP($J,"HR",NODE)) Q:NODE="" D
155 ..S OCCUR=$P(^TMP($J,"HR",NODE),U,TIME+1),TOTOCC=TOTOCC+OCCUR
156 ..S USER=$P($G(^TMP($J,"HR",NODE,"USER")),U,TIME+1),TOTUSR=TOTUSR+USER
157 ..W $J($FN(OCCUR,",",0),9)
158 .W $J($FN(TOTOCC,",",0),9),$J($FN(TOTUSR,",",0),9)
159 .I +KMPRDATE=DT I TIME=NOWHR W " <<<Partial Data>>>"
160 .W !
161 .I $Y>(IOSL-3) D
162 ..D CONTINUE^KMPDUTL4("Press RETURN to continue or '^' to exit",1,.CONT)
163 ..D:CONT HDR
164 ;
165 D:CONT CONTINUE^KMPDUTL4("Press RETURN to continue",1,.CONT)
166 Q
167 ;
168HDR ;
169 N NODE,TITLE,X
170 S TITLE="Hourly Occurrence Distribution for "_$P(KMPROPT,U,2)
171 W:$Y @IOF W !
172 W ?(80-$L($G(SITE))\2),$G(SITE),!
173 W ?(80-$L(TITLE)\2),TITLE,!
174 W ?31,"For "_$P($G(KMPRDATE),U,2),!!
175 W LINE,!," Hour",?10
176 S NODE=""
177 F S NODE=$O(^TMP($J,"HR",NODE)) Q:NODE="" D
178 .W " ",$S($E(NODE,1,3)=+NODE:" "_$E(NODE,$L(NODE)-2,$L(NODE)),1:$E(NODE,$L(NODE)-3,$L(NODE)))," "
179 S X=$X
180 W " Total Total",!
181 W ?X," Occ User",!,LINE,!
182 ;
183 Q
184 ;
185OPR() ;-- extrinsic function - select option, protocol or rpc
186 ;-----------------------------------------------------------------------
187 ; Return: 1 - Option
188 ; 2 - Protocol
189 ; 3 - RPC
190 ; "" - No selection made
191 ;-----------------------------------------------------------------------
192 N DIR,X,Y
193 ;
194 S DIR(0)="SO^1:Option/Task;2:Protocol;3:RPC"
195 D ^DIR
196 ;
197 Q $S(Y:Y_"^"_$G(Y(0)),1:"")
198 ;
199OPRCHK(OPR,OPT,DATA) ;-- extrinsic function
200 ;- check to see if option, protocol or rpc matches
201 ;-----------------------------------------------------------------------
202 ; OPR.... Results from $$OPR above
203 ; OPT.... Option, protocol or rpc name to be matched
204 ; DATA... Zero node of file 8971.1 (RESOURCE USAGE MONITOR)
205 ;
206 ; Return: OptionName - match
207 ; "" - no match
208 ;-----------------------------------------------------------------------
209 Q:$G(OPR)="" ""
210 Q:'OPR!($P(OPR,U,2)="") ""
211 Q:'$D(DATA) ""
212 Q:(+OPR)<1!((+OPR)>3) ""
213 ;
214 N OPTION
215 ;
216 ; option - piece 4, protocol - piece 5, rpc - piece 7
217 S OPTION=$S((+OPR=1):$P(DATA,U,4),(+OPR=2):$P(DATA,U,5),1:$P(DATA,U,7))
218 ;
219 Q $S(OPTION="":"",OPTION'=$P(OPT,U,2):"",(+OPR=1)&($P(DATA,U,5)'=""):"",1:OPTION)
220 ;
221OPRSEL(OPR) ;-- extrinsic function - select entry
222 ;-----------------------------------------------------------------------
223 ; OPT.... Results from $$OPR above
224 ;
225 ; Return: IEN^Name - this will be from the Option file, Protocol file,
226 ; or RPC file, depending on the value of OPR
227 ; "" - no selection made
228 ;-----------------------------------------------------------------------
229 Q:'$G(OPR) ""
230 Q:OPR<1!(OPR>3) ""
231 ;
232 N DIC,X,Y
233 ;
234 W !
235 ; 1 - option, 2 - protocol, 3 - rpc
236 S DIC=$S((+OPR)=1:19,(+OPR)=2:101,1:8994)
237 S DIC(0)="AEMQZ",DIC("A")="Select "_$P(OPR,U,2)_": "
238 D ^DIC
239 ;
240 Q $S(Y<0:"",1:+Y_"^"_Y(0,0))
Note: See TracBrowser for help on using the repository browser.