XQ81.m

XQ81 ;SEA/AMF/LUKE,SF/RWF,ISD/HGW - Build menu trees ;03/19/13  09:21

 ;;8.0;KERNEL;**81,116,157,253,478,614**;Jul 10, 1995;Build 12

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;

BUILD ;

 ;

RD2 N XQSTAT S XQSTAT=$$STATUS()

 I 'XQSTAT W !!,"Some one else is rebuilding menus.  Sorry." Q

 K ZTSK

 D MICRO ;Turn off micro surgery for now

 ;

 S XQSTART=$$HTE^XLFDT($H)

 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.",!

 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) BLDEND1 S XQVE=(Y=1)

 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) BLDEND1 S XQBSEC=(Y=1)

 ;

 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) BLDEND1 I Y=1 D

 .S ZTRTN="QUE^XQ81",ZTIO=""

 .S ZTSAVE("XQVE")="",ZTSAVE("XQBSEC")="",ZTSAVE("XQSTART")=""

 .S ZTDESC="Build menu trees in ^DIC(19,""AXQ"")"

 .D ^%ZTLOAD

 .I $D(ZTSK),'XQVE W !!,"Task #: ",ZTSK,!

 .Q

 ;

 I $D(ZTSK) K ^DIC(19,"AXQ","P0") S XQALLDON="" G BLDEND

 E  S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0"):DILOCKTM

 ;

 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) BLDEND1 G:Y'=1 RD2

 ;

KIDS ;Entry from KIDS

 I '$D(XQSTAT),$D(^DIC(19,"AXQ","P0")) S XQSTAT=$$STATUS I 'XQSTAT W !!,"  Some one else is building menus.  Sorry." K XQSTAT Q

 I '$D(^DIC(19,"AXQ","P0","STOP")) D MICRO

 I '$D(^DIC(19,"AXQ","P0")) S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0"):DILOCKTM

 I '$D(XQVE) S XQFG=0,XQBSEC=1,XQVE=0

 N XQNTREE,XQNDONE S (XQNTREE,XQNDONE)=0

 ;

 ;Set up the error trap so we can clear the screen if it blows

 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XQ81"

 E  S X="ERR^XQ81",@^%ZOSF("TRAP")

 ;

 ;Set up the bar graph and window if not from KIDS

 I '$D(XPDNM) D INIT^XPDID

 I XPDIDVT D

 .I $D(XPDIDTOT) S XQSAVTOT=XPDIDTOT

 .S X="Rebuilding Menus" D TITLE^XPDID(X)

 .S XPDIDTOT=50 ;Number of divisions in bar graph

 .D UPDATE^XPDID(0)

 .Q

 ;

 S XQSTART=$$HTE^XLFDT($H)

 W !!,"Starting Menu Rebuild:  ",XQSTART

 S XQFG=0 W !!,"Collecting primary menus in the New Person file..."

 ;

