XQ83 ;SF-ISC.SEA/JLI/LUKE,ISD/HGW - FIND ^XUTL NODES NEEDING SURGERY ;05/01/12 09:43
;;8.0;KERNEL;**60,157,286,593**;Jul 10, 1995;Build 8
;Per VHA Directive 2004-038, this routine should not be modified
Q
DQ ;TaskMan entry fired by CHEK below
;
Q:'$D(^DIC(19,"AT")) ;Nothing to do
;
I $D(^DIC(19,"AXQ","P0"))=1 D ;Somebody is rebuilding menus
.L +^DIC(19,"AXQ","P0"):DILOCKTM ;If we can lock it the flag is bogus ;P593
.I $T L -^DIC(19,"AXQ","P0") K ^DIC(19,"AXQ","P0")
.Q
Q:$D(^DIC(19,"AXQ","P0"))=1
;
I $D(^DIC(19,"AXQ","P0","STOP")) D
.N X,Y,Z
.S X=$G(^DIC(19,"AXQ","P0","STOP")) Q:X=""
.S Y=$H
.S Z=$$HDIFF^XLFDT(Y,X,1)
.I Z>0 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag left over from yesterday
.S Z=$$HDIFF^XLFDT(Y,X,2)
.I Z>11000 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag is over 2 hours old
.Q
Q:$D(^DIC(19,"AXQ","P0","STOP")) ;Rebuilding - stop micro surgery
;
S ^DIC(19,"AXQ","P0","MICRO")=$H ;Set the 'I am working' flag.
;
D NOW^%DTC ;Returns: %=3010706.131332, %H=58626,47612, X=3010706
S X=% S %XQT1=X H 2
S XQSTART=$$HTE^XLFDT($H) ;Returns: Jul 06, 2001@13:19:20
;
S X1=X,X2=-21 D C^%DTC F %K=0:0 S %K=$O(^DIC(19,"AT",%K)) Q:%K'>0!(%K'<X) K ^(%K) ;Kill of those that are 21 days old
S X=DT+2 F S X=$O(^DIC(19,"AT",X)) Q:X'>0 S %K="" F S %K=$O(^DIC(19,"AT",X,%K)) Q:%K="" W !,X K ^(%K) S ^DIC(19,"AT",$$NOW^XLFDT(),%K)="" W " ",$$NOW^XLFDT()
;Kill off old "AT" nodes
;
LOOP ;Main loop
;
;I $D(^DIC(19,"AXQ","P0","STOP")) G KILL
K ^TMP($J) S X=%XQT,%XQX="",N=0 F %K=X:0 S %K=$O(^DIC(19,"AT",%K)) Q:%K'>0!(%K>%XQT1) S %XQT=%K,%Z="" F %J=0:0 S %Z=$O(^DIC(19,"AT",%K,%Z)) Q:%Z="" S N=N+1,^TMP($J,N,%Z)="",^TMP($J,"A",%Z,N)=""
;$O through "AT" and set up lists in ^TMP, ^TMP($J,"A" is the XREF
;
I '$D(^TMP($J)) S XQN="P0",X=%XQT D H^%DTC S %XQT=%H_","_%T F %K=0:0 S XQN=$O(^XUTL("XQO",XQN)) Q:$E(XQN)'="P" S ^(XQN,0)=%XQT
I '$D(^TMP($J)) G KILL
;If nothing appears in TMP quit
;
S %Z="" F %K=0:0 S %Z=$O(^TMP($J,"A",%Z)) Q:%Z="" F N=0:0 S N=$O(^TMP($J,"A",%Z,N)) Q:N'>0 I $O(^(N))>0 K ^TMP($J,N)
;F N=0:0 S N=$O(^TMP($J,N)) Q:N'>0 S %Z=$O(^(N,"")),%X1=+%Z,%XC=$E(%Z,$L(%X1)+1,99),%X2=$E(%XC,2,99),XJ=$S(%XC="DIFROM":"DNUL",%XC["I":"DINS",%XC["D":"DDEL",%Z=+%Z:"DREG",%XC["S":"DSYN",%XC["P":"DPRI",1:"DNUL") D @XJ
F XQXM=0:0 S XQXM=$O(^TMP($J,XQXM)) Q:XQXM'>0 S XQOP=$O(^(XQXM,"")),XQENT=$S(XQOP["S":"SYN",XQOP["I":"INS",XQOP["D":"DEL",XQOP["P":"PRI",1:"REG") D @XQENT
;solve the entry for the type of operation needs to be performed and
; to that code below.
;Remove the "AT" nodes that we processed
F XQI=0:0 S XQI=$O(^DIC(19,"AT",XQI)) Q:(XQI'<%XQT1)!(XQI<1) K ^(XQI)
D NOW^%DTC S %XQT=%XQT1 S:%=0 %="" S %XQT1=X H 2
G LOOP
;
DINS F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 I $D(^(%M,(%X1_"D"_%X2)))!$D(^(%X1))!$D(^(%X2)) K ^TMP($J,N) Q
I $D(^TMP($J,N)) F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 I $D(^(%M,(%X1_"S"_%X2))) K ^TMP($J,%M)
Q
DDEL F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 I $D(^(%M,(%X1_"I"_%X2))) K ^TMP($J,N) Q
I $D(^TMP($J,N)) F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 I $D(^(%M,(%X1_"S"_%X2))) K ^TMP($J,%M)
Q
DREG F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 S X=$O(^(%M,"")) I X[("I"_%X2)!(X[("S"_%X2)) K ^TMP($J,%M)
Q
DSYN F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 S X=$O(^(%M,"")) I X=%X2!(X=(%X1_"I"_%X2)) K ^TMP($J,N) Q
Q
DNUL K ^TMP($J,N)
DPRI Q
;
DEL S XQC="D" D SPLIT D ^XQ83D Q
;
DIFROM S XQH=%XQT D QUE^XQ81
G KILL
;
INS S XQC="I" D SPLIT D ^XQ83A Q
;
SYN S XQC="S" D SPLIT D SYN^XQ83R Q
;
REG S XQC="" D REG^XQ83R Q
;
PRI ; Enter a new Primary menu
S XQC="P" D SPLIT S (A,XQDIC)="P"_XQOPM,XQVE=0,XQRB=0,XQFG1=1 K XQFG L +^XUTL("XQO",A):0 D PM1^XQ8 S ^XUTL("XQO",XQDIC,0)=%XQT1 L -^XUTL("XQO",XQDIC)
Q
;
SPLIT S XQOPM=+XQOP,XQOPI=+$P(XQOP,XQC,2),XQC1=XQOPM_","_XQOPI_",",XQC2=","_XQC1,XQOPI1=XQOPI_",",XQOPI2=","_XQOPI1 Q
;
;
CHEKV ;First see if the compiled menus live on this system
;If so fall through to CHEK, else quit (called by XQOO*)
Q:'$D(^XUTL("XQO"))
;
CHEK ;See if microsurgery needs to be run here
;Called by XUS+25 and XUSG+18
;Also kicked off by the option XQKICKMICRO
;
Q:'$D(^DIC(19,"AT")) ;Nothing to do
;
I $D(^DIC(19,"AXQ","P0"))=1 D ;Somebody is rebuilding menus
.L +^DIC(19,"AXQ","P0"):DILOCKTM ;If we can lock it the flag is bogus ;P593
.I $T L -^DIC(19,"AXQ","P0") K ^DIC(19,"AXQ","P0")
.Q
Q:$D(^DIC(19,"AXQ","P0"))=1
;
I $D(^DIC(19,"AXQ","P0","STOP")) D
.N X,Y,Z
.S X=$G(^DIC(19,"AXQ","P0","STOP")) Q:X=""
.S Y=$H
.S Z=$$HDIFF^XLFDT(Y,X,1)
.I Z>0 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag left over from yesterday
.S Z=$$HDIFF^XLFDT(Y,X,2)
.I Z>11000 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag is over 2 hours old
.Q
Q:$D(^DIC(19,"AXQ","P0","STOP")) ;Rebuilding - stop micro surgery
;
;If the compiled menus do not exist on "AXQ" rebuild all of them
S %XQH=$O(^DIC(19,"AXQ","P")) I %XQH'["P" D Q
.;S ^DIC(19,"AXQ","P0")=$H
.S ZTIO="",ZTDTH=$H,ZTRTN="QUE^XQ81",ZTSAVE("DUZ")=.5
.D SETVOL
.D ^%ZTLOAD
.Q
;
Q:'$D(^XUTL("XQO",%XQH,0)) L ^XUTL("XQO",%XQH,0):DILOCKTM I '$T K %XQH Q ;P593
;If the first menu has a 0th node lock it, if it won't lock quit
N X S %H=$P(^XUTL("XQO",%XQH,0),U,1) D YMD^%DTC S:%>.001 %=%-.001 S:%=0 %="" S %XQT=X_%
;Get date off first entry set %XQT (looks like: 3000414.081043)
S %XQX="",%ZO="" S:'$D(XQM) XQM=+$G(^VA(200,DUZ,201)) I XQM>0,'$D(^XUTL("XQO","P"_XQM)) S %XQX=XQM_"P",^DIC(19,"AT",%XQT+.0001,%XQX)=""
;Set Primary menu of this user, if not there flag it in "AT" it looks
; like this: ^DIC(19,"AT",3000414.081143,9P)
;I $O(^DIC(19,"AT",%XQT))>0
;
S ^DIC(19,"AXQ","P0","MICRO")=$H,%XQX=1
S %TIM=$P($H,",")-1_","_$P($H,",",2)
L -^XUTL("XQO",%XQH,0)
;
S ZTDESC="MICRO UPDATING XUTL",ZTRTN="DQ^XQ83",ZTSAVE("%XQT")="",ZTSAVE("DUZ")=.5,ZTDTH=%TIM,ZTIO="" D:'$D(ZTCPU) SETVOL D ^%ZTLOAD
;Unlock the node and task off DQ above and quit
;
Q
SETVOL ;
X ^%ZOSF("UCI") S ZTCPU=$P(Y,",",2),ZTUCI=$P(Y,",")
Q
;
KILL D REPORT^XQ84("MICRO")
K ^DIC(19,"AXQ","P0","MICRO")
;
K %,%H,%J,%K,%M,%X1,%X2,%TIM,%XQT1,%XQH,%I,%T,%XQA,%XQX,%XQT,%XQX1,%XQX2,%XQY,A,B,I,I0,%Z,%ZO
K J,K,M,N,P,X1,X2,XQA,XQC,XQC1,XQC2,XQE,XQENT,XQK,XQOP,XQOPI,XQOPI1,XQOPI2
K XQI,XQH,XQFG1,XQM,XQN,XQOPM,XQOPS,XQP,XQRB,XQSTART,XQVE,XQXM,Y
I $D(ZTQUEUED) S ZTREQ="@"
Q
XQ83 ;SF-ISC.SEA/JLI/LUKE,ISD/HGW - FIND ^XUTL NODES NEEDING SURGERY ;05/01/12 09:43
+1 ;;8.0;KERNEL;**60,157,286,593**;Jul 10, 1995;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
DQ ;TaskMan entry fired by CHEK below
+1 ;
+2 ;Nothing to do
IF '$DATA(^DIC(19,"AT"))
QUIT
+3 ;
+4 ;Somebody is rebuilding menus
IF $DATA(^DIC(19,"AXQ","P0"))=1
Begin DoDot:1
+5 ;If we can lock it the flag is bogus ;P593
LOCK +^DIC(19,"AXQ","P0"):DILOCKTM
+6 IF $TEST
LOCK -^DIC(19,"AXQ","P0")
KILL ^DIC(19,"AXQ","P0")
+7 QUIT
End DoDot:1
+8 IF $DATA(^DIC(19,"AXQ","P0"))=1
QUIT
+9 ;
+10 IF $DATA(^DIC(19,"AXQ","P0","STOP"))
Begin DoDot:1
+11 NEW X,Y,Z
+12 SET X=$GET(^DIC(19,"AXQ","P0","STOP"))
IF X=""
QUIT
+13 SET Y=$HOROLOG
+14 SET Z=$$HDIFF^XLFDT(Y,X,1)
+15 ;Flag left over from yesterday
IF Z>0
KILL ^DIC(19,"AXQ","P0","STOP")
QUIT
+16 SET Z=$$HDIFF^XLFDT(Y,X,2)
+17 ;Flag is over 2 hours old
IF Z>11000
KILL ^DIC(19,"AXQ","P0","STOP")
QUIT
+18 QUIT
End DoDot:1
+19 ;Rebuilding - stop micro surgery
IF $DATA(^DIC(19,"AXQ","P0","STOP"))
QUIT
+20 ;
+21 ;Set the 'I am working' flag.
SET ^DIC(19,"AXQ","P0","MICRO")=$HOROLOG
+22 ;
+23 ;Returns: %=3010706.131332, %H=58626,47612, X=3010706
DO NOW^%DTC
+24 SET X=%
SET %XQT1=X
HANG 2
+25 ;Returns: Jul 06, 2001@13:19:20
SET XQSTART=$$HTE^XLFDT($HOROLOG)
+26 ;
+27 ;Kill of those that are 21 days old
SET X1=X
SET X2=-21
DO C^%DTC
FOR %K=0:0
SET %K=$ORDER(^DIC(19,"AT",%K))
IF %K'>0!(%K'<X)
QUIT
KILL ^(%K)
+28 SET X=DT+2
FOR
SET X=$ORDER(^DIC(19,"AT",X))
IF X'>0
QUIT
SET %K=""
FOR
SET %K=$ORDER(^DIC(19,"AT",X,%K))
IF %K=""
QUIT
WRITE !,X
KILL ^(%K)
SET ^DIC(19,"AT",$$NOW^XLFDT(),%K)=""
WRITE " ",$$NOW^XLFDT()
+29 ;Kill off old "AT" nodes
+30 ;
LOOP ;Main loop
+1 ;
+2 ;I $D(^DIC(19,"AXQ","P0","STOP")) G KILL
+3 KILL ^TMP($JOB)
SET X=%XQT
SET %XQX=""
SET N=0
FOR %K=X:0
SET %K=$ORDER(^DIC(19,"AT",%K))
IF %K'>0!(%K>%XQT1)
QUIT
SET %XQT=%K
SET %Z=""
FOR %J=0:0
SET %Z=$ORDER(^DIC(19,"AT",%K,%Z))
IF %Z=""
QUIT
SET N=N+1
SET ^TMP($JOB,N,%Z)=""
SET ^TMP($JOB,"A",%Z,N)=""
+4 ;$O through "AT" and set up lists in ^TMP, ^TMP($J,"A" is the XREF
+5 ;
+6 IF '$DATA(^TMP($JOB))
SET XQN="P0"
SET X=%XQT
DO H^%DTC
SET %XQT=%H_","_%T
FOR %K=0:0
SET XQN=$ORDER(^XUTL("XQO",XQN))
IF $EXTRACT(XQN)'="P"
QUIT
SET ^(XQN,0)=%XQT
+7 IF '$DATA(^TMP($JOB))
GOTO KILL
+8 ;If nothing appears in TMP quit
+9 ;
+10 SET %Z=""
FOR %K=0:0
SET %Z=$ORDER(^TMP($JOB,"A",%Z))
IF %Z=""
QUIT
FOR N=0:0
SET N=$ORDER(^TMP($JOB,"A",%Z,N))
IF N'>0
QUIT
IF $ORDER(^(N))>0
KILL ^TMP($JOB,N)
+11 ;F N=0:0 S N=$O(^TMP($J,N)) Q:N'>0 S %Z=$O(^(N,"")),%X1=+%Z,%XC=$E(%Z,$L(%X1)+1,99),%X2=$E(%XC,2,99),XJ=$S(%XC="DIFROM":"DNUL",%XC["I":"DINS",%XC["D":"DDEL",%Z=+%Z:"DREG",%XC["S":"DSYN",%XC["P":"DPRI",1:"DNUL") D @XJ
+12 FOR XQXM=0:0
SET XQXM=$ORDER(^TMP($JOB,XQXM))
IF XQXM'>0
QUIT
SET XQOP=$ORDER(^(XQXM,""))
SET XQENT=$SELECT(XQOP["S":"SYN",XQOP["I":"INS",XQOP["D":"DEL",XQOP["P":"PRI",1:"REG")
DO @XQENT
+13 ;solve the entry for the type of operation needs to be performed and
+14 ; to that code below.
+15 ;Remove the "AT" nodes that we processed
+16 FOR XQI=0:0
SET XQI=$ORDER(^DIC(19,"AT",XQI))
IF (XQI'<%XQT1)!(XQI<1)
QUIT
KILL ^(XQI)
+17 DO NOW^%DTC
SET %XQT=%XQT1
IF %=0
SET %=""
SET %XQT1=X
HANG 2
+18 GOTO LOOP
+19 ;
DINS FOR %M=N:0
SET %M=$ORDER(^TMP($JOB,%M))
IF %M'>0
QUIT
IF $DATA(^(%M,(%X1_"D"_%X2)))!$DATA(^(%X1))!$DATA(^(%X2))
KILL ^TMP($JOB,N)
QUIT
+1 IF $DATA(^TMP($JOB,N))
FOR %M=N:0
SET %M=$ORDER(^TMP($JOB,%M))
IF %M'>0
QUIT
IF $DATA(^(%M,(%X1_"S"_%X2)))
KILL ^TMP($JOB,%M)
+2 QUIT
DDEL FOR %M=N:0
SET %M=$ORDER(^TMP($JOB,%M))
IF %M'>0
QUIT
IF $DATA(^(%M,(%X1_"I"_%X2)))
KILL ^TMP($JOB,N)
QUIT
+1 IF $DATA(^TMP($JOB,N))
FOR %M=N:0
SET %M=$ORDER(^TMP($JOB,%M))
IF %M'>0
QUIT
IF $DATA(^(%M,(%X1_"S"_%X2)))
KILL ^TMP($JOB,%M)
+2 QUIT
DREG FOR %M=N:0
SET %M=$ORDER(^TMP($JOB,%M))
IF %M'>0
QUIT
SET X=$ORDER(^(%M,""))
IF X[("I"_%X2)!(X[("S"_%X2))
KILL ^TMP($JOB,%M)
+1 QUIT
DSYN FOR %M=N:0
SET %M=$ORDER(^TMP($JOB,%M))
IF %M'>0
QUIT
SET X=$ORDER(^(%M,""))
IF X=%X2!(X=(%X1_"I"_%X2))
KILL ^TMP($JOB,N)
QUIT
+1 QUIT
DNUL KILL ^TMP($JOB,N)
DPRI QUIT
+1 ;
DEL SET XQC="D"
DO SPLIT
DO ^XQ83D
QUIT
+1 ;
DIFROM SET XQH=%XQT
DO QUE^XQ81
+1 GOTO KILL
+2 ;
INS SET XQC="I"
DO SPLIT
DO ^XQ83A
QUIT
+1 ;
SYN SET XQC="S"
DO SPLIT
DO SYN^XQ83R
QUIT
+1 ;
REG SET XQC=""
DO REG^XQ83R
QUIT
+1 ;
PRI ; Enter a new Primary menu
+1 SET XQC="P"
DO SPLIT
SET (A,XQDIC)="P"_XQOPM
SET XQVE=0
SET XQRB=0
SET XQFG1=1
KILL XQFG
LOCK +^XUTL("XQO",A):0
DO PM1^XQ8
SET ^XUTL("XQO",XQDIC,0)=%XQT1
LOCK -^XUTL("XQO",XQDIC)
+2 QUIT
+3 ;
SPLIT SET XQOPM=+XQOP
SET XQOPI=+$PIECE(XQOP,XQC,2)
SET XQC1=XQOPM_","_XQOPI_","
SET XQC2=","_XQC1
SET XQOPI1=XQOPI_","
SET XQOPI2=","_XQOPI1
QUIT
+1 ;
+2 ;
CHEKV ;First see if the compiled menus live on this system
+1 ;If so fall through to CHEK, else quit (called by XQOO*)
+2 IF '$DATA(^XUTL("XQO"))
QUIT
+3 ;
CHEK ;See if microsurgery needs to be run here
+1 ;Called by XUS+25 and XUSG+18
+2 ;Also kicked off by the option XQKICKMICRO
+3 ;
+4 ;Nothing to do
IF '$DATA(^DIC(19,"AT"))
QUIT
+5 ;
+6 ;Somebody is rebuilding menus
IF $DATA(^DIC(19,"AXQ","P0"))=1
Begin DoDot:1
+7 ;If we can lock it the flag is bogus ;P593
LOCK +^DIC(19,"AXQ","P0"):DILOCKTM
+8 IF $TEST
LOCK -^DIC(19,"AXQ","P0")
KILL ^DIC(19,"AXQ","P0")
+9 QUIT
End DoDot:1
+10 IF $DATA(^DIC(19,"AXQ","P0"))=1
QUIT
+11 ;
+12 IF $DATA(^DIC(19,"AXQ","P0","STOP"))
Begin DoDot:1
+13 NEW X,Y,Z
+14 SET X=$GET(^DIC(19,"AXQ","P0","STOP"))
IF X=""
QUIT
+15 SET Y=$HOROLOG
+16 SET Z=$$HDIFF^XLFDT(Y,X,1)
+17 ;Flag left over from yesterday
IF Z>0
KILL ^DIC(19,"AXQ","P0","STOP")
QUIT
+18 SET Z=$$HDIFF^XLFDT(Y,X,2)
+19 ;Flag is over 2 hours old
IF Z>11000
KILL ^DIC(19,"AXQ","P0","STOP")
QUIT
+20 QUIT
End DoDot:1
+21 ;Rebuilding - stop micro surgery
IF $DATA(^DIC(19,"AXQ","P0","STOP"))
QUIT
+22 ;
+23 ;If the compiled menus do not exist on "AXQ" rebuild all of them
+24 SET %XQH=$ORDER(^DIC(19,"AXQ","P"))
IF %XQH'["P"
Begin DoDot:1
+25 ;S ^DIC(19,"AXQ","P0")=$H
+26 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTRTN="QUE^XQ81"
SET ZTSAVE("DUZ")=.5
+27 DO SETVOL
+28 DO ^%ZTLOAD
+29 QUIT
End DoDot:1
QUIT
+30 ;
+31 ;P593
IF '$DATA(^XUTL("XQO",%XQH,0))
QUIT
LOCK ^XUTL("XQO",%XQH,0):DILOCKTM
IF '$TEST
KILL %XQH
QUIT
+32 ;If the first menu has a 0th node lock it, if it won't lock quit
+33 NEW X
SET %H=$PIECE(^XUTL("XQO",%XQH,0),U,1)
DO YMD^%DTC
IF %>.001
SET %=%-.001
IF %=0
SET %=""
SET %XQT=X_%
+34 ;Get date off first entry set %XQT (looks like: 3000414.081043)
+35 SET %XQX=""
SET %ZO=""
IF '$DATA(XQM)
SET XQM=+$GET(^VA(200,DUZ,201))
IF XQM>0
IF '$DATA(^XUTL("XQO","P"_XQM))
SET %XQX=XQM_"P"
SET ^DIC(19,"AT",%XQT+.0001,%XQX)=""
+36 ;Set Primary menu of this user, if not there flag it in "AT" it looks
+37 ; like this: ^DIC(19,"AT",3000414.081143,9P)
+38 ;I $O(^DIC(19,"AT",%XQT))>0
+39 ;
+40 SET ^DIC(19,"AXQ","P0","MICRO")=$HOROLOG
SET %XQX=1
+41 SET %TIM=$PIECE($HOROLOG,",")-1_","_$PIECE($HOROLOG,",",2)
+42 LOCK -^XUTL("XQO",%XQH,0)
+43 ;
+44 SET ZTDESC="MICRO UPDATING XUTL"
SET ZTRTN="DQ^XQ83"
SET ZTSAVE("%XQT")=""
SET ZTSAVE("DUZ")=.5
SET ZTDTH=%TIM
SET ZTIO=""
IF '$DATA(ZTCPU)
DO SETVOL
DO ^%ZTLOAD
+45 ;Unlock the node and task off DQ above and quit
+46 ;
+47 QUIT
SETVOL ;
+1 XECUTE ^%ZOSF("UCI")
SET ZTCPU=$PIECE(Y,",",2)
SET ZTUCI=$PIECE(Y,",")
+2 QUIT
+3 ;
KILL DO REPORT^XQ84("MICRO")
+1 KILL ^DIC(19,"AXQ","P0","MICRO")
+2 ;
+3 KILL %,%H,%J,%K,%M,%X1,%X2,%TIM,%XQT1,%XQH,%I,%T,%XQA,%XQX,%XQT,%XQX1,%XQX2,%XQY,A,B,I,I0,%Z,%ZO
+4 KILL J,K,M,N,P,X1,X2,XQA,XQC,XQC1,XQC2,XQE,XQENT,XQK,XQOP,XQOPI,XQOPI1,XQOPI2
+5 KILL XQI,XQH,XQFG1,XQM,XQN,XQOPM,XQOPS,XQP,XQRB,XQSTART,XQVE,XQXM,Y
+6 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
