source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ84.m@ 1705

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1XQ84 ;SEA/Luke - Menu Rebuild Utilities ;03/03/2003 09:19
2 ;;8.0;KERNEL;**157,253**;Jul 10, 1995
3 ;
4 ;
5SHOW ; Show what's in the global ^XUTL("XQ","REBUILDS")
6 I '$D(^XUTL("XQ","REBUILDS")) W !," Sorry, there is no data in the global ^XUTL(""XQ"",""REBUILDS"") to show you.",! Q
7 ;
8 N %,XQI,XQNL,XQNI,XQNT
9 N XQB,XQE,XQBY,XQTYPE,XQT,XQUCI,XQJ
10 ;
11 I '$D(IOF) D HOME^%ZIS
12 W @IOF
13 S XQNL=0 ;Line counter
14 S XQNI=1 ;Item or occurance counter
15 S XQNT=$S($D(IOSL):IOSL-4,1:18) ;Number of lines on the screen
16 ;
17 D TITLE
18 D TOP
19 ;
20 S XQI=0
21 F Q:$D(DIRUT) S XQI=$O(^XUTL("XQ","REBUILDS",XQI)) Q:XQI="" D
22 .S %=^XUTL("XQ","REBUILDS",XQI)
23 .S XQBY=$P($P(%,U,3),","),XQBY=$E(XQBY,1,12)
24 .S XQB=$P(%,U,1),XQE=$P(%,U,2),XQTYPE=$P(%,U,4),XQT=$P(%,U,5)
25 .S XQUCI=" Location: "_$P(%,U,6,8)
26 .S XQJ=" Job #: "_$P(%,U,9)
27 .D WRITE
28 .Q
29 ;
30 K DIRUT,DUOUT
31 Q
32 ;
33WRITE ;Write an entry unless the screen is full
34 I XQNL>XQNT D
35 .D WAIT Q:$D(DIRUT)
36 .W @IOF
37 .S XQNL=0
38 .D TOP
39 .Q
40 Q:$D(DIRUT)
41 W !,XQNI,".",?4,XQB,?28,XQE,?51,XQBY,?60,XQTYPE,?71,XQT,!,XQUCI,XQJ,!
42 S XQNL=XQNL+3,XQNI=XQNI+1
43 Q
44 ;
45TOP ; Format the top of the page
46 W !,?11,"Start",?35,"End",?53,"By",?59,"Type/Name",?72,"Task #",!
47 S XQNL=XQNL+2
48 Q
49 ;
50TITLE ;What is this all about?
51 N %
52 S %=$G(^XUTL("XQ","MICRO"))
53 W ?36,"Recent Menu Rebuilds",!
54 S XQNL=XQNL+2
55 W ?14,$S(%>0:%,1:"No")_" instances of Micro Surgery since last rebuild."
56 S XQNL=XQNL+2
57 Q
58 ;
59WAIT ;That's a screen load hold it here for a minute
60 N X,Y
61 S DIR(0)="E" D ^DIR K DIR
62 Q
63 ;
64 ;
65USER ;Rebuild the menu trees of a specific user
66 ;called by the option XQBUILDUSER
67 N XUN,XQCNT,XQSEC,XQREACT,XQPRIM,XQFL
68 S (XQCNT,XQSEC)=0
69 ;
70 S XUN=+$$LOOKUP^XUSER Q:XUN'>0
71 S XQPRIM=$G(^VA(200,XUN,201)) I XQPRIM'>0 W !!,"No Primary Menu defined for this user." Q
72 S XQCNT=1,XQREACT(XQCNT)=XQPRIM
73 F S XQSEC=$O(^VA(200,XUN,203,"B",XQSEC)) Q:XQSEC'=+XQSEC D
74 .Q:'$D(^DIC(19,XQSEC,0)) ;Error in Buffalo...old pointer?
75 .I $P(^DIC(19,XQSEC,0),U,4)="M" S XQCNT=XQCNT+1,XQREACT(XQCNT)=XQSEC
76 .Q
77 ;
78 M XQREACTS=XQREACT ;Save the originals
79 S XQCNTS=XQCNT
80 ;
81 S XQFL=$$FLAG(.XQREACT,.XQCNT)
82 I XQFL=1 D
83 .N DIR
84 .S DIR(0)="Y"
85 .S DIR("A")=" Are you sure you want to force a rebuild? "
86 .S DIR("A",1)=" ***WARNING*** "
87 .S DIR("A",2)=" Someone else may be rebuilding these trees right now."
88 .S DIR("?")=" Enter 'Y' to force a rebuild, 'N' to quit."
89 .D ^DIR
90 .I Y=1 D
91 ..M XQREACT=XQREACTS ;Restore original list of menus
92 ..S XQCNT=XQCNTS
93 ..S XQFL=0
94 ..Q
95 .Q
96 ;
97 Q:XQFL ;Flags are set, let's not mess with it.
98 ;
99 S DIR(0)="Y",DIR("A")=" Queue this rebuild? ",DIR("B")="Y"
100 S DIR("?")=" Please enter 'Y'es or 'N'o."
101 D ^DIR I Y=1 D
102 .S ZTRTN="REACTQ^XQ84"
103 .S ZTSAVE("XUN")=""
104 .S ZTSAVE("XQREACT(")="",ZTSAVE("XQCNT")=""
105 .S ZTIO="",ZTDTH=$H
106 .S ZTDESC="Rebuild "_$P(^VA(200,XUN,0),U)_"'s menu trees (DUZ="_XUN_")"
107 .D ^%ZTLOAD
108 .I $D(ZTSK) W !!," Task number: ",ZTSK
109 .Q
110 K DIR,Y
111 ;
112 I '$D(ZTSK) D REACTQ W !!," Done."
113 K ZTSK
114 Q
115 ;
116REACT(XUN) ;From XUSERNEW, check trees for reactivated user
117 ;
118 N XQCNT,XQSEC,XQREACT,XQPRIM,XQCHAT
119 S XQCHAT=1 I $D(XQUEUED)!$D(XWB) S XQCHAT=0 ;Anybody out there?
120 S XQPRIM=$G(^VA(200,XUN,201)) I 'XQPRIM,'$D(XQQUE) W:XQCHAT !!,"** WARNING ** No Primary Menu defined." Q
121 I (XQPRIM'=+XQPRIM)!($G(^DIC(19,XQPRIM,0))="") Q
122 S (XQCNT,XQSEC)=0
123 I XQPRIM,'$D(^DIC(19,"AXQ","P"_XQPRIM)),$P(^DIC(19,XQPRIM,0),U,4)="M" S XQCNT=XQCNT+1,XQREACT(XQCNT)="P"_XQPRIM
124 F S XQSEC=$O(^VA(200,XUN,203,"B",XQSEC)) Q:XQSEC'=+XQSEC D
125 .Q:'$D(^DIC(19,XQSEC,0)) ;Bad pointer don't use it
126 .I '$D(^DIC(19,"AXQ","P"_XQSEC)),$P(^DIC(19,XQSEC,0),U,4)="M" S XQCNT=XQCNT+1,XQREACT(XQCNT)="P"_XQSEC
127 .Q
128 ;
129 Q:XQCNT=0 ;The menu trees look OK to me.
130 ;
131 N %
132 S %=$$FLAG(.XQREACT,.XQCNT) ;Are we already merging them (1)
133 Q:%
134 ;
135 I XQCNT>0 D
136 .S ZTRTN="REACTQ^XQ84"
137 .S ZTSAVE("XQREACT(")="",ZTSAVE("XUN")=""
138 .S ZTIO="",ZTDTH=$H
139 .S ZTDESC="Rebuild reactivated user's menu trees (DUZ="_XUN_")"
140 .D ^%ZTLOAD
141 .K ZTSK
142 .Q
143 Q
144 ;
145FLAG(XQARRAY,XQNUM1) ;Should we build a particular array of trees
146 ;Input: XQARRAY - array of trees e.g. P106, etc. XQNUM1 number of trees
147 ;Output: 0 - There are trees to rebuild, 1 - Trees are already flagged
148 ;Merge flags e.g. [^XUTL("XQMERGED","P106)=$H] are set here
149 ; and killed in REACTQ+16
150 ;
151 N %,XQNUM,XQPXU S XQNUM=0
152 S %=$$STATUS^XQ81() I '% Q 1 ;Menues rebuilding
153 S XQPXU=$G(^DIC(19,"AXQ","PXU",0)) Q:XQPXU="" 1
154 S %="" F S %=$O(XQARRAY(%)) Q:%="" D
155 .N X
156 .S X=XQARRAY(%)
157 .I $D(^XUTL("XQMERGED",X)) D
158 ..N Y,Z
159 ..S Y=$G(^XUTL("XQMERGED",X)) Q:Y="" ;Flag's gone
160 ..S Z=$$HDIFF^XLFDT(XQPXU,Y)
161 ..I Z>0 K ^XUTL("XQMERGED",X) ;Old Flag
162 ..Q
163 .I $D(^XUTL("XQMERGED",X)) K XQARRAY(%) Q
164 .S ^XUTL("XQMERGED",X)=$H,XQNUM=XQNUM+1 ;We'll merge this one
165 .Q
166 I XQNUM>0 S XQNUM1=XQNUM Q 0 ;There are some left to rebuild
167 Q 1
168 ;
169 ;
170REACTQ ;Queued job to rebuild a reativated user's menu trees
171 ; can also be run in real time by USER (above) [Not Used]
172 ;
173 N % S %=0
174 K ZTREQ ;Don't delete the task information
175 I $D(^DIC(19,"AXQ","P0")) S XQSTAT=$$STATUS^XQ81 Q:'XQSTAT ;Menus are being rebuilt
176 Q:'$D(XQREACT) ;Nothing to rebuild
177 ;
178 D MICRO^XQ81 ;Turn off Micro Surgery
179 S ^DIC(19,"AXQ","P0")=$H
180 N XQCNT,XQDIC S XQCNT=""
181 K ^TMP($J),^TMP("XQO",$J)
182 F S XQCNT=$O(XQREACT(XQCNT)) Q:XQCNT="" D
183 .S (XQFG1,XQXUF)="",XQDIC="P"_XQREACT(XQCNT)
184 .D PM2^XQ8
185 .Q:'$D(^TMP("XQO",$J,XQDIC))
186 .M ^DIC(19,"AXQ",XQDIC)=^TMP("XQO",$J,XQDIC) ;D MERGET^XQ81
187 .M ^XUTL("XQO",XQDIC)=^DIC(19,"AXQ",XQDIC) ;D MERGEX^XQ81
188 .K ^XUTL("XQMERGED",XQREACT(XQCNT))
189 .Q
190 K ^DIC(19,"AXQ","P0"),^TMP($J),^TMP("XQO",$J)
191 D REPORT($E($P(^VA(200,XUN,0),U),1,9))
192 K ^DIC(19,"AXQ","P0","STOP")
193 K D,I,W,X,XQK,XQQUE,XQXUF,Y,Z
194 I $D(ZTQUEUED) S ZTREQ="@"
195 Q
196 ;
197 ;
198REPORT(XQTYPE) ;Tell Rick What happened.
199 N %,X,XQI,XQJ,XQK,XQLINE,XQEND,Y
200 I '$D(^XUTL("XQ","MICRO")) S ^("MICRO")=0
201 I XQTYPE["MICRO" S ^XUTL("XQ","MICRO")=^XUTL("XQ","MICRO")+1 Q ;Update Micro count
202 S XQEND=$$HTE^XLFDT($H)
203 I '$D(XQSTART) S XQSTART=XQEND
204 S XQLINE=XQSTART_"^"_XQEND_"^"_$P(^VA(200,DUZ,0),U,1)_"^"
205 ;S X=$S($D(^DIC(19,"AXQ","P0","MICRO")):"MICRO",$D(ZTSK):"QUEUED",1:"LIVE")
206 S X=XQTYPE K XQTYPE
207 S Y=$S($D(ZTSK):ZTSK,1:"LIVE")
208 S XQLINE=XQLINE_X_"^"_Y
209 D GETENV^%ZOSV
210 S XQLINE=XQLINE_"^"_$P(Y,"^",1,3)_"^"_$J
211 I $D(^XUTL("XQ","REBUILDS")) D
212 .S (XQJ,XQK)=0
213 .F S XQJ=$O(^XUTL("XQ","REBUILDS",XQJ)) Q:XQJ=""!(XQJ=49) S XQK=XQK+1
214 .F XQI=XQK:-1:1 S ^XUTL("XQ","REBUILDS",XQI+1)=^(XQI)
215 .Q
216 S ^XUTL("XQ","REBUILDS",1)=XQLINE
217 Q
218 ;
219 ;
220NOW ;Is there a rebuild of any kind running right now?
221 N % S %=0
222 I $D(^DIC(19,"AXQ","P0","MICRO")) D
223 .W !!?6,"Micro surgery is currently updating the compiled menus."
224 .I $D(^DIC(19,"AXQ","AXQ","STOP")) D
225 ..W !?6,"... but it has been instructed to stop."
226 ..Q
227 .S %=47
228 .Q
229 Q:%=47
230 I $D(^DIC(19,"AXQ","P0")) D
231 .W !!?6," A complete menu rebuild is currently running."
232 .S %=47
233 .Q
234 Q:%=47
235 W !!?6,"There is no menu rebuild activity running on your system right now."
236 Q
Note: See TracBrowser for help on using the repository browser.