DQ ;Entry from taskman  Write if $D(XQFG)

 K ZTREQ

 I '$D(XQSTART) S XQSTART=$$HTE^XLFDT($H)

 N XQNOW,XQ8FLG,XQTASK

 S XQ8FLG=0

 S:'$D(XQNOW) XQNOW=$H

 S ^DIC(19,"AXQ","P0")=XQNOW

 S ^DIC(19,"AXQ","P0","STOP")=XQNOW ;Stop micro surgery if it's running

 ;

 S XQSEC=1,XQ81T="" I 'XQVE H 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)) S XQ81T=^(0) Q

 S:XQ81T="" XQ81T="Unknown"

 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 (XQNTREE,%)=0 F  S %=$O(^TMP($J,%)) Q:%=""  S XQNTREE=XQNTREE+1

 S %=0 F  S %=$O(^TMP($J,"SEC",%)) Q:%=""  S XQNTREE=XQNTREE+1

 ;

 W:$D(XQFG) !!?20,"Primary menus found in the New Person file",!?20,"------------------------------------------"

 W:$D(XQFG) !!,"OPTION NAME         MENU TEXT",?49,"# OF",?62,"LAST",?71,"LAST",!?49,"USERS",?62,"USED",?71,"BUILT",!

 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

 S XQSEC=0 I $D(XQFG),XQBSEC W !!,"Building secondary menu trees...."

 I XQBSEC S X="" F XQBLD=0:0 S XQBLD=$O(^TMP($J,"SEC",XQBLD)) Q:XQBLD'>0  D SEC

 I 'XQVE S XQK="P" F XQBLD=0:0 S XQK=$O(^TMP("XQO",$J,XQK)) Q:XQK'["P"  S ^(XQK,0)=XQH

 G BLDEND

 ;

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

 ;

VER I $D(XQFG) D

 .N XQMT,XQOPNM

 .S XQK=$P(^TMP($J,XQBLD),U,2)

 .S:$L(XQK) XQK=$E(XQK,4,5)_"/"_$E(XQK,6,7)_"/"_$E(XQK,2,3)

 .S XQOPNM=$P(XQJ,U)

 .S XQMT=$P(XQJ,U,2) I $L(XQMT)>28 S XQMT=$E(XQMT,1,25)_"..."

 .W !,$P(XQJ,U,1)

 .W:($L(XQOPNM)>20) !

 .W ?20,XQMT,?49,+^TMP($J,XQBLD),?60,XQK

 .Q

 ;

 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)

 ;

RD3 ;Update counter an rebuild it if necessary

 I $D(XQFG),XPDIDVT D

 .N %

 .S XQNDONE=XQNDONE+1

 .S %=(XQNDONE/XQNTREE)*XPDIDTOT

 .D UPDATE^XPDID(%)

 .Q

 ;

 S XQDIC="P"_XQBLD D CHK^XQ8 I XQRE W:$D(XQFG) !,"SOMEONE ELSE IS CURRENTLY REBUILDING THIS MENU" Q

 I XQVE,XQSEC S DIR(0)="Y",DIR("A")="Rebuild",DIR("B")="YES" D ^DIR Q:$D(DIRUT)  W ! Q:Y'=1

 S XQFG1=1 D PM2^XQ8

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

 ;

SET G:'$D(^VA(200,XQI,201)) SET1 S XQK=+^(201) Q:'$L(XQK)  ;I $D(XQFG) W:'(XQI#10) "."

 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 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)=""

 Q

 ;

QUE ;Entry point for the option XQBUILDTREEQUE, and XQBUILDALL

 ;Also called by CHEK^XQ83

 S XQVE=0,XQBSEC=1 K XQFG

 S XQSTART=$$HTE^XLFDT($H)

 G DQ

 ;

BLDEND ;File a report, cleanup, and quit.

 ;

 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

 ;

 I $D(XQALLDON) K XQALLDON Q  ;Quit here if we're just creating a task

 ;

 D MERGET

 D CLEAN

 D MERGEX

 ;

 K ^TMP($J),^TMP("XQO",$J)

 ;

 ;Clear the flags and locks.

 K ^XUTL("XQO","XQMERGED") ;Menus merged since last rebuild REACT^XQ84

 K ^DIC(19,"AT") ;Micro message nodes

 S ^XUTL("XQO","MICRO")=0 ;Number of Micro instances since last build

 K ^DIC(19,"AXQ","P0","STOP") ;Allow Micro surgery to start up

 K ^DIC(19,"AXQ","P0") ;Clear the rebuild flag (redundant, I know)

 L -^DIC(19,"AXQ","P0") ;Unlock the rebuild flag, everybody's good to go

 ;

 S %=$S($D(XPDNM):"KIDS",$D(ZTSK):"QUEUED",1:"LIVE")

 D REPORT^XQ84(%)

 K XQSTART,ZTSK

 ;

 I '$D(XPDIDVT) K XQFG Q

 ;

 I $D(XQFG),XPDIDVT F %=((XQNDONE/XQNTREE)*XPDIDTOT):1:XPDIDTOT D UPDATE^XPDID(%) H .25

 I $D(XQFG),XPDIDVT D UPDATE^XPDID(XPDIDTOT)

 I $D(XQFG) W !!,"Menu Rebuild Complete:  ",$$HTE^XLFDT($H)

 ;

 ;

 H 2

 ;If we're not from KIDS then clean it up, otherwise let kids do it.

 I '$D(XPDNM) D

 .D EXIT^XPDID()

 .K XPDIDVT,XPDIDTOT

 .Q

 ;

 I $D(XQSAVTOT) S XPDIDTOT=XQSAVTOT

 K %,VALMCOFF,VALMCON,VALMIOXY,VALMSGR,VALMWD,XQFG,XQNDONE,XQNTREE,XQSAVTOT

 Q

 ;

 ;================================Subroutines==========================

 ;

