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

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

WorldVistAEHR overlayed on FOIAVistA
File size: 8.8 KB
Line 
1XQ81 ;SEA/AMF/LUKE,SF/RWF - Build menu trees ;03/03/2003 10:00
2 ;;8.0;KERNEL;**81,116,157,253**;Jul 10, 1995
3BUILD ;
4 ;
5RD2 N XQSTAT S XQSTAT=$$STATUS()
6 I 'XQSTAT W !!,"Some one else is rebuilding menus. Sorry." Q
7 K ZTSK
8 D MICRO ;Turn off micro surgery for now
9 ;
10 S XQSTART=$$HTE^XLFDT($H)
11 K XQFG W !!,"This option will build menu trees for each primary and secondary menu.",!,"You may build all the trees, or build them selectively, using 'verify'.",!,"Note that the 'compiled menus' will only be built into ^XUTL on this CPU.",!
12 S DIR(0)="Y",DIR("A")="Do you wish to verify each primary menu",DIR("B")="NO",DIR("??")="XQBUILDTREE-VER" D ^DIR K DIR G:$D(DIRUT) BLDEND S XQVE=(Y=1)
13 S DIR(0)="Y",DIR("A")="Would you like to build secondary menu trees too",DIR("B")="YES",DIR("??")="XQBUILDTREE-SEC" D ^DIR G:$D(DIRUT) BLDEND S XQBSEC=(Y=1)
14 ;
15 I 'XQVE S DIR(0)="Y",DIR("A")="Would you like to queue this job",DIR("B")="YES" D ^DIR K DIR G:$D(DIRUT) BLDEND I Y=1 D
16 .S ZTRTN="QUE^XQ81",ZTIO=""
17 .S ZTSAVE("XQVE")="",ZTSAVE("XQBSEC")="",ZTSAVE("XQSTART")=""
18 .S ZTDESC="Build menu trees in ^DIC(19,""AXQ"")"
19 .D ^%ZTLOAD
20 .I $D(ZTSK),'XQVE W !!,"Task #: ",ZTSK,!
21 .Q
22 ;
23 I $D(ZTSK) K ^DIC(19,"AXQ","P0") S XQALLDON="" G BLDEND
24 E S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0")
25 ;
26 I 'XQVE S DIR(0)="Y",DIR("A")="Do you really wish to run this DIRECTLY (it may take some time)",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT) BLDEND G:Y'=1 RD2
27 ;
28KIDS ;Entry from KIDS
29 I '$D(XQSTAT),$D(^DIC(19,"AXQ","P0")) S XQSTAT=$$STATUS I 'XQSTAT W !!," Some one else is building menus. Sorry." K XQSTAT Q
30 I '$D(^DIC(19,"AXQ","P0","STOP")) D MICRO
31 I '$D(^DIC(19,"AXQ","P0")) S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0")
32 I '$D(XQVE) S XQFG=0,XQBSEC=1,XQVE=0
33 N XQNTREE,XQNDONE S (XQNTREE,XQNDONE)=0
34 ;
35 ;Set up the error trap so we can clear the screen if it blows
36 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XQ81"
37 E S X="ERR^XQ81",@^%ZOSF("TRAP")
38 ;
39 ;Set up the bar graph and window if not from KIDS
40 I '$D(XPDNM) D INIT^XPDID
41 I XPDIDVT D
42 .I $D(XPDIDTOT) S XQSAVTOT=XPDIDTOT
43 .S X="Rebuilding Menus" D TITLE^XPDID(X)
44 .S XPDIDTOT=50 ;Number of divisions in bar graph
45 .D UPDATE^XPDID(0)
46 .Q
47 ;
48 S XQSTART=$$HTE^XLFDT($H)
49 W !!,"Starting Menu Rebuild: ",XQSTART
50 S XQFG=0 W !!,"Collecting primary menus in the New Person file..."
51 ;
52DQ ;Entry from taskman Write if $D(XQFG)
53 K ZTREQ
54 I '$D(XQSTART) S XQSTART=$$HTE^XLFDT($H)
55 N XQNOW,XQ8FLG,XQTASK
56 S XQ8FLG=0
57 S:'$D(XQNOW) XQNOW=$H
58 S ^DIC(19,"AXQ","P0")=XQNOW
59 S ^DIC(19,"AXQ","P0","STOP")=XQNOW ;Stop micro surgery if it's running
60 ;
61 S XQSEC=1,XQ81T="" I 'XQVE H 1
62 S XQI="" F XQK=0:0 S XQI=$O(^TMP("XQO",$J,XQI)) Q:XQI'=+XQI!(XQI="") I $D(^TMP("XQO",$J,XQI,0))#2 S $P(^(0),U,2)=""
63 S XQI="U" F XQK=0:0 S XQI=$O(^TMP("XQO",$J,XQI)) Q:"U"'[$E(XQI)!(XQI="") I $D(^TMP("XQO",$J,XQI,0))#2 S $P(^(0),U,2)=""
64 S XQI="P" F XQK=0:0 S XQI=$O(^TMP("XQO",$J,XQI)) Q:"P"'[$E(XQI)!(XQI="") I $D(^TMP("XQO",$J,XQI,0))#2,$L(^(0)) S XQ81T=^(0) Q
65 S:XQ81T="" XQ81T="Unknown"
66 S XQI="P" F XQK=0:0 S XQI=$O(^TMP("XQO",$J,XQI)) Q:"P"'[$E(XQI)!(XQI="") I "P"[$E(XQI),XQI'="P0" K ^TMP("XQO",$J,XQI)
67 ;
68 ;Find the various trees and put them into ^TMP($J), and count them
69 S:'$D(XQH) XQH=$H K ^TMP($J) S XQI=.5 F XQK=0:0 S XQI=$O(^VA(200,XQI)) Q:XQI'=+XQI I $D(^VA(200,XQI,0)),$L($P(^VA(200,XQI,0),U,3)) D SET
70 ;
71 S (XQNTREE,%)=0 F S %=$O(^TMP($J,%)) Q:%="" S XQNTREE=XQNTREE+1
72 S %=0 F S %=$O(^TMP($J,"SEC",%)) Q:%="" S XQNTREE=XQNTREE+1
73 ;
74 W:$D(XQFG) !!?20,"Primary menus found in the New Person file",!?20,"------------------------------------------"
75 W:$D(XQFG) !!,"OPTION NAME MENU TEXT",?49,"# OF",?62,"LAST",?71,"LAST",!?49,"USERS",?62,"USED",?71,"BUILT",!
76 S X="" F XQBLD=0:0 S XQBLD=$O(^TMP($J,XQBLD)) Q:XQBLD'>0!(X=U) I $D(^DIC(19,XQBLD,0)) S XQJ=^DIC(19,XQBLD,0) D VER
77 S XQSEC=0 I $D(XQFG),XQBSEC W !!,"Building secondary menu trees...."
78 I XQBSEC S X="" F XQBLD=0:0 S XQBLD=$O(^TMP($J,"SEC",XQBLD)) Q:XQBLD'>0 D SEC
79 I 'XQVE S XQK="P" F XQBLD=0:0 S XQK=$O(^TMP("XQO",$J,XQK)) Q:XQK'["P" S ^(XQK,0)=XQH
80 G BLDEND
81 ;
82SEC S XQL="P"_XQBLD Q:$D(^TMP("XQO",$J,XQL)) D RD3 Q
83 S XQL="P" F XQN=0:0 S XQL=$O(^TMP("XQO",$J,XQL)) Q:$E(XQL)'="P" I $D(^TMP("XQO",$J,XQL,"^",XQBLD)) Q
84 D:$E(XQL)'="P" RD3
85 Q
86 ;
87VER I $D(XQFG) D
88 .N XQMT,XQOPNM
89 .S XQK=$P(^TMP($J,XQBLD),U,2)
90 .S:$L(XQK) XQK=$E(XQK,4,5)_"/"_$E(XQK,6,7)_"/"_$E(XQK,2,3)
91 .S XQOPNM=$P(XQJ,U)
92 .S XQMT=$P(XQJ,U,2) I $L(XQMT)>28 S XQMT=$E(XQMT,1,25)_"..."
93 .W !,$P(XQJ,U,1)
94 .W:($L(XQOPNM)>20) !
95 .W ?20,XQMT,?49,+^TMP($J,XQBLD),?60,XQK
96 .Q
97 ;
98 I $D(XQFG) S:$D(^DIC(19,"AXQ","P"_XQBLD,0)) XQ81T=+^(0) I $L(XQ81T) S %H=XQ81T D YMD^%DTC S XQK=X W ?71,$E(XQK,4,5),"/",$E(XQK,6,7),"/",$E(XQK,2,3)
99 ;
100RD3 ;Update counter an rebuild it if necessary
101 I $D(XQFG),XPDIDVT D
102 .N %
103 .S XQNDONE=XQNDONE+1
104 .S %=(XQNDONE/XQNTREE)*XPDIDTOT
105 .D UPDATE^XPDID(%)
106 .Q
107 ;
108 S XQDIC="P"_XQBLD D CHK^XQ8 I XQRE W:$D(XQFG) !,"SOMEONE ELSE IS CURRENTLY REBUILDING THIS MENU" Q
109 I XQVE,XQSEC S DIR(0)="Y",DIR("A")="Rebuild",DIR("B")="YES" D ^DIR Q:$D(DIRUT) W ! Q:Y'=1
110 S XQFG1=1 D PM2^XQ8
111 I $D(ZTQUEUED) S ZTREQ="@"
112 Q
113 ;
114SET G:'$D(^VA(200,XQI,201)) SET1 S XQK=+^(201) Q:'$L(XQK) ;I $D(XQFG) W:'(XQI#10) "."
115 S XQR="" S:$D(^VA(200,XQI,1.1)) XQR=$P(^(1.1),".",1) S XQP=1_U_XQR
116 I $D(^TMP($J,XQK)) S XQP=^TMP($J,XQK) S XQP=XQP+1_U_$S(XQR>$P(XQP,U,2):XQR,1:$P(XQP,U,2))
117 I $D(^DIC(19,XQK,0)),$P(^(0),U,4)="M" S ^TMP($J,XQK)=XQP
118 ;
119SET1 I XQBSEC F XQN=0:0 S XQN=$O(^VA(200,XQI,203,XQN)) Q:XQN'>0 S XQL=+^(XQN,0) I $D(^DIC(19,XQL,0)),$P(^(0),U,4)="M" S ^TMP($J,"SEC",XQL)=""
120 Q
121 ;
122QUE ;Entry point for the option XQBUILDTREEQUE, and XQBUILDALL
123 ;Also called by CHEK^XQ83
124 S XQVE=0,XQBSEC=1 K XQFG
125 S XQSTART=$$HTE^XLFDT($H)
126 G DQ
127 ;
128BLDEND ;File a report, cleanup, and quit.
129 ;
130 K %,%H,%TG,C,D,DIC,DIR,I,J,K,L,V,XQBSEC,X,Y,Z,XQL,XQN,XQRE,XQK,XQI,XQII,UU,XQH,XQPX,XQSAV,XQXUF,XQ81T,XQDATE,XQSEC,XQVE,XQBLD,XQP,XQR,XQJ
131 ;
132 I $D(XQALLDON) K XQALLDON Q ;Quit here if we're just creating a task
133 ;
134 D MERGET
135 D CLEAN
136 D MERGEX
137 ;
138 K ^TMP($J),^TMP("XQO",$J)
139 ;
140 ;Clear the flags and locks.
141 K ^XUTL("XQMERGED") ;Menues merged since last rebuild REACT^XQ84
142 K ^DIC(19,"AT") ;Micro message nodes
143 S ^XUTL("XQ","MICRO")=0 ;Number of Micro instances since last build
144 K ^DIC(19,"AXQ","P0","STOP") ;Allow Micro surgery to start up
145 K ^DIC(19,"AXQ","P0") ;Clear the rebuild flag (redundant, I know)
146 L -^DIC(19,"AXQ","P0") ;Unlock the rebuild flag, everybody's good to go
147 ;
148 S %=$S($D(XPDNM):"KIDS",$D(ZTSK):"QUEUED",1:"LIVE")
149 D REPORT^XQ84(%)
150 K XQSTART,ZTSK
151 ;
152 I '$D(XPDIDVT) K XQFG Q
153 ;
154 I $D(XQFG),XPDIDVT F %=((XQNDONE/XQNTREE)*XPDIDTOT):1:XPDIDTOT D UPDATE^XPDID(%) H .25
155 I $D(XQFG),XPDIDVT D UPDATE^XPDID(XPDIDTOT)
156 I $D(XQFG) W !!,"Menu Rebuild Complete: ",$$HTE^XLFDT($H)
157 ;
158 ;
159 H 2
160 ;If we're not from KIDS then clean it up, otherwise let kids do it.
161 I '$D(XPDNM) D
162 .D EXIT^XPDID()
163 .K XPDIDVT,XPDIDTOT
164 .Q
165 ;
166 I $D(XQSAVTOT) S XPDIDTOT=XQSAVTOT
167 K %,VALMCOFF,VALMCON,VALMIOXY,VALMSGR,VALMWD,XQFG,XQNDONE,XQNTREE,XQSAVTOT
168 Q
169 ;
170 ;================================Subroutines==========================
171 ;
172MERGET ;Merge ^TMP("XQO",$J) into ^DIC(19,"AXQ")
173 N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""
174 I $D(XQFG) W !!,"Merging...."
175 F S X=$O(^TMP("XQO",$J,X)) Q:X="" D
176 .L +^DIC(19,"AXQ",X):2 I '$T S XQFLAG=1 Q
177 .S %X="^TMP(""XQO"","_$J_","_Q_X_Q_","
178 .S %Y="^DIC(19,""AXQ"","_Q_X_Q_","
179 .K ^DIC(19,"AXQ",X)
180 .;M ^DIC(19,"AXQ",X)=^TMP("XQO",$J,X)
181 .D %XY^%RCR
182 .L -^DIC(19,"AXQ",X)
183 .K %X,%Y
184 .Q
185 ;
186 I XQFLAG,$D(XQFG) D
187 .N %,Y
188 .S Y=$P(X,"P",2) Q:Y=""
189 .S %=$G(^DIC(19,Y,0)) Q:%=""
190 .S Y=$P(%,"^",2) Q:%=""
191 .W !,?12,"Could not merge menu: "_Y
192 .Q
193 Q
194 ;
195CLEAN ;Clean out unused menu trees from ^DIC(19,"AXQ")
196 N X,Y S X="P"
197 F S X=$O(^DIC(19,"AXQ",X)) Q:X="" D
198 .I X'="PXU" D
199 ..S Y=$E(X,2,99)
200 ..I '$D(^TMP($J,Y))&('$D(^TMP($J,"SEC",Y))) K ^DIC(19,"AXQ",X),^XUTL("XQO",X)
201 ..Q
202 .Q
203 Q
204 ;
205MERGEX ;Merge ^DIC(19,"AXQ") into ^XUTL("XQO")
206 N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""
207 F S X=$O(^DIC(19,"AXQ",X)) Q:X="" D
208 .L +^XUTL("XQO",X):2 I '$T S XQFLAG=1 Q
209 .S %X="^DIC(19,""AXQ"","_Q_X_Q_","
210 .S %Y="^XUTL(""XQO"","_Q_X_Q_","
211 .K ^XUTL("XQO",X)
212 .;M ^XUTL("XQO",X)=^DIC(19,"AXQ",X)
213 .D %XY^%RCR
214 .L -^XUTL("XQO",X)
215 .K %X,%Y
216 .Q
217 ;
218 I XQFLAG,$D(XQFG) D
219 .N %,Y
220 .S Y=$P(X,"P",2) Q:Y=""
221 .S %=$G(^DIC(19,Y,0)) Q:%=""
222 .S Y=$P(%,"^",2) Q:%=""
223 .W !,?12,"Could not merge menu: "_Y
224 .Q
225 ;
226 I 'XQFLAG,$D(XQFG) W " done."
227 Q
228 ;
229STATUS() ;Are the menus being rebuilt even as we speak?
230 N %,XQTHEN
231 S %=$G(^DIC(19,"AXQ","P0")) I %="" Q 1 ;It finished. Never mind.
232 L +^DIC(19,"AXQ","P0"):0 ;If job is still running we can't lock it
233 I $T L -^DIC(19,"AXQ","P0") K ^("P0") Q 1 ;Job must have failed
234 Q 0
235 ;
236 ;
237MICRO ;Turn off micro surgery
238 I $D(^DIC(19,"AXQ","P0","MICRO")) D
239 .S ^DIC(19,"AXQ","P0","STOP")=$H ;Turn off micro-surgery
240 .K ^DIC(19,"AXQ","P0","MICRO")
241 .H 2
242 .Q
243 Q
244 ;
245 ;
246ERR ;Come here on error
247 N XQERROR
248 S XQERROR=$$EC^%ZOSV
249 D ^%ZTER
250 D EXIT^XPDID()
251 G UNWIND^%ZTER
252 Q
Note: See TracBrowser for help on using the repository browser.