Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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/XQ81.m

    r613 r623  
    1 XQ81    ;SEA/AMF/LUKE,SF/RWF - Build menu trees ;12/10/07
    2         ;;8.0;KERNEL;**81,116,157,253,478**;Jul 10, 1995;Build 3
    3 BUILD   ;
    4         ;
    5 RD2     N XQSTAT S XQSTAT=$$STATUS()
    6         I 'XQSTAT W !!,"Some one else is rebuilding menus.  Sorry." Q
    7         K ZTSK
    8         D MICRO ;Turn off micro surgery for now
    9         ;
    10         S XQSTART=$$HTE^XLFDT($H)
    11         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.",!
    12         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)
    13         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)
    14         ;
    15         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
    16         .S ZTRTN="QUE^XQ81",ZTIO=""
    17         .S ZTSAVE("XQVE")="",ZTSAVE("XQBSEC")="",ZTSAVE("XQSTART")=""
    18         .S ZTDESC="Build menu trees in ^DIC(19,""AXQ"")"
    19         .D ^%ZTLOAD
    20         .I $D(ZTSK),'XQVE W !!,"Task #: ",ZTSK,!
    21         .Q
    22         ;
    23         I $D(ZTSK) K ^DIC(19,"AXQ","P0") S XQALLDON="" G BLDEND
    24         E  S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0")
    25         ;
    26         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
    27         ;
    28 KIDS    ;Entry from KIDS
    29         I '$D(XQSTAT),$D(^DIC(19,"AXQ","P0")) S XQSTAT=$$STATUS I 'XQSTAT W !!,"  Some one else is building menus.  Sorry." K XQSTAT Q
    30         I '$D(^DIC(19,"AXQ","P0","STOP")) D MICRO
    31         I '$D(^DIC(19,"AXQ","P0")) S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0")
    32         I '$D(XQVE) S XQFG=0,XQBSEC=1,XQVE=0
    33         N XQNTREE,XQNDONE S (XQNTREE,XQNDONE)=0
    34         ;
    35         ;Set up the error trap so we can clear the screen if it blows
    36         I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XQ81"
    37         E  S X="ERR^XQ81",@^%ZOSF("TRAP")
    38         ;
    39         ;Set up the bar graph and window if not from KIDS
    40         I '$D(XPDNM) D INIT^XPDID
    41         I XPDIDVT D
    42         .I $D(XPDIDTOT) S XQSAVTOT=XPDIDTOT
    43         .S X="Rebuilding Menus" D TITLE^XPDID(X)
    44         .S XPDIDTOT=50 ;Number of divisions in bar graph
    45         .D UPDATE^XPDID(0)
    46         .Q
    47         ;
    48         S XQSTART=$$HTE^XLFDT($H)
    49         W !!,"Starting Menu Rebuild:  ",XQSTART
    50         S XQFG=0 W !!,"Collecting primary menus in the New Person file..."
    51         ;
    52 DQ      ;Entry from taskman  Write if $D(XQFG)
    53         K ZTREQ
    54         I '$D(XQSTART) S XQSTART=$$HTE^XLFDT($H)
    55         N XQNOW,XQ8FLG,XQTASK
    56         S XQ8FLG=0
    57         S:'$D(XQNOW) XQNOW=$H
    58         S ^DIC(19,"AXQ","P0")=XQNOW
    59         S ^DIC(19,"AXQ","P0","STOP")=XQNOW ;Stop micro surgery if it's running
    60         ;
    61         S XQSEC=1,XQ81T="" I 'XQVE H 1
    62         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)=""
    63         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)=""
    64         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
    65         S:XQ81T="" XQ81T="Unknown"
    66         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)
    67         ;
    68         ;Find the various trees and put them into ^TMP($J), and count them
    69         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
    70         ;
    71         S (XQNTREE,%)=0 F  S %=$O(^TMP($J,%)) Q:%=""  S XQNTREE=XQNTREE+1
    72         S %=0 F  S %=$O(^TMP($J,"SEC",%)) Q:%=""  S XQNTREE=XQNTREE+1
    73         ;
    74         W:$D(XQFG) !!?20,"Primary menus found in the New Person file",!?20,"------------------------------------------"
    75         W:$D(XQFG) !!,"OPTION NAME         MENU TEXT",?49,"# OF",?62,"LAST",?71,"LAST",!?49,"USERS",?62,"USED",?71,"BUILT",!
    76         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
    77         S XQSEC=0 I $D(XQFG),XQBSEC W !!,"Building secondary menu trees...."
    78         I XQBSEC S X="" F XQBLD=0:0 S XQBLD=$O(^TMP($J,"SEC",XQBLD)) Q:XQBLD'>0  D SEC
    79         I 'XQVE S XQK="P" F XQBLD=0:0 S XQK=$O(^TMP("XQO",$J,XQK)) Q:XQK'["P"  S ^(XQK,0)=XQH
    80         G BLDEND
    81         ;
    82 SEC     S XQL="P"_XQBLD Q:$D(^TMP("XQO",$J,XQL))  D RD3 Q
    83         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
    84         D:$E(XQL)'="P" RD3
    85         Q
    86         ;
    87 VER     I $D(XQFG) D
    88         .N XQMT,XQOPNM
    89         .S XQK=$P(^TMP($J,XQBLD),U,2)
    90         .S:$L(XQK) XQK=$E(XQK,4,5)_"/"_$E(XQK,6,7)_"/"_$E(XQK,2,3)
    91         .S XQOPNM=$P(XQJ,U)
    92         .S XQMT=$P(XQJ,U,2) I $L(XQMT)>28 S XQMT=$E(XQMT,1,25)_"..."
    93         .W !,$P(XQJ,U,1)
    94         .W:($L(XQOPNM)>20) !
    95         .W ?20,XQMT,?49,+^TMP($J,XQBLD),?60,XQK
    96         .Q
    97         ;
    98         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)
    99         ;
    100 RD3     ;Update counter an rebuild it if necessary
    101         I $D(XQFG),XPDIDVT D
    102         .N %
    103         .S XQNDONE=XQNDONE+1
    104         .S %=(XQNDONE/XQNTREE)*XPDIDTOT
    105         .D UPDATE^XPDID(%)
    106         .Q
    107         ;
    108         S XQDIC="P"_XQBLD D CHK^XQ8 I XQRE W:$D(XQFG) !,"SOMEONE ELSE IS CURRENTLY REBUILDING THIS MENU" Q
    109         I XQVE,XQSEC S DIR(0)="Y",DIR("A")="Rebuild",DIR("B")="YES" D ^DIR Q:$D(DIRUT)  W ! Q:Y'=1
    110         S XQFG1=1 D PM2^XQ8
    111         I $D(ZTQUEUED) S ZTREQ="@"
    112         Q
    113         ;
    114 SET     G:'$D(^VA(200,XQI,201)) SET1 S XQK=+^(201) Q:'$L(XQK)  ;I $D(XQFG) W:'(XQI#10) "."
    115         S XQR="" S:$D(^VA(200,XQI,1.1)) XQR=$P(^(1.1),".",1) S XQP=1_U_XQR
    116         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))
    117         I $D(^DIC(19,XQK,0)),$P(^(0),U,4)="M" S ^TMP($J,XQK)=XQP
    118         ;
    119 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)=""
    120         Q
    121         ;
    122 QUE     ;Entry point for the option XQBUILDTREEQUE, and XQBUILDALL
    123         ;Also called by CHEK^XQ83
    124         S XQVE=0,XQBSEC=1 K XQFG
    125         S XQSTART=$$HTE^XLFDT($H)
    126         G DQ
    127         ;
    128 BLDEND  ;File a report, cleanup, and quit.
    129         ;
    130         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
    131         ;
    132         I $D(XQALLDON) K XQALLDON Q  ;Quit here if we're just creating a task
    133         ;
    134         D MERGET
    135         D CLEAN
    136         D MERGEX
    137         ;
    138         K ^TMP($J),^TMP("XQO",$J)
    139         ;
    140         ;Clear the flags and locks.
    141         K ^XUTL("XQMERGED") ;Menues merged since last rebuild REACT^XQ84
    142         K ^DIC(19,"AT") ;Micro message nodes
    143         S ^XUTL("XQ","MICRO")=0 ;Number of Micro instances since last build
    144         K ^DIC(19,"AXQ","P0","STOP") ;Allow Micro surgery to start up
    145         K ^DIC(19,"AXQ","P0") ;Clear the rebuild flag (redundant, I know)
    146         L -^DIC(19,"AXQ","P0") ;Unlock the rebuild flag, everybody's good to go
    147         ;
    148         S %=$S($D(XPDNM):"KIDS",$D(ZTSK):"QUEUED",1:"LIVE")
    149         D REPORT^XQ84(%)
    150         K XQSTART,ZTSK
    151         ;
    152         I '$D(XPDIDVT) K XQFG Q
    153         ;
    154         I $D(XQFG),XPDIDVT F %=((XQNDONE/XQNTREE)*XPDIDTOT):1:XPDIDTOT D UPDATE^XPDID(%) H .25
    155         I $D(XQFG),XPDIDVT D UPDATE^XPDID(XPDIDTOT)
    156         I $D(XQFG) W !!,"Menu Rebuild Complete:  ",$$HTE^XLFDT($H)
    157         ;
    158         ;
    159         H 2
    160         ;If we're not from KIDS then clean it up, otherwise let kids do it.
    161         I '$D(XPDNM) D
    162         .D EXIT^XPDID()
    163         .K XPDIDVT,XPDIDTOT
    164         .Q
    165         ;
    166         I $D(XQSAVTOT) S XPDIDTOT=XQSAVTOT
    167         K %,VALMCOFF,VALMCON,VALMIOXY,VALMSGR,VALMWD,XQFG,XQNDONE,XQNTREE,XQSAVTOT
    168         Q
    169         ;
    170         ;================================Subroutines==========================
    171         ;
    172 MERGET  ;Merge ^TMP("XQO",$J) into ^DIC(19,"AXQ")
    173         N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""
    174         I $D(XQFG) W !!,"Merging...."
    175         F  S X=$O(^TMP("XQO",$J,X)) Q:X=""  D
    176         .L +^DIC(19,"AXQ",X):2 I '$T S XQFLAG=1 Q
    177         .S %X="^TMP(""XQO"","_$J_","_Q_X_Q_","
    178         .S %Y="^DIC(19,""AXQ"","_Q_X_Q_","
    179         .K ^DIC(19,"AXQ",X)
    180         .;M ^DIC(19,"AXQ",X)=^TMP("XQO",$J,X)
    181         .D %XY^%RCR
    182         .L -^DIC(19,"AXQ",X)
    183         .K %X,%Y
    184         .Q
    185         ;
    186         I XQFLAG,$D(XQFG) D
    187         .N %,Y
    188         .S Y=$P(X,"P",2) Q:Y=""
    189         .S %=$G(^DIC(19,Y,0)) Q:%=""
    190         .S Y=$P(%,"^",2) Q:%=""
    191         .W !,?12,"Could not merge menu: "_Y
    192         .Q
    193         Q
    194         ;
    195 CLEAN   ;Clean out unused menu trees from ^DIC(19,"AXQ")
    196         N X,Y S X="P"
    197         F  S X=$O(^DIC(19,"AXQ",X)) Q:X=""  D
    198         .I X'="PXU" D
    199         ..S Y=$E(X,2,99)
    200         ..I '$D(^TMP($J,Y))&('$D(^TMP($J,"SEC",Y))) K ^DIC(19,"AXQ",X),^XUTL("XQO",X)
    201         ..Q
    202         .Q
    203         Q
    204         ;
    205 MERGEX  ;Merge ^DIC(19,"AXQ") into ^XUTL("XQO")
    206         N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""
    207         F  S X=$O(^DIC(19,"AXQ",X)) Q:X=""  D
    208         .L +^XUTL("XQO",X):2 I '$T S XQFLAG=1 Q
    209         .S %X="^DIC(19,""AXQ"","_Q_X_Q_","
    210         .S %Y="^XUTL(""XQO"","_Q_X_Q_","
    211         .K ^XUTL("XQO",X)
    212         .;M ^XUTL("XQO",X)=^DIC(19,"AXQ",X)
    213         .D %XY^%RCR
    214         .L -^XUTL("XQO",X)
    215         .K %X,%Y
    216         .Q
    217         ;
    218         I XQFLAG,$D(XQFG) D
    219         .N %,Y
    220         .S Y=$P(X,"P",2) Q:Y=""
    221         .S %=$G(^DIC(19,Y,0)) Q:%=""
    222         .S Y=$P(%,"^",2) Q:%=""
    223         .W !,?12,"Could not merge menu: "_Y
    224         .Q
    225         ;
    226         I 'XQFLAG,$D(XQFG) W " done."
    227         Q
    228         ;
    229 STATUS()         ;Are the menus being rebuilt even as we speak?
    230         N %,XQTHEN
    231         S %=$G(^DIC(19,"AXQ","P0")) I %="" Q 1  ;It finished.  Never mind.
    232         L +^DIC(19,"AXQ","P0"):0 ;If job is still running we can't lock it
    233         I $T L -^DIC(19,"AXQ","P0") K ^("P0") Q 1  ;Job must have failed
    234         Q 0
    235         ;
    236         ;
    237 MICRO   ;Turn off micro surgery
    238         I $D(^DIC(19,"AXQ","P0","MICRO")) D
    239         .S ^DIC(19,"AXQ","P0","STOP")=$H ;Turn off micro-surgery
    240         .K ^DIC(19,"AXQ","P0","MICRO")
    241         .H 2
    242         .Q
    243         Q
    244         ;
    245         ;
    246 ERR     ;Come here on error
    247         N XQERROR
    248         S XQERROR=$$EC^%ZOSV
    249         D ^%ZTER
    250         D EXIT^XPDID()
    251         G UNWIND^%ZTER
    252         Q
    253         ;
    254 BLDEND1 ;Quit and clean
    255         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
    256         Q
     1XQ81 ;SEA/AMF/LUKE,SF/RWF - Build menu trees ;03/03/2003  10:00
     2 ;;8.0;KERNEL;**81,116,157,253**;Jul 10, 1995
     3BUILD ;
     4 ;
     5RD2 N XQSTAT S XQSTAT=$$STATUS()
     6 I 'XQSTAT W !!,"Some one else is rebuilding menus.  Sorry." Q
     7 K ZTSK
     8 D MICRO ;Turn off micro surgery for now
     9 ;
     10 S XQSTART=$$HTE^XLFDT($H)
     11 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.",!
     12 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) BLDEND S XQVE=(Y=1)
     13 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) BLDEND S XQBSEC=(Y=1)
     14 ;
     15 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) BLDEND I Y=1 D
     16 .S ZTRTN="QUE^XQ81",ZTIO=""
     17 .S ZTSAVE("XQVE")="",ZTSAVE("XQBSEC")="",ZTSAVE("XQSTART")=""
     18 .S ZTDESC="Build menu trees in ^DIC(19,""AXQ"")"
     19 .D ^%ZTLOAD
     20 .I $D(ZTSK),'XQVE W !!,"Task #: ",ZTSK,!
     21 .Q
     22 ;
     23 I $D(ZTSK) K ^DIC(19,"AXQ","P0") S XQALLDON="" G BLDEND
     24 E  S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0")
     25 ;
     26 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) BLDEND G:Y'=1 RD2
     27 ;
     28KIDS ;Entry from KIDS
     29 I '$D(XQSTAT),$D(^DIC(19,"AXQ","P0")) S XQSTAT=$$STATUS I 'XQSTAT W !!,"  Some one else is building menus.  Sorry." K XQSTAT Q
     30 I '$D(^DIC(19,"AXQ","P0","STOP")) D MICRO
     31 I '$D(^DIC(19,"AXQ","P0")) S ^DIC(19,"AXQ","P0")=$H L +^DIC(19,"AXQ","P0")
     32 I '$D(XQVE) S XQFG=0,XQBSEC=1,XQVE=0
     33 N XQNTREE,XQNDONE S (XQNTREE,XQNDONE)=0
     34 ;
     35 ;Set up the error trap so we can clear the screen if it blows
     36 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XQ81"
     37 E  S X="ERR^XQ81",@^%ZOSF("TRAP")
     38 ;
     39 ;Set up the bar graph and window if not from KIDS
     40 I '$D(XPDNM) D INIT^XPDID
     41 I XPDIDVT D
     42 .I $D(XPDIDTOT) S XQSAVTOT=XPDIDTOT
     43 .S X="Rebuilding Menus" D TITLE^XPDID(X)
     44 .S XPDIDTOT=50 ;Number of divisions in bar graph
     45 .D UPDATE^XPDID(0)
     46 .Q
     47 ;
     48 S XQSTART=$$HTE^XLFDT($H)
     49 W !!,"Starting Menu Rebuild:  ",XQSTART
     50 S XQFG=0 W !!,"Collecting primary menus in the New Person file..."
     51 ;
     52DQ ;Entry from taskman  Write if $D(XQFG)
     53 K ZTREQ
     54 I '$D(XQSTART) S XQSTART=$$HTE^XLFDT($H)
     55 N XQNOW,XQ8FLG,XQTASK
     56 S XQ8FLG=0
     57 S:'$D(XQNOW) XQNOW=$H
     58 S ^DIC(19,"AXQ","P0")=XQNOW
     59 S ^DIC(19,"AXQ","P0","STOP")=XQNOW ;Stop micro surgery if it's running
     60 ;
     61 S XQSEC=1,XQ81T="" I 'XQVE H 1
     62 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)=""
     63 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)=""
     64 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
     65 S:XQ81T="" XQ81T="Unknown"
     66 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)
     67 ;
     68 ;Find the various trees and put them into ^TMP($J), and count them
     69 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
     70 ;
     71 S (XQNTREE,%)=0 F  S %=$O(^TMP($J,%)) Q:%=""  S XQNTREE=XQNTREE+1
     72 S %=0 F  S %=$O(^TMP($J,"SEC",%)) Q:%=""  S XQNTREE=XQNTREE+1
     73 ;
     74 W:$D(XQFG) !!?20,"Primary menus found in the New Person file",!?20,"------------------------------------------"
     75 W:$D(XQFG) !!,"OPTION NAME         MENU TEXT",?49,"# OF",?62,"LAST",?71,"LAST",!?49,"USERS",?62,"USED",?71,"BUILT",!
     76 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
     77 S XQSEC=0 I $D(XQFG),XQBSEC W !!,"Building secondary menu trees...."
     78 I XQBSEC S X="" F XQBLD=0:0 S XQBLD=$O(^TMP($J,"SEC",XQBLD)) Q:XQBLD'>0  D SEC
     79 I 'XQVE S XQK="P" F XQBLD=0:0 S XQK=$O(^TMP("XQO",$J,XQK)) Q:XQK'["P"  S ^(XQK,0)=XQH
     80 G BLDEND
     81 ;
     82SEC S XQL="P"_XQBLD Q:$D(^TMP("XQO",$J,XQL))  D RD3 Q
     83 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
     84 D:$E(XQL)'="P" RD3
     85 Q
     86 ;
     87VER I $D(XQFG) D
     88 .N XQMT,XQOPNM
     89 .S XQK=$P(^TMP($J,XQBLD),U,2)
     90 .S:$L(XQK) XQK=$E(XQK,4,5)_"/"_$E(XQK,6,7)_"/"_$E(XQK,2,3)
     91 .S XQOPNM=$P(XQJ,U)
     92 .S XQMT=$P(XQJ,U,2) I $L(XQMT)>28 S XQMT=$E(XQMT,1,25)_"..."
     93 .W !,$P(XQJ,U,1)
     94 .W:($L(XQOPNM)>20) !
     95 .W ?20,XQMT,?49,+^TMP($J,XQBLD),?60,XQK
     96 .Q
     97 ;
     98 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)
     99 ;
     100RD3 ;Update counter an rebuild it if necessary
     101 I $D(XQFG),XPDIDVT D
     102 .N %
     103 .S XQNDONE=XQNDONE+1
     104 .S %=(XQNDONE/XQNTREE)*XPDIDTOT
     105 .D UPDATE^XPDID(%)
     106 .Q
     107 ;
     108 S XQDIC="P"_XQBLD D CHK^XQ8 I XQRE W:$D(XQFG) !,"SOMEONE ELSE IS CURRENTLY REBUILDING THIS MENU" Q
     109 I XQVE,XQSEC S DIR(0)="Y",DIR("A")="Rebuild",DIR("B")="YES" D ^DIR Q:$D(DIRUT)  W ! Q:Y'=1
     110 S XQFG1=1 D PM2^XQ8
     111 I $D(ZTQUEUED) S ZTREQ="@"
     112 Q
     113 ;
     114SET G:'$D(^VA(200,XQI,201)) SET1 S XQK=+^(201) Q:'$L(XQK)  ;I $D(XQFG) W:'(XQI#10) "."
     115 S XQR="" S:$D(^VA(200,XQI,1.1)) XQR=$P(^(1.1),".",1) S XQP=1_U_XQR
     116 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))
     117 I $D(^DIC(19,XQK,0)),$P(^(0),U,4)="M" S ^TMP($J,XQK)=XQP
     118 ;
     119SET1 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)=""
     120 Q
     121 ;
     122QUE ;Entry point for the option XQBUILDTREEQUE, and XQBUILDALL
     123 ;Also called by CHEK^XQ83
     124 S XQVE=0,XQBSEC=1 K XQFG
     125 S XQSTART=$$HTE^XLFDT($H)
     126 G DQ
     127 ;
     128BLDEND ;File a report, cleanup, and quit.
     129 ;
     130 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
     131 ;
     132 I $D(XQALLDON) K XQALLDON Q  ;Quit here if we're just creating a task
     133 ;
     134 D MERGET
     135 D CLEAN
     136 D MERGEX
     137 ;
     138 K ^TMP($J),^TMP("XQO",$J)
     139 ;
     140 ;Clear the flags and locks.
     141 K ^XUTL("XQMERGED") ;Menues merged since last rebuild REACT^XQ84
     142 K ^DIC(19,"AT") ;Micro message nodes
     143 S ^XUTL("XQ","MICRO")=0 ;Number of Micro instances since last build
     144 K ^DIC(19,"AXQ","P0","STOP") ;Allow Micro surgery to start up
     145 K ^DIC(19,"AXQ","P0") ;Clear the rebuild flag (redundant, I know)
     146 L -^DIC(19,"AXQ","P0") ;Unlock the rebuild flag, everybody's good to go
     147 ;
     148 S %=$S($D(XPDNM):"KIDS",$D(ZTSK):"QUEUED",1:"LIVE")
     149 D REPORT^XQ84(%)
     150 K XQSTART,ZTSK
     151 ;
     152 I '$D(XPDIDVT) K XQFG Q
     153 ;
     154 I $D(XQFG),XPDIDVT F %=((XQNDONE/XQNTREE)*XPDIDTOT):1:XPDIDTOT D UPDATE^XPDID(%) H .25
     155 I $D(XQFG),XPDIDVT D UPDATE^XPDID(XPDIDTOT)
     156 I $D(XQFG) W !!,"Menu Rebuild Complete:  ",$$HTE^XLFDT($H)
     157 ;
     158 ;
     159 H 2
     160 ;If we're not from KIDS then clean it up, otherwise let kids do it.
     161 I '$D(XPDNM) D
     162 .D EXIT^XPDID()
     163 .K XPDIDVT,XPDIDTOT
     164 .Q
     165 ;
     166 I $D(XQSAVTOT) S XPDIDTOT=XQSAVTOT
     167 K %,VALMCOFF,VALMCON,VALMIOXY,VALMSGR,VALMWD,XQFG,XQNDONE,XQNTREE,XQSAVTOT
     168 Q
     169 ;
     170 ;================================Subroutines==========================
     171 ;
     172MERGET ;Merge ^TMP("XQO",$J) into ^DIC(19,"AXQ")
     173 N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""
     174 I $D(XQFG) W !!,"Merging...."
     175 F  S X=$O(^TMP("XQO",$J,X)) Q:X=""  D
     176 .L +^DIC(19,"AXQ",X):2 I '$T S XQFLAG=1 Q
     177 .S %X="^TMP(""XQO"","_$J_","_Q_X_Q_","
     178 .S %Y="^DIC(19,""AXQ"","_Q_X_Q_","
     179 .K ^DIC(19,"AXQ",X)
     180 .;M ^DIC(19,"AXQ",X)=^TMP("XQO",$J,X)
     181 .D %XY^%RCR
     182 .L -^DIC(19,"AXQ",X)
     183 .K %X,%Y
     184 .Q
     185 ;
     186 I XQFLAG,$D(XQFG) D
     187 .N %,Y
     188 .S Y=$P(X,"P",2) Q:Y=""
     189 .S %=$G(^DIC(19,Y,0)) Q:%=""
     190 .S Y=$P(%,"^",2) Q:%=""
     191 .W !,?12,"Could not merge menu: "_Y
     192 .Q
     193 Q
     194 ;
     195CLEAN ;Clean out unused menu trees from ^DIC(19,"AXQ")
     196 N X,Y S X="P"
     197 F  S X=$O(^DIC(19,"AXQ",X)) Q:X=""  D
     198 .I X'="PXU" D
     199 ..S Y=$E(X,2,99)
     200 ..I '$D(^TMP($J,Y))&('$D(^TMP($J,"SEC",Y))) K ^DIC(19,"AXQ",X),^XUTL("XQO",X)
     201 ..Q
     202 .Q
     203 Q
     204 ;
     205MERGEX ;Merge ^DIC(19,"AXQ") into ^XUTL("XQO")
     206 N Q,X,XQFLAG,Y S X="P",XQFLAG=0,Q=""""
     207 F  S X=$O(^DIC(19,"AXQ",X)) Q:X=""  D
     208 .L +^XUTL("XQO",X):2 I '$T S XQFLAG=1 Q
     209 .S %X="^DIC(19,""AXQ"","_Q_X_Q_","
     210 .S %Y="^XUTL(""XQO"","_Q_X_Q_","
     211 .K ^XUTL("XQO",X)
     212 .;M ^XUTL("XQO",X)=^DIC(19,"AXQ",X)
     213 .D %XY^%RCR
     214 .L -^XUTL("XQO",X)
     215 .K %X,%Y
     216 .Q
     217 ;
     218 I XQFLAG,$D(XQFG) D
     219 .N %,Y
     220 .S Y=$P(X,"P",2) Q:Y=""
     221 .S %=$G(^DIC(19,Y,0)) Q:%=""
     222 .S Y=$P(%,"^",2) Q:%=""
     223 .W !,?12,"Could not merge menu: "_Y
     224 .Q
     225 ;
     226 I 'XQFLAG,$D(XQFG) W " done."
     227 Q
     228 ;
     229STATUS()  ;Are the menus being rebuilt even as we speak?
     230 N %,XQTHEN
     231 S %=$G(^DIC(19,"AXQ","P0")) I %="" Q 1  ;It finished.  Never mind.
     232 L +^DIC(19,"AXQ","P0"):0 ;If job is still running we can't lock it
     233 I $T L -^DIC(19,"AXQ","P0") K ^("P0") Q 1  ;Job must have failed
     234 Q 0
     235 ;
     236 ;
     237MICRO ;Turn off micro surgery
     238 I $D(^DIC(19,"AXQ","P0","MICRO")) D
     239 .S ^DIC(19,"AXQ","P0","STOP")=$H ;Turn off micro-surgery
     240 .K ^DIC(19,"AXQ","P0","MICRO")
     241 .H 2
     242 .Q
     243 Q
     244 ;
     245 ;
     246ERR ;Come here on error
     247 N XQERROR
     248 S XQERROR=$$EC^%ZOSV
     249 D ^%ZTER
     250 D EXIT^XPDID()
     251 G UNWIND^%ZTER
     252 Q
Note: See TracChangeset for help on using the changeset viewer.