MERGET ;Merge ^TMP("XQO",$J) into ^DIC(19,"AXQ")

 N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""

 I $D(XQFG) W !!,"Merging...."

 F  S X=$O(^TMP("XQO",$J,X)) Q:X=""  D

 .L +^DIC(19,"AXQ",X):2 I '$T S XQFLAG=1 Q

 .S %X="^TMP(""XQO"","_$J_","_Q_X_Q_","

 .S %Y="^DIC(19,""AXQ"","_Q_X_Q_","

 .K ^DIC(19,"AXQ",X)

 .;M ^DIC(19,"AXQ",X)=^TMP("XQO",$J,X)

 .D %XY^%RCR

 .L -^DIC(19,"AXQ",X)

 .K %X,%Y

 .Q

 ;

 I XQFLAG,$D(XQFG) D

 .N %,Y

 .S Y=$P(X,"P",2) Q:Y=""

 .S %=$G(^DIC(19,Y,0)) Q:%=""

 .S Y=$P(%,"^",2) Q:%=""

 .W !,?12,"Could not merge menu: "_Y

 .Q

 Q

 ;

CLEAN ;Clean out unused menu trees from ^DIC(19,"AXQ")

 N X,Y S X="P"

 F  S X=$O(^DIC(19,"AXQ",X)) Q:X=""  D

 .I X'="PXU" D

 ..S Y=$E(X,2,99)

 ..I '$D(^TMP($J,Y))&('$D(^TMP($J,"SEC",Y))) K ^DIC(19,"AXQ",X),^XUTL("XQO",X)

 ..Q

 .Q

 Q

 ;

MERGEX ;Merge ^DIC(19,"AXQ") into ^XUTL("XQO")

 N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""

 F  S X=$O(^DIC(19,"AXQ",X)) Q:X=""  D

 .L +^XUTL("XQO",X):2 I '$T S XQFLAG=1 Q

 .S %X="^DIC(19,""AXQ"","_Q_X_Q_","

 .S %Y="^XUTL(""XQO"","_Q_X_Q_","

 .K ^XUTL("XQO",X)

 .;M ^XUTL("XQO",X)=^DIC(19,"AXQ",X)

 .D %XY^%RCR

 .L -^XUTL("XQO",X)

 .K %X,%Y

 .Q

 ;

 I XQFLAG,$D(XQFG) D

 .N %,Y

 .S Y=$P(X,"P",2) Q:Y=""

 .S %=$G(^DIC(19,Y,0)) Q:%=""

 .S Y=$P(%,"^",2) Q:%=""

 .W !,?12,"Could not merge menu: "_Y

 .Q

 ;

 I 'XQFLAG,$D(XQFG) W " done."

 Q

 ;

STATUS()  ;Are the menus being rebuilt even as we speak?

 N %,XQTHEN

 S %=$G(^DIC(19,"AXQ","P0")) I %="" Q 1  ;It finished.  Never mind.

 L +^DIC(19,"AXQ","P0"):0 ;If job is still running we can't lock it

 I $T L -^DIC(19,"AXQ","P0") K ^("P0") Q 1  ;Job must have failed

 Q 0

 ;

 ;

