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

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
[613]1XQ83 ;SF-ISC.SEA/JLI/LUKE - FIND ^XUTL NODES NEEDING SURGERY ;04/08/2003 11:46
2 ;;8.0;KERNEL;**60,157,286**;Jul 10, 1995
3 Q
4DQ ;TaskMan entry fired by CHEK below
5 ;
6 Q:'$D(^DIC(19,"AT")) ;Nothing to do
7 ;
8 I $D(^DIC(19,"AXQ","P0"))=1 D ;Somebody is rebuilding menus
9 .L +^DIC(19,"AXQ","P0"):0 ;If we can lock it the flag is bogus
10 .I $T L -^DIC(19,"AXQ","P0") K ^DIC(19,"AXQ","P0")
11 .Q
12 Q:$D(^DIC(19,"AXQ","P0"))=1
13 ;
14 I $D(^DIC(19,"AXQ","P0","STOP")) D
15 .N X,Y,Z
16 .S X=$G(^DIC(19,"AXQ","P0","STOP")) Q:X=""
17 .S Y=$H
18 .S Z=$$HDIFF^XLFDT(Y,X,1)
19 .I Z>0 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag left over from yesterday
20 .S Z=$$HDIFF^XLFDT(Y,X,2)
21 .I Z>11000 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag is over 2 hours old
22 .Q
23 Q:$D(^DIC(19,"AXQ","P0","STOP")) ;Rebuilding - stop micro surgery
24 ;
25 S ^DIC(19,"AXQ","P0","MICRO")=$H ;Set the 'I am working' flag.
26 ;
27 D NOW^%DTC ;Returns: %=3010706.131332, %H=58626,47612, X=3010706
28 S X=% S %XQT1=X H 2
29 S XQSTART=$$HTE^XLFDT($H) ;Returns: Jul 06, 2001@13:19:20
30 ;
31 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
32 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)=""
33 ;Kill off old "AT" nodes
34 ;
35LOOP ;Main loop
36 ;
37 ;I $D(^DIC(19,"AXQ","P0","STOP")) G KILL
38 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)=""
39 ;$O through "AT" and set up lists in ^TMP, ^TMP($J,"A" is the XREF
40 ;
41 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
42 I '$D(^TMP($J)) G KILL
43 ;If nothing appears in TMP quit
44 ;
45 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)
46 ;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
47 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
48 ;solve the entry for the type of operation needs to be performed and
49 ; to that code below.
50 ;Remove the "AT" nodes that we processed
51 F XQI=0:0 S XQI=$O(^DIC(19,"AT",XQI)) Q:(XQI'<%XQT1)!(XQI<1) K ^(XQI)
52 D NOW^%DTC S %XQT=%XQT1 S:%=0 %="" S %XQT1=X H 2
53 G LOOP
54 ;
55DINS 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
56 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)
57 Q
58DDEL F %M=N:0 S %M=$O(^TMP($J,%M)) Q:%M'>0 I $D(^(%M,(%X1_"I"_%X2))) K ^TMP($J,N) Q
59 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)
60 Q
61DREG 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)
62 Q
63DSYN 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
64 Q
65DNUL K ^TMP($J,N)
66DPRI Q
67 ;
68DEL S XQC="D" D SPLIT D ^XQ83D Q
69 ;
70DIFROM S XQH=%XQT D QUE^XQ81
71 G KILL
72 ;
73INS S XQC="I" D SPLIT D ^XQ83A Q
74 ;
75SYN S XQC="S" D SPLIT D SYN^XQ83R Q
76 ;
77REG S XQC="" D REG^XQ83R Q
78 ;
79PRI ; Enter a new Primary menu
80 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)
81 Q
82 ;
83SPLIT S XQOPM=+XQOP,XQOPI=+$P(XQOP,XQC,2),XQC1=XQOPM_","_XQOPI_",",XQC2=","_XQC1,XQOPI1=XQOPI_",",XQOPI2=","_XQOPI1 Q
84 ;
85 ;
86CHEKV ;First see if the compiled menus live on this system
87 ;If so fall through to CHEK, else quit (called by XQOO*)
88 Q:'$D(^XUTL("XQO"))
89 ;
90CHEK ;See if microsurgery needs to be run here
91 ;Called by XUS+25 and XUSG+18
92 ;Also kicked off by the option XQKICKMICRO
93 ;
94 Q:'$D(^DIC(19,"AT")) ;Nothing to do
95 ;
96 I $D(^DIC(19,"AXQ","P0"))=1 D ;Somebody is rebuilding menus
97 .L +^DIC(19,"AXQ","P0"):0 ;If we can lock it the flag is bogus
98 .I $T L -^DIC(19,"AXQ","P0") K ^DIC(19,"AXQ","P0")
99 .Q
100 Q:$D(^DIC(19,"AXQ","P0"))=1
101 ;
102 I $D(^DIC(19,"AXQ","P0","STOP")) D
103 .N X,Y,Z
104 .S X=$G(^DIC(19,"AXQ","P0","STOP")) Q:X=""
105 .S Y=$H
106 .S Z=$$HDIFF^XLFDT(Y,X,1)
107 .I Z>0 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag left over from yesterday
108 .S Z=$$HDIFF^XLFDT(Y,X,2)
109 .I Z>11000 K ^DIC(19,"AXQ","P0","STOP") Q ;Flag is over 2 hours old
110 .Q
111 Q:$D(^DIC(19,"AXQ","P0","STOP")) ;Rebuilding - stop micro surgery
112 ;
113 ;If the compiled menus do not exist on "AXQ" rebuild all of them
114 S %XQH=$O(^DIC(19,"AXQ","P")) I %XQH'["P" D Q
115 .;S ^DIC(19,"AXQ","P0")=$H
116 .S ZTIO="",ZTDTH=$H,ZTRTN="QUE^XQ81",ZTSAVE("DUZ")=.5
117 .D SETVOL
118 .D ^%ZTLOAD
119 .Q
120 ;
121 Q:'$D(^XUTL("XQO",%XQH,0)) L ^XUTL("XQO",%XQH,0):0 I '$T K %XQH Q
122 ;If the first menu has a 0th node lock it, if it won't lock quit
123 N X S %H=$P(^XUTL("XQO",%XQH,0),U,1) D YMD^%DTC S:%>.001 %=%-.001 S:%=0 %="" S %XQT=X_%
124 ;Get date off first entry set %XQT (looks like: 3000414.081043)
125 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)=""
126 ;Set Primary menu of this user, if not there flag it in "AT" it looks
127 ; like this: ^DIC(19,"AT",3000414.081143,9P)
128 ;I $O(^DIC(19,"AT",%XQT))>0
129 ;
130 S ^DIC(19,"AXQ","P0","MICRO")=$H,%XQX=1
131 S %TIM=$P($H,",")-1_","_$P($H,",",2)
132 L -^XUTL("XQO",%XQH,0)
133 ;
134 ;
135 S ZTDESC="MICRO UPDATING XUTL",ZTRTN="DQ^XQ83",ZTSAVE("%XQT")="",ZTSAVE("DUZ")=.5,ZTDTH=%TIM,ZTIO="" D:'$D(ZTCPU) SETVOL D ^%ZTLOAD
136 ;Unlock the node and task off DQ above and quit
137 ;
138 Q
139SETVOL ;
140 X ^%ZOSF("UCI") S ZTCPU=$P(Y,",",2),ZTUCI=$P(Y,",")
141 Q
142 ;
143KILL D REPORT^XQ84("MICRO")
144 K ^DIC(19,"AXQ","P0","MICRO")
145 ;
146 K %,%H,%J,%K,%M,%X1,%X2,%TIM,%XQT1,%XQH,%I,%T,%XQA,%XQX,%XQT,%XQX1,%XQX2,%XQY,A,B,I,I0,%Z,%ZO
147 K J,K,M,N,P,X1,X2,XQA,XQC,XQC1,XQC2,XQE,XQENT,XQK,XQOP,XQOPI,XQOPI1,XQOPI2
148 K XQI,XQH,XQFG1,XQM,XQN,XQOPM,XQOPS,XQP,XQRB,XQSTART,XQVE,XQXM,Y
149 I $D(ZTQUEUED) S ZTREQ="@"
150 Q
Note: See TracBrowser for help on using the repository browser.