151 lines
5.9 KiB
Mathematica
151 lines
5.9 KiB
Mathematica
XQ83 ;SF-ISC.SEA/JLI/LUKE - FIND ^XUTL NODES NEEDING SURGERY ;04/08/2003 11:46
|
|
;;8.0;KERNEL;**60,157,286**;Jul 10, 1995
|
|
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"):0 ;If we can lock it the flag is bogus
|
|
.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 says 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="" K ^(%K) S ^DIC(19,"AT",$$NOW^XLFDT(),%K)=""
|
|
;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"):0 ;If we can lock it the flag is bogus
|
|
.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):0 I '$T K %XQH Q
|
|
;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
|