MICRO ;Turn off micro surgery

 I $D(^DIC(19,"AXQ","P0","MICRO")) D

 .S ^DIC(19,"AXQ","P0","STOP")=$H ;Turn off micro-surgery

 .K ^DIC(19,"AXQ","P0","MICRO")

 .H 2

 .Q

 Q

 ;

 ;

ERR ;Come here on error

 N XQERROR

 S XQERROR=$$EC^%ZOSV

 D ^%ZTER

 D EXIT^XPDID()

 G UNWIND^%ZTER

 Q

 ;

BLDEND1 ;Quit and clean

 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

 Q

XQ81      ;SEA/AMF/LUKE,SF/RWF,ISD/HGW - Build menu trees ;03/19/13  09:21

 +1       ;;8.0;KERNEL;**81,116,157,253,478,614**;Jul 10, 1995;Build 12

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

BUILD     ;

 +1       ;

RD2        NEW XQSTAT

           SET XQSTAT=$$STATUS()

 +1        IF 'XQSTAT

               WRITE !!,"Some one else is rebuilding menus.  Sorry."

               QUIT 

 +2        KILL ZTSK

 +3       ;Turn off micro surgery for now

           DO MICRO

 +4       ;

 +5        SET XQSTART=$$HTE^XLFDT($HOROLOG)

 +6        KILL XQFG

           WRITE !!,"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.",!

 +7        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to verify each primary menu"

           SET DIR("B")="NO"

           SET DIR("??")="XQBUILDTREE-VER"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO BLDEND1

           SET XQVE=(Y=1)

 +8        SET DIR(0)="Y"

           SET DIR("A")="Would you like to build secondary menu trees too"

           SET DIR("B")="YES"

           SET DIR("??")="XQBUILDTREE-SEC"

           DO ^DIR

           IF $DATA(DIRUT)

               GOTO BLDEND1

           SET XQBSEC=(Y=1)

 +9       ;

 +10       IF 'XQVE

               SET DIR(0)="Y"

               SET DIR("A")="Would you like to queue this job"

               SET DIR("B")="YES"

               DO ^DIR

               KILL DIR

               IF $DATA(DIRUT)

                   GOTO BLDEND1

               IF Y=1

                   Begin DoDot:1

 +11                   SET ZTRTN="QUE^XQ81"

                       SET ZTIO=""

 +12                   SET ZTSAVE("XQVE")=""

                       SET ZTSAVE("XQBSEC")=""

                       SET ZTSAVE("XQSTART")=""

 +13                   SET ZTDESC="Build menu trees in ^DIC(19,""AXQ"")"

 +14                   DO ^%ZTLOAD

 +15                   IF $DATA(ZTSK)

                           IF 'XQVE

                               WRITE !!,"Task #: ",ZTSK,!

 +16                   QUIT 

                   End DoDot:1

 +17      ;

 +18       IF $DATA(ZTSK)

               KILL ^DIC(19,"AXQ","P0")

               SET XQALLDON=""

               GOTO BLDEND

 +19      IF '$TEST

               SET ^DIC(19,"AXQ","P0")=$HOROLOG

               LOCK +^DIC(19,"AXQ","P0"):DILOCKTM

 +20      ;

 +21       IF 'XQVE

               SET DIR(0)="Y"

               SET DIR("A")="Do you really wish to run this DIRECTLY (it may take some time)"

               SET DIR("B")="NO"

               DO ^DIR

               KILL DIR

               IF $DATA(DIRUT)

                   GOTO BLDEND1

               IF Y'=1

                   GOTO RD2

 +22      ;

