XQ88 ;SF/GFT,RWF,AMF,JLI,LUKE - Build menu trees ;04/18/2002 11:08
;;8.0;KERNEL;**156**;Jul 10, 1995
;Taken from XQ8 and XQ81 to make a stripped down menu rebuild
;
TIME ;See if there are prohibited times for this option
S %XQI=$P(^DIC(19,Y,0),U,9) I $L(%XQI)>2 S XQP(L)=%XQI_"MO-FR"
I $D(^DIC(19,Y,3.91)) S %XQI=0 F S %XQI=$O(^DIC(19,Y,3.91,%XQI)) Q:%XQI'>0 S XQP(L)=$S($D(XQP(L)):XQP(L)_";",1:"")_$P(^(%XQI,0),U,1)_$P(^(0),U,2)
K %XQI I '$D(XQP(L)),$L($P(Y(0),U,9)) S XQP(L)=$P(Y(0),U,9)
Q
;
UP S X=$$UP^XLFSTR(X) ;F Z=1:1 Q:X?.NUP S W=$A(X,Z) I W<123,W>96 S X=$E(X,1,Z-1)_$C(W-32)_$E(X,Z+1,255)
Q
;
PM2 ;Enter here to rebuild a single menu Called by RD3+10
K ^TMP("XQO",$J,XQDIC) S ^XUTL("XQO",XQDIC,"^BUILD")=$P($H,",",2)
;
I XQDIC'="PXU" S Y=+$P(XQDIC,"P",2) Q:Y'>0 Q:'$D(^DIC(19,Y,0))
I '$D(XQXUF) K ^TMP("XQO",$J,"PXU") S XQSAV=XQDIC S XQDIC="PXU",Y=$O(^DIC(19,"B","XUCOMMAND",0)) S:Y>0 %="",(L,X(0))=0,XQD=Y D:Y>0 TREE1,PMOK S XQDIC=XQSAV,XQXUF=1,^TMP("XQO",$J,"PXU",0)=XQDT
I XQDIC=9!(XQDIC="P9")
;
S Y=$P(XQDIC,"P",2) G:Y'>0!'$D(^DIC(19,+Y,0)) PMOKA I Y>0,$D(^DIC(19,Y,0)),$P(^(0),U,4)="M" D PMOK S %="",(L,X(0))=0,XQD=Y D TREE1
S:$D(^DIC(19,$E(XQDIC,2,99),0)) ^(99.1)=XQDT S ^TMP("XQO",$J,XQDIC,0)=XQDT
S Y=+$P(XQDIC,"P",2)
I Y>0 S (XQD,%)=^DIC(19,Y,0),L=1,XQP(L)="" D TIME S ^TMP("XQO",$J,XQDIC,U,Y)=U_$P(%,U,1,2)_U_$S(($P(%,U,3)]""):1,1:"")_U_$P(%,U,4)_UU_$P(%,U,6,8)_U_XQP(L)_U_$P(%,U,10,99)
I Y>0,'$D(^DIC(19,Y,"U")) S XQFL=0 S:$D(X)#2 XQSAVE=X,XQFL=1 S X=$E($P(^DIC(19,+Y,0),U,2),1,30) D UP S ^("U")=X S:XQFL X=XQSAVE
I Y>0 S ^TMP("XQO",$J,XQDIC,^DIC(19,Y,"U")_U)=Y_"^0"
PMOKA K ^XUTL("XQO",XQDIC,"^BUILD") K ZTSK
PMOK K %,XQA,XQD,XQE,XQF,XQFL,XQP,XQR,XQSAVE
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
TREE ;
S X(L)=$O(^DIC(19,XQD,10,X(L))) Q:X(L)'>0 S Y=^(X(L),0),%=$P(Y,U,2),Y=+Y G:$D(XQR(Y))!'$D(^DIC(19,Y,0)) TREE S XQR(Y)=""
TREE1 S Y(0)=^DIC(19,Y,0),X=$S($D(^("U")):^("U"),1:"") I X="" S X=$E($P(Y(0),U,2),1,30) D UP S ^("U")=X
S Y(1)=X S:'$L($P(Y(0),U,5)) $P(Y(0),U,5)=0
G:$L($P(Y(0),U,3)) TREE S:$L($P(Y(0),U,6)) XQK(L)=$P(Y(0),U,6) S XQA(L)=Y S:$L($P(Y(0),U,10)) XQE(L)=$P(Y(0),U,10)
S:$P(Y(0),U,16) XQF(L)=$P(^DIC(19,Y,3),U) I $D(XQF(L)) K:XQF(L)="" XQF(L)
D TIME,PMOSET S L=L+1,X(L)=0,(XQD,XQD(L))=Y D TREE
Q:L<2 K XQR(XQD(L)) S L=L-1 K XQA(L),XQK(L),XQP(L),XQE(L),XQF(L) S XQD=XQD(L) G TREE
;
PMOSET ;
S K=0,X=$E(Y(1),1,27) I $L(X) S X=X_U D:$D(^TMP("XQO",$J,XQDIC,X))!$D(^(X_"1")) PMO3 S:L&'K ^TMP("XQO",$J,XQDIC,X)=Y_"^1"
I $D(%),$L(%) S X=%,K=0 D UP Q:'$L(X) S X=X_U D:$D(^TMP("XQO",$J,XQDIC,X))!$D(^(X_"1")) PMO3 S:L&'K ^TMP("XQO",$J,XQDIC,X)=Y_"^0"
S (XQA,XQK,XQP,XQE,XQF)="" F D="XQA","XQK","XQP","XQE","XQF" F I=1:1:L I $D(@(D_"(I)")) S @D=@D_@(D_"(I)")_","
I '$D(^TMP("XQO",$J,XQDIC,"^",Y)) S ^(Y)=U_$P(Y(0),U,1,2)_U_$S(($P(Y(0),U,3)]""):1,1:"")_U_$P(Y(0),U,4)_U_XQA_U_XQK_U_$P(Y(0),U,7,8)_U_XQP_U_XQE_U_$P(Y(0),U,11,15)_U_XQF_U_$P(Y(0),U,17,99) Q
S %=$S('$D(^TMP("XQO",$J,XQDIC,"^",Y,0)):1,1:^(0)+1),^(0)=%,^(0,%)=XQA_U_XQK_U_XQP_U_XQE_U_XQF
Q
PMO3 ;
S D=X,K=$S($D(^TMP("XQO",$J,XQDIC,X)):(Y=+^(X)),1:0) F S V=$O(^TMP("XQO",$J,XQDIC,D)) Q:K!($P(V,U,1)'=$P(X,U,1)) S D=V S:Y=+^(V) K=1
I 'K S I=$P(D,U,2) S:'$L(I) I=0 I I=0 S ^(X_"1")=^TMP("XQO",$J,XQDIC,X) K ^(X) S I=1
I 'K S X=X_(I+1)
Q
;
;
SEC S XQL="P"_XQBLD Q:$D(^TMP("XQO",$J,XQL)) D RD3 Q
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
D:$E(XQL)'="P" RD3
Q
;
RD3 ;Called by SEC and SEC+2
S XQDIC="P"_XQBLD
D PM2
Q
;
SET G:'$D(^VA(200,XQI,201)) SET1 S XQK=+^(201) Q:'$L(XQK)
S XQR="" S:$D(^VA(200,XQI,1.1)) XQR=$P(^(1.1),".",1) S XQP=1_U_XQR
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))
I $D(^DIC(19,XQK,0)),$P(^(0),U,4)="M" S ^TMP($J,XQK)=XQP
SET1 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)) S ^TMP($J,"SEC",XQL)=""
Q
;
;
EN ;Entry point
S U="^",UU="^^"
N XQDIC,XQDT,XQI,XQH,XQSAV,XQSEC
S:'$D(XQDT) XQDT=$H
K ZTREQ
S ^TMP("XQO",$J,"P0")="",XQSEC=1
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)=""
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)=""
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)) Q
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)
;
;Find the various trees and put them into ^TMP($J), and count them
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
;
S (XQNT,%)=0 F S %=$O(^TMP($J,%)) Q:%="" S XQNT=XQNT+1
S %=0 F S %=$O(^TMP($J,"SEC",%)) Q:%="" S XQNT=XQNT+1
;
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 RD3
S XQSEC=0
S X="" F XQBLD=0:0 S XQBLD=$O(^TMP($J,"SEC",XQBLD)) Q:XQBLD'>0 D SEC
K ^TMP("XQO",$J,"P0") S XQK="P" F XQBLD=0:0 S XQK=$O(^TMP("XQO",$J,XQK)) Q:XQK'["P" S ^(XQK,0)=XQH
;
BLDEND ;We are all done, let's clean up and quit.
;
K %,%H,%TG,D,DIC,DIR,I,J,K,L,V,X,Y,Z,UU
K XQBLD,XQDT,XQH,XQI,XQJ,XQK,XQL,XQN,XQNT,XQP,XQR,XQSAV,XQSEC,XQXUF
;
D MERGE
;
K ^TMP($J),^TMP("XQO",$J)
K D,I,W,X,XQK,XQREALT,XQXUF,Y,Z
Q
;
MERGE ;Merge ^TMP("XQO",$J) into ^DIC(19,"AXQ")
N X S X="P"
F S X=$O(^TMP("XQO",$J,X)) Q:X="" D
.L +^DIC(19,"AXQ",X):5
.K ^DIC(19,"AXQ",X)
.M ^DIC(19,"AXQ",X)=^TMP("XQO",$J,X)
.L -^DIC(19,"AXQ",X)
.K ^TMP("XQO",$J,X)
.Q
Q
;
ERR ;Come here on error
N XQERROR
S XQERROR=$$EC^%ZOSV
D ^%ZTER
D EXIT^XPDID()
G UNWIND^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ88 5861 printed Apr 09, 2024@21:07:10 Page 2
XQ88 ;SF/GFT,RWF,AMF,JLI,LUKE - Build menu trees ;04/18/2002 11:08
+1 ;;8.0;KERNEL;**156**;Jul 10, 1995
+2 ;Taken from XQ8 and XQ81 to make a stripped down menu rebuild
+3 ;
TIME ;See if there are prohibited times for this option
+1 SET %XQI=$PIECE(^DIC(19,Y,0),U,9)
IF $LENGTH(%XQI)>2
SET XQP(L)=%XQI_"MO-FR"
+2 IF $DATA(^DIC(19,Y,3.91))
SET %XQI=0
FOR
SET %XQI=$ORDER(^DIC(19,Y,3.91,%XQI))
if %XQI'>0
QUIT
SET XQP(L)=$SELECT($DATA(XQP(L)):XQP(L)_";",1:"")_$PIECE(^(%XQI,0),U,1)_$PIECE(^(0),U,2)
+3 KILL %XQI
IF '$DATA(XQP(L))
IF $LENGTH($PIECE(Y(0),U,9))
SET XQP(L)=$PIECE(Y(0),U,9)
+4 QUIT
+5 ;
UP ;F Z=1:1 Q:X?.NUP S W=$A(X,Z) I W<123,W>96 S X=$E(X,1,Z-1)_$C(W-32)_$E(X,Z+1,255)
SET X=$$UP^XLFSTR(X)
+1 QUIT
+2 ;
PM2 ;Enter here to rebuild a single menu Called by RD3+10
+1 KILL ^TMP("XQO",$JOB,XQDIC)
SET ^XUTL("XQO",XQDIC,"^BUILD")=$PIECE($HOROLOG,",",2)
+2 ;
+3 IF XQDIC'="PXU"
SET Y=+$PIECE(XQDIC,"P",2)
if Y'>0
QUIT
if '$DATA(^DIC(19,Y,0))
QUIT
+4 IF '$DATA(XQXUF)
KILL ^TMP("XQO",$JOB,"PXU")
SET XQSAV=XQDIC
SET XQDIC="PXU"
SET Y=$ORDER(^DIC(19,"B","XUCOMMAND",0))
if Y>0
SET %=""
SET (L,X(0))=0
SET XQD=Y
if Y>0
DO TREE1
DO PMOK
SET XQDIC=XQSAV
SET XQXUF=1
SET ^TMP("XQO",$JOB,"PXU",0)=XQDT
+5 IF XQDIC=9!(XQDIC="P9")
+6 ;
+7 SET Y=$PIECE(XQDIC,"P",2)
if Y'>0!'$DATA(^DIC(19,+Y,0))
GOTO PMOKA
IF Y>0
IF $DATA(^DIC(19,Y,0))
IF $PIECE(^(0),U,4)="M"
DO PMOK
SET %=""
SET (L,X(0))=0
SET XQD=Y
DO TREE1
+8 if $DATA(^DIC(19,$EXTRACT(XQDIC,2,99),0))
SET ^(99.1)=XQDT
SET ^TMP("XQO",$JOB,XQDIC,0)=XQDT
+9 SET Y=+$PIECE(XQDIC,"P",2)
+10 IF Y>0
SET (XQD,%)=^DIC(19,Y,0)
SET L=1
SET XQP(L)=""
DO TIME
SET ^TMP("XQO",$JOB,XQDIC,U,Y)=U_$PIECE(%,U,1,2)_U_$SELECT(($PIECE(%,U,3)]""):1,1:"")_U_$PIECE(%,U,4)_UU_$PIECE(%,U,6,8)_U_XQP(L)_U_$PIECE(%,U,10,99)
+11 IF Y>0
IF '$DATA(^DIC(19,Y,"U"))
SET XQFL=0
if $DATA(X)#2
SET XQSAVE=X
SET XQFL=1
SET X=$EXTRACT($PIECE(^DIC(19,+Y,0),U,2),1,30)
DO UP
SET ^("U")=X
if XQFL
SET X=XQSAVE
+12 IF Y>0
SET ^TMP("XQO",$JOB,XQDIC,^DIC(19,Y,"U")_U)=Y_"^0"
PMOKA KILL ^XUTL("XQO",XQDIC,"^BUILD")
KILL ZTSK
PMOK KILL %,XQA,XQD,XQE,XQF,XQFL,XQP,XQR,XQSAVE
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;
TREE ;
+1 SET X(L)=$ORDER(^DIC(19,XQD,10,X(L)))
if X(L)'>0
QUIT
SET Y=^(X(L),0)
SET %=$PIECE(Y,U,2)
SET Y=+Y
if $DATA(XQR(Y))!'$DATA(^DIC(19,Y,0))
GOTO TREE
SET XQR(Y)=""
TREE1 SET Y(0)=^DIC(19,Y,0)
SET X=$SELECT($DATA(^("U")):^("U"),1:"")
IF X=""
SET X=$EXTRACT($PIECE(Y(0),U,2),1,30)
DO UP
SET ^("U")=X
+1 SET Y(1)=X
if '$LENGTH($PIECE(Y(0),U,5))
SET $PIECE(Y(0),U,5)=0
+2 if $LENGTH($PIECE(Y(0),U,3))
GOTO TREE
if $LENGTH($PIECE(Y(0),U,6))
SET XQK(L)=$PIECE(Y(0),U,6)
SET XQA(L)=Y
if $LENGTH($PIECE(Y(0),U,10))
SET XQE(L)=$PIECE(Y(0),U,10)
+3 if $PIECE(Y(0),U,16)
SET XQF(L)=$PIECE(^DIC(19,Y,3),U)
IF $DATA(XQF(L))
if XQF(L)=""
KILL XQF(L)
+4 DO TIME
DO PMOSET
SET L=L+1
SET X(L)=0
SET (XQD,XQD(L))=Y
DO TREE
+5 if L<2
QUIT
KILL XQR(XQD(L))
SET L=L-1
KILL XQA(L),XQK(L),XQP(L),XQE(L),XQF(L)
SET XQD=XQD(L)
GOTO TREE
+6 ;
PMOSET ;
+1 SET K=0
SET X=$EXTRACT(Y(1),1,27)
IF $LENGTH(X)
SET X=X_U
if $DATA(^TMP("XQO",$JOB,XQDIC,X))!$DATA(^(X_"1"))
DO PMO3
if L&'K
SET ^TMP("XQO",$JOB,XQDIC,X)=Y_"^1"
+2 IF $DATA(%)
IF $LENGTH(%)
SET X=%
SET K=0
DO UP
if '$LENGTH(X)
QUIT
SET X=X_U
if $DATA(^TMP("XQO",$JOB,XQDIC,X))!$DATA(^(X_"1"))
DO PMO3
if L&'K
SET ^TMP("XQO",$JOB,XQDIC,X)=Y_"^0"
+3 SET (XQA,XQK,XQP,XQE,XQF)=""
FOR D="XQA","XQK","XQP","XQE","XQF"
FOR I=1:1:L
IF $DATA(@(D_"(I)"))
SET @D=@D_@(D_"(I)")_","
+4 IF '$DATA(^TMP("XQO",$JOB,XQDIC,"^",Y))
SET ^(Y)=U_$PIECE(Y(0),U,1,2)_U_$SELECT(($PIECE(Y(0),U,3)]""):1,1:"")_U_$PIECE(Y(0),U,4)_U_XQA_U_XQK_U_$PIECE(Y(0),U,7,8)_U_XQP_U_XQE_U_$PIECE(Y(0),U,11,15)_U_XQF_U_$PIECE(Y(0),U,17,99)
QUIT
+5 SET %=$SELECT('$DATA(^TMP("XQO",$JOB,XQDIC,"^",Y,0)):1,1:^(0)+1)
SET ^(0)=%
SET ^(0,%)=XQA_U_XQK_U_XQP_U_XQE_U_XQF
+6 QUIT
PMO3 ;
+1 SET D=X
SET K=$SELECT($DATA(^TMP("XQO",$JOB,XQDIC,X)):(Y=+^(X)),1:0)
FOR
SET V=$ORDER(^TMP("XQO",$JOB,XQDIC,D))
if K!($PIECE(V,U,1)'=$PIECE(X,U,1))
QUIT
SET D=V
if Y=+^(V)
SET K=1
+2 IF 'K
SET I=$PIECE(D,U,2)
if '$LENGTH(I)
SET I=0
IF I=0
SET ^(X_"1")=^TMP("XQO",$JOB,XQDIC,X)
KILL ^(X)
SET I=1
+3 IF 'K
SET X=X_(I+1)
+4 QUIT
+5 ;
+6 ;
SEC SET XQL="P"_XQBLD
if $DATA(^TMP("XQO",$JOB,XQL))
QUIT
DO RD3
QUIT
+1 SET XQL="P"
FOR XQN=0:0
SET XQL=$ORDER(^TMP("XQO",$JOB,XQL))
if $EXTRACT(XQL)'="P"
QUIT
IF $DATA(^TMP("XQO",$JOB,XQL,"^",XQBLD))
QUIT
+2 if $EXTRACT(XQL)'="P"
DO RD3
+3 QUIT
+4 ;
RD3 ;Called by SEC and SEC+2
+1 SET XQDIC="P"_XQBLD
+2 DO PM2
+3 QUIT
+4 ;
SET if '$DATA(^VA(200,XQI,201))
GOTO SET1
SET XQK=+^(201)
if '$LENGTH(XQK)
QUIT
+1 SET XQR=""
if $DATA(^VA(200,XQI,1.1))
SET XQR=$PIECE(^(1.1),".",1)
SET XQP=1_U_XQR
+2 IF $DATA(^TMP($JOB,XQK))
SET XQP=^TMP($JOB,XQK)
SET XQP=XQP+1_U_$SELECT(XQR>$PIECE(XQP,U,2):XQR,1:$PIECE(XQP,U,2))
+3 IF $DATA(^DIC(19,XQK,0))
IF $PIECE(^(0),U,4)="M"
SET ^TMP($JOB,XQK)=XQP
SET1 FOR XQN=0:0
SET XQN=$ORDER(^VA(200,XQI,203,XQN))
if XQN'>0
QUIT
SET XQL=+^(XQN,0)
IF $DATA(^DIC(19,XQL,0))
SET ^TMP($JOB,"SEC",XQL)=""
+1 QUIT
+2 ;
+3 ;
EN ;Entry point
+1 SET U="^"
SET UU="^^"
+2 NEW XQDIC,XQDT,XQI,XQH,XQSAV,XQSEC
+3 if '$DATA(XQDT)
SET XQDT=$HOROLOG
+4 KILL ZTREQ
+5 SET ^TMP("XQO",$JOB,"P0")=""
SET XQSEC=1
+6 SET XQI=""
FOR XQK=0:0
SET XQI=$ORDER(^TMP("XQO",$JOB,XQI))
if XQI'=+XQI!(XQI="")
QUIT
IF $DATA(^TMP("XQO",$JOB,XQI,0))#2
SET $PIECE(^(0),U,2)=""
+7 SET XQI="U"
FOR XQK=0:0
SET XQI=$ORDER(^TMP("XQO",$JOB,XQI))
if "U"'[$EXTRACT(XQI)!(XQI="")
QUIT
IF $DATA(^TMP("XQO",$JOB,XQI,0))#2
SET $PIECE(^(0),U,2)=""
+8 SET XQI="P"
FOR XQK=0:0
SET XQI=$ORDER(^TMP("XQO",$JOB,XQI))
if "P"'[$EXTRACT(XQI)!(XQI="")
QUIT
IF $DATA(^TMP("XQO",$JOB,XQI,0))#2
IF $LENGTH(^(0))
QUIT
+9 SET XQI="P"
FOR XQK=0:0
SET XQI=$ORDER(^TMP("XQO",$JOB,XQI))
if "P"'[$EXTRACT(XQI)!(XQI="")
QUIT
IF "P"[$EXTRACT(XQI)
IF XQI'="P0"
KILL ^TMP("XQO",$JOB,XQI)
+10 ;
+11 ;Find the various trees and put them into ^TMP($J), and count them
+12 if '$DATA(XQH)
SET XQH=$HOROLOG
KILL ^TMP($JOB)
SET XQI=.5
FOR XQK=0:0
SET XQI=$ORDER(^VA(200,XQI))
if XQI'=+XQI
QUIT
IF $DATA(^VA(200,XQI,0))
IF $LENGTH($PIECE(^VA(200,XQI,0),U,3))
DO SET
+13 ;
+14 SET (XQNT,%)=0
FOR
SET %=$ORDER(^TMP($JOB,%))
if %=""
QUIT
SET XQNT=XQNT+1
+15 SET %=0
FOR
SET %=$ORDER(^TMP($JOB,"SEC",%))
if %=""
QUIT
SET XQNT=XQNT+1
+16 ;
+17 SET X=""
FOR XQBLD=0:0
SET XQBLD=$ORDER(^TMP($JOB,XQBLD))
if XQBLD'>0!(X=U)
QUIT
IF $DATA(^DIC(19,XQBLD,0))
SET XQJ=^DIC(19,XQBLD,0)
DO RD3
+18 SET XQSEC=0
+19 SET X=""
FOR XQBLD=0:0
SET XQBLD=$ORDER(^TMP($JOB,"SEC",XQBLD))
if XQBLD'>0
QUIT
DO SEC
+20 KILL ^TMP("XQO",$JOB,"P0")
SET XQK="P"
FOR XQBLD=0:0
SET XQK=$ORDER(^TMP("XQO",$JOB,XQK))
if XQK'["P"
QUIT
SET ^(XQK,0)=XQH
+21 ;
BLDEND ;We are all done, let's clean up and quit.
+1 ;
+2 KILL %,%H,%TG,D,DIC,DIR,I,J,K,L,V,X,Y,Z,UU
+3 KILL XQBLD,XQDT,XQH,XQI,XQJ,XQK,XQL,XQN,XQNT,XQP,XQR,XQSAV,XQSEC,XQXUF
+4 ;
+5 DO MERGE
+6 ;
+7 KILL ^TMP($JOB),^TMP("XQO",$JOB)
+8 KILL D,I,W,X,XQK,XQREALT,XQXUF,Y,Z
+9 QUIT
+10 ;
MERGE ;Merge ^TMP("XQO",$J) into ^DIC(19,"AXQ")
+1 NEW X
SET X="P"
+2 FOR
SET X=$ORDER(^TMP("XQO",$JOB,X))
if X=""
QUIT
Begin DoDot:1
+3 LOCK +^DIC(19,"AXQ",X):5
+4 KILL ^DIC(19,"AXQ",X)
+5 MERGE ^DIC(19,"AXQ",X)=^TMP("XQO",$JOB,X)
+6 LOCK -^DIC(19,"AXQ",X)
+7 KILL ^TMP("XQO",$JOB,X)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
ERR ;Come here on error
+1 NEW XQERROR
+2 SET XQERROR=$$EC^%ZOSV
+3 DO ^%ZTER
+4 DO EXIT^XPDID()
+5 GOTO UNWIND^%ZTER
+6 QUIT