KIDS      ;Entry from KIDS

 +1        IF '$DATA(XQSTAT)

               IF $DATA(^DIC(19,"AXQ","P0"))

                   SET XQSTAT=$$STATUS

                   IF 'XQSTAT

                       WRITE !!,"  Some one else is building menus.  Sorry."

                       KILL XQSTAT

                       QUIT 

 +2        IF '$DATA(^DIC(19,"AXQ","P0","STOP"))

               DO MICRO

 +3        IF '$DATA(^DIC(19,"AXQ","P0"))

               SET ^DIC(19,"AXQ","P0")=$HOROLOG

               LOCK +^DIC(19,"AXQ","P0"):DILOCKTM

 +4        IF '$DATA(XQVE)

               SET XQFG=0

               SET XQBSEC=1

               SET XQVE=0

 +5        NEW XQNTREE,XQNDONE

           SET (XQNTREE,XQNDONE)=0

 +6       ;

 +7       ;Set up the error trap so we can clear the screen if it blows

 +8        IF $$NEWERR^%ZTER

               NEW $ETRAP,$ESTACK

               SET $ETRAP="D ERR^XQ81"

 +9       IF '$TEST

               SET X="ERR^XQ81"

               SET @^%ZOSF("TRAP")

 +10      ;

 +11      ;Set up the bar graph and window if not from KIDS

 +12       IF '$DATA(XPDNM)

               DO INIT^XPDID

 +13       IF XPDIDVT

               Begin DoDot:1

 +14               IF $DATA(XPDIDTOT)

                       SET XQSAVTOT=XPDIDTOT

 +15               SET X="Rebuilding Menus"

                   DO TITLE^XPDID(X)

 +16      ;Number of divisions in bar graph

                   SET XPDIDTOT=50

 +17               DO UPDATE^XPDID(0)

 +18               QUIT 

               End DoDot:1

 +19      ;

 +20       SET XQSTART=$$HTE^XLFDT($HOROLOG)

 +21       WRITE !!,"Starting Menu Rebuild:  ",XQSTART

 +22       SET XQFG=0

           WRITE !!,"Collecting primary menus in the New Person file..."

 +23      ;

DQ        ;Entry from taskman  Write if $D(XQFG)

 +1        KILL ZTREQ

 +2        IF '$DATA(XQSTART)

               SET XQSTART=$$HTE^XLFDT($HOROLOG)

 +3        NEW XQNOW,XQ8FLG,XQTASK

 +4        SET XQ8FLG=0

 +5        IF '$DATA(XQNOW)

               SET XQNOW=$HOROLOG

 +6        SET ^DIC(19,"AXQ","P0")=XQNOW

 +7       ;Stop micro surgery if it's running

           SET ^DIC(19,"AXQ","P0","STOP")=XQNOW

 +8       ;

 +9        SET XQSEC=1

           SET XQ81T=""

           IF 'XQVE

               HANG 1

 +10       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)=""

 +11       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)=""

 +12       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))

                       SET XQ81T=^(0)

                       QUIT 

 +13       IF XQ81T=""

               SET XQ81T="Unknown"

 +14       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)

 +15      ;

 +16      ;Find the various trees and put them into ^TMP($J), and count them

 +17       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

 +18      ;

 +19       SET (XQNTREE,%)=0

           FOR 

               SET %=$ORDER(^TMP($JOB,%))

               IF %=""

                   QUIT 

               SET XQNTREE=XQNTREE+1

 +20       SET %=0

           FOR 

               SET %=$ORDER(^TMP($JOB,"SEC",%))

               IF %=""

                   QUIT 

               SET XQNTREE=XQNTREE+1

 +21      ;

 +22       IF $DATA(XQFG)

               WRITE !!?20,"Primary menus found in the New Person file",!?20,"------------------------------------------"

 +23       IF $DATA(XQFG)

               WRITE !!,"OPTION NAME         MENU TEXT",?49,"# OF",?62,"LAST",?71,"LAST",!?49,"USERS",?62,"USED",?71,"BUILT",!

 +24       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 VER

 +25       SET XQSEC=0

           IF $DATA(XQFG)

               IF XQBSEC

                   WRITE !!,"Building secondary menu trees...."

 +26       IF XQBSEC

               SET X=""

               FOR XQBLD=0:0

                   SET XQBLD=$ORDER(^TMP($JOB,"SEC",XQBLD))

                   IF XQBLD'>0

                       QUIT 

                   DO SEC

 +27       IF 'XQVE

               SET XQK="P"

               FOR XQBLD=0:0

                   SET XQK=$ORDER(^TMP("XQO",$JOB,XQK))

                   IF XQK'["P"

                       QUIT 

                   SET ^(XQK,0)=XQH

 +28       GOTO BLDEND

 +29      ;

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       ;

VER        IF $DATA(XQFG)

               Begin DoDot:1

 +1                NEW XQMT,XQOPNM

 +2                SET XQK=$PIECE(^TMP($JOB,XQBLD),U,2)

 +3                IF $LENGTH(XQK)

                       SET XQK=$EXTRACT(XQK,4,5)_"/"_$EXTRACT(XQK,6,7)_"/"_$EXTRACT(XQK,2,3)

 +4                SET XQOPNM=$PIECE(XQJ,U)

 +5                SET XQMT=$PIECE(XQJ,U,2)

                   IF $LENGTH(XQMT)>28

                       SET XQMT=$EXTRACT(XQMT,1,25)_"..."

 +6                WRITE !,$PIECE(XQJ,U,1)

 +7                IF ($LENGTH(XQOPNM)>20)

                       WRITE !

 +8                WRITE ?20,XQMT,?49,+^TMP($JOB,XQBLD),?60,XQK

 +9                QUIT 

               End DoDot:1

 +10      ;

 +11       IF $DATA(XQFG)

               IF $DATA(^DIC(19,"AXQ","P"_XQBLD,0))

                   SET XQ81T=+^(0)

               IF $LENGTH(XQ81T)

                   SET %H=XQ81T

                   DO YMD^%DTC

                   SET XQK=X

                   WRITE ?71,$EXTRACT(XQK,4,5),"/",$EXTRACT(XQK,6,7),"/",$EXTRACT(XQK,2,3)

 +12      ;

RD3       ;Update counter an rebuild it if necessary

 +1        IF $DATA(XQFG)

               IF XPDIDVT

                   Begin DoDot:1

 +2                    NEW %

 +3                    SET XQNDONE=XQNDONE+1

 +4                    SET %=(XQNDONE/XQNTREE)*XPDIDTOT

 +5                    DO UPDATE^XPDID(%)

 +6                    QUIT 

                   End DoDot:1

 +7       ;

 +8        SET XQDIC="P"_XQBLD

           DO CHK^XQ8

           IF XQRE

               IF $DATA(XQFG)

                   WRITE !,"SOMEONE ELSE IS CURRENTLY REBUILDING THIS MENU"

               QUIT 

 +9        IF XQVE

               IF XQSEC

                   SET DIR(0)="Y"

                   SET DIR("A")="Rebuild"

                   SET DIR("B")="YES"

                   DO ^DIR

                   IF $DATA(DIRUT)

                       QUIT 

                   WRITE !

                   IF Y'=1

                       QUIT 

 +10       SET XQFG1=1

           DO PM2^XQ8

 +11       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +12       QUIT 

 +13      ;

SET       ;I $D(XQFG) W:'(XQI#10) "."

           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

 +4       ;

SET1       IF XQBSEC

               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))

                       IF $PIECE(^(0),U,4)="M"

                           SET ^TMP($JOB,"SEC",XQL)=""

 +1        QUIT 

 +2       ;

QUE       ;Entry point for the option XQBUILDTREEQUE, and XQBUILDALL

 +1       ;Also called by CHEK^XQ83

 +2        SET XQVE=0

           SET XQBSEC=1

           KILL XQFG

 +3        SET XQSTART=$$HTE^XLFDT($HOROLOG)

 +4        GOTO DQ

 +5       ;

BLDEND    ;File a report, cleanup, and quit.

 +1       ;

 +2        KILL %,%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

 +3       ;

 +4       ;Quit here if we're just creating a task

           IF $DATA(XQALLDON)

               KILL XQALLDON

               QUIT 

 +5       ;

 +6        DO MERGET

 +7        DO CLEAN

 +8        DO MERGEX

 +9       ;

 +10       KILL ^TMP($JOB),^TMP("XQO",$JOB)

 +11      ;

 +12      ;Clear the flags and locks.