XQ12 ;SEA/LUKE,ISD/HGW - MENU MANAGER UTILITIES ;01/10/13 15:09
;;8.0;KERNEL;**9,20,46,157,253,593,614**;Jul 10, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
;
DVARS ;Set up (or reset) necessary variables. From ^XQ1 and ^XQT1.
S U="^" I '$D(DUZ)#2 S DUZ=^XUTL("XQ",$J,"DUZ")
S:'$D(DUZ(0))#2 DUZ(0)="" I DUZ(0)="" S:$D(^VA(200,DUZ,0)) DUZ(0)=$P(^(0),U,4)
I '$D(DT) D ^XQDATE S DT=$P(%,".")
I '$D(DUZ("AG")),$D(^XTV(8989.3,1,0)) S DUZ("AG")=$P(^(0),U,8)
I '$D(IOS) S IOS=$S($D(^XUTL("XQ",$J,"IOS"))#2:^("IOS"),1:"")
I '$D(DTIME) S DTIME=$$DTIME^XUP(DUZ,IOS)
I '$D(DUZ("AUTO")) S I=$S($D(^VA(200,DUZ,200)):$P(^(200),U,6),1:"") S:'$L(I) I=$S($D(^%ZIS(1,$I,"XUS")):$P(^("XUS"),U,6),1:"") S:'$L(I) I=$S($D(^XTV(8989.3,1,"XUS")):$P(^("XUS"),U,6),1:"") S:'$L(I) I=1 S DUZ("AUTO")=I
I '$D(DUZ("TEST"))&'$$PROD^XUPROD D
.S DUZ("TEST")=$$GET^XPAR("SYS","XQ MENUMANAGER PROMPT",1,"Q")
.I $L($G(DUZ("TEST")))<3 S DUZ("TEST")=" <TEST ACCOUNT>"
Q
;
INIT ;Entry for new logon, called from the top of ^XQ and ^XQ1
K DIC,Y Q:$D(DUZ)[0 Q:'$D(^VA(200,DUZ,0))
;S:'$D(XQY) XQY=^VA(200,DUZ,201)
I '$D(XQUSER) S XQUSER=$P($P(^VA(200,DUZ,0),U),",",2)_" "_$P($P(^(0),U),",")
;
;Select device tied option, primary menu, or primary window
;
S:'$D(XQY) XQY=""
S %=$G(^VA(200,DUZ,201)),^XUTL("XQ",$J,"XQM")=+%,^("XQW")=$P(%,"^",2)
D:'$D(IO) HOME^%ZIS
I IO]"" S %=$G(^%ZIS(1,IO,201)) I %]"" S XQY=%
I XQY']"" D
.S %=$G(^VA(200,DUZ,201))
.S XQPM=$P(%,U),XQPW=$P(%,U,2),XQSD=$P(%,U,3)
.I XQPW']"" S XQY=XQPM Q
.I XQSD="M" S XQY=XQPM
.E S XQY=XQPW
.Q
;
D SET^XQCHK
S ^XUTL("XQ",$J,1)=XQY_"P"_XQY_"^"_XQY0,^("T")=1
S XQDIC=XQY,XQPSM="P"_XQY
;
; P593 Run XU USER START-UP menu option for terminal sessions only
I $E($G(IOST),1,2)="C-" S XUSQUIT=$$STARTUP() G:XUSQUIT HALT
;
;D MERGE,MGPXU,MGSEC ;get the menu trees this user will need to jump
;
;Fire LOGIN menu template if they have one and its the first login
;of the day. XQXFLG("LLOG") is copy of ^VA(200,DUZ,1.1) before it's
;updated at XUS1+47
I $D(^VA(200,DUZ,19.8,"B","LOGIN")) D
.Q:'$D(XQXFLG("LLOG"))
.S XQLAST=$P($P(XQXFLG("LLOG"),U),".") ;Get last login DT
.Q:+XQLAST<1
.I XQLAST<DT S XQUR="[LOGIN",XQJS=3
.K XQLAST
.Q
K XQXFLG("LLOG")
;
UI ;Entry for TaskMan (DUZ may = 0), from ZTSK^XQ1
D DVARS I '$D(^XUTL("XQ",$J,0)) D ^XQDATE S ^XUTL("XQ",$J,0)=%_U_%Y
S:'$D(XQDIC) XQDIC="P"_XQY
S:'$D(XQPSM) XQPSM="P"_XQY
S:'$D(XQJS)&'$D(ZTQUEUED) XQY0=^DIC(19,XQY,0),^XUTL("XQ",$J,"T")=0,^("DUZ")=DUZ,^("XQM")=XQY,XQPSM="P"_XQY
S XQCY=XQY D ^XQCHK I XQCY<1 D
.S XQPRMN=1,XQL=0
.D:'$D(ZTQUEUED) MES^XQCHK,PAUSE^XQ6
.S XQY=-1
.Q
S XQM3="" I $P(XQY0,U,4)'="A",$P(XQY0,U,14),$D(^DIC(19,XQY,20)),$L(^(20)) X ^(20) ;W " ==> XQ12+59"
I $D(XQUIT),'$D(ZTQUEUED) D PM^XQUIT I $D(XQUIT) S XQY=-1 G ^XUSCLEAN
ABT ;WARNING: XQXFLG is also used by OERR test sites.
S U="^"
S $P(XQXFLG,U)=$S($O(^XTV(8989.3,1,"ABPKG",0))>0:1,1:0)
CMP S $P(XQXFLG,U,2)=$S('$D(^XTV(8989.3,1,"XUCP")):0,1:^("XUCP")="Y")
K %,%Y,PGM,X,XQCY,XQPM,XQPXU,XQPW,XQSD
Q
MERGE ;Merge in the menu trees that this user needs, start with Primary Menu
Q:'$D(^DIC(19,"AXQ",XQPSM))
I $D(^XUTL("XQO","XQMERGED",XQPSM)) D OLDF(XQPSM)
Q:$D(^XUTL("XQO","XQMERGED",XQPSM)) ;It's already being done
;
L +^XUTL("XQO",XQPSM):DILOCKTM Q:'$T
S ^XUTL("XQO","XQMERGED",XQPSM)=$H
;
K ^XUTL("XQO",XQPSM)
M ^XUTL("XQO",XQPSM)=^DIC(19,"AXQ",XQPSM)
;
L -^XUTL("XQO",XQPSM)
K ^XUTL("XQO","XQMERGED",XQPSM)
Q
;
MGPXU ;Check for XUCOMMAND
Q:'$D(^DIC(19,"AXQ","PXU"))
I $D(^XUTL("XQO","XQMERGED","PXU")) D OLDF("PXU")
Q:$D(^XUTL("XQO","XQMERGED","PXU")) ;Already being merged
;
L +^XUTL("XQO","PXU"):DILOCKTM Q:'$T
S ^XUTL("XQO","XQMERGED","PXU")=$H
;
K ^XUTL("XQO","PXU")
M ^XUTL("XQO","PXU")=^DIC(19,"AXQ","PXU")
;
L -^XUTL("XQO","PXU")
K ^XUTL("XQO","XQMERGED","PXU")
Q
;
MGSEC ;Now the Secondary Menu trees
N %,%1
F %=0:0 S %=$O(^VA(200,DUZ,203,"B",%)) Q:%'=+% D
.S %1="P"_%
.I '$D(^XUTL("XQO",%1)),$D(^DIC(19,"AXQ",%1)) D
..I $D(^XUTL("XQO","XQMERGED",%1)) D OLDF(%1)
..Q:$D(^XUTL("XQO","XQMERGED",%1)) ;Already merging as we speak
..S ^XUTL("XQO","XQMERGED",%1)=$H
..L +^XUTL("XQO",%1):DILOCKTM Q:'$T
..I '$D(^XUTL("XQO",%1)) D
...K ^XUTL("XQO",%1)
...M ^XUTL("XQO",%1)=^DIC(19,"AXQ",%1)
...Q
..L -^XUTL("XQO",%1)
..K ^XUTL("XQO","XQMERGED",%1)
..Q
.Q
Q
;
OLDF(X) ;See if this flag is au current, if not KILL it
;X is the P name of the tree, e.g., P9 might be EVE
S:'$D(XQPXU) XQPXU=$G(^DIC(19,"AXQ","PXU",0))
I XQPXU="" S XQPXU=$H ;Assume it's rebuilding now
N Y,Z
S Y=$G(^XUTL("XQO","XQMERGED",X)) Q:Y="" ;Flag's gone
S Z=$$HDIFF^XLFDT(XQPXU,Y,2)
I Z<3600 K ^XUTL("XQO","XQMERGED",X) ;Old Flag
Q
;
LOGOPT ;Option audit
S:'$D(XQLTL) XQLTL=""
S %=$P($H,",",2),%=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)
I XQLTL S $P(^XUSEC(19,XQLTL,0),U,5)=%,XQLTL=0
S I=1 I XQAUDIT'=1 S I=0 F J=1:2 S K1=$P(XQAUDIT,U,J),K2=$P(XQAUDIT,U,J+1) Q:'$L(K1)!I I K1=2&(K2=XQY)!(K1=3&($E($P(XQY0,U,1),1,$L(K2))=K2)) S I=1
Q:'I S XQLTL=% L +^XUSEC(19,0):0 S %=^XUSEC(19,0),XQLTL=XQLTL+(.00000001*$S(XQLTL'=$E($P(%,U,3),1,14):10,1:$E($P(%,U,3),15,16)+1)),$P(^(0),U,3,4)=XQLTL_"^"_($P(%,U,4)+1) L -^XUSEC(19,0)
D GETENV^%ZOSV S XUVOL=$P(Y,U,2),^XUSEC(19,XQLTL,0)=XQY_U_DUZ_U_$I_U_$J_"^^"_XUVOL
K K1,K2
Q
XPRMP D CHK^XM W !!,"Do you really want to ",$S(XQUR="REST":"restart",1:"halt"),"? YES// " R X:10 S:'$L(X) X="Y"
I "Yy"'[$E(X) S Y=1 S:^XUTL("XQ",$J,"T")>1 Y=^("T")-1 S ^("T")=Y,Y=^(Y),XQY0=$P(Y,U,2,99),XQPSM=$P(Y,U,1),(XQY,XQDIC)=+XQPSM,XQPSM=$P(XQPSM,XQY,2,3),XQAA="Select "_$P(XQY0,U,2)_$G(DUZ("TEST"))_" Option: " W ! G ASK^XQ
G REST:XQUR="REST",HALT:XQUR'="CON"
;
CON ;Continue option logic. Enter from ASK^XQ on timeout.
W !!,"Do you want to halt and continue with this option later? YES// " R XQUR:20 S:(XQUR="")!('$T) XQUR="Y"
I "YyNn"'[$E(XQUR,1) W !!," If you enter 'Y' or 'RETURN' you will halt and continue here next time",!," you logon to the computer.",!," If you enter 'N' you will resume processing where you were." G CON
I "Nn"[$E(XQUR,1) W ! S XQUR=0,Y=^XUTL("XQ",$J,"T"),Y=^(Y),XQY0=$P(Y,U,2,99),XQPSM=$P(Y,U,1),(XQY,XQDIC)=+XQPSM,XQPSM=$P(XQPSM,XQY,2,3),XQAA="Select "_$P(XQY0,U,2)_$G(DUZ("TEST"))_" Option: " G ASK^XQ
S X=^XUTL("XQ",$J,^XUTL("XQ",$J,"T")),Y=^("XQM") I (+X'=+Y) S XQM="P"_+Y S XQPSM=$S($D(^XUTL("XQO",XQM,"^",+X)):XQM,$D(^XUTL("XQO","PXU","^",+X)):"PXU",1:"") D:XQPSM="" SS S:XQPSM'="" ^VA(200,DUZ,202.1)=+X_XQPSM
S X=$P($H,",",2),X=(X>41400&(X<46800))
W !!,$P("HMM^OK^ALL RIGHT^WELL CERTAINLY^FINE","^",$R(5)+1),"... ",$P("SEE YOU LATER^I'LL BE READY WHEN YOU ARE.^HURRY BACK!^HAVE A GOOD LUNCH BREAK!","^",$R(3)+X+1)
HALT ;
G H^XUS
REST S XQNOHALT=1 D ^XUSCLEAN G ^XUS
;
SS ;Search Secondaries for a particular option.
Q:'$D(^VA(200,DUZ,203,0)) Q:$P(^VA(200,DUZ,203,0),U,4)<1
S Y=0 F XQI=1:1 Q:XQPSM'="" S Y=$O(^VA(200,DUZ,203,Y)) Q:Y'>0 S %=^(Y,0) I $D(^XUTL("XQO","P"_%,"^",+X)) S XQPSM="U"_DUZ_",P"_%
Q
ABLOG S %2=0 F %3=0:0 S %2=$O(^XTV(8989.3,1,"ABPKG",%2)) Q:%2'>0 F %=0:0 S %=$O(^XTV(8989.3,1,"ABPKG",%2,1,%)) Q:%'>0 S %1=$P(^(%,0),U) I $E(XQY0,1,$L(%1))=%1,$E(XQY0,$L(%1)+1)'="Z" D ABLOG1
K %,%1,%2,%3,%4
Q
ABLOG1 F %4=0:0 S %4=$O(^XTV(8989.3,1,"ABPKG",%2,1,%,1,%4)) Q:%4'>0 S %1=$P(^(%4,0),U) I $E(XQY0,1,$L(%1))=%1 Q
I %4'>0 S:'$D(^XTV(8989.3,1,"ABOPT",0)) ^(0)="^8989.333P^" S:'$D(^(XQY)) %4=+$P(^(0),U,3),$P(^(0),U,3,4)=$S(XQY>%4:XQY,1:%4)_U_($P(^(0),U,4)+1) S ^(0)=XQY_U_($S($D(^(XQY,0)):$P(^(0),U,2),1:0)+1),%2="A"
Q
STARTUP() ; P593 Run XU USER START-UP option
N XUSER,XUSQUIT,XUDISV ;Protect ourself.
S DIC="^DIC(19,",X="XU USER START-UP",XUSQUIT=0
S XUDISV=$G(^DISV(DUZ,"^DIC(19,")) ;p614 Save OPTION value for <spacebar><return>
D EN^XQOR
I $G(XUDISV)>0 S ^DISV(DUZ,"^DIC(19,")=XUDISV ;p614 Restore OPTION value for <spacebar><return>
K X,DIC
Q XUSQUIT ;If option set XUSQUIT will stop sign-on.
SAMPLE ; P593 sample start-up option
N DA
S DA=+DUZ
W !!," Sample: Testing XU USER START-UP option for patch XU*8.0*593"
W !!," Sample: Prompt to edit fields in NEW PERSON file (#200)",!
S DA=+DUZ,DIE="^VA(200,",DR="20.2;20.3;.132;.138" D ^DIE
W !!," Sample: Yes(Y) or No(N) prompt."
W !," Entering Y will set the variable XUSQUIT to 1 and end your session."
W !," Entering anything else (including ^ or <CR>) will continue."
W !," Do you want to end your session now" D YN^DICN I %=1 S XUSQUIT=%
W !!," Sample: End of sample script."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ12 8651 printed Jan 18, 2025@03:05:52 Page 2
XQ12 ;SEA/LUKE,ISD/HGW - MENU MANAGER UTILITIES ;01/10/13 15:09
+1 ;;8.0;KERNEL;**9,20,46,157,253,593,614**;Jul 10, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
DVARS ;Set up (or reset) necessary variables. From ^XQ1 and ^XQT1.
+1 SET U="^"
IF '$DATA(DUZ)#2
SET DUZ=^XUTL("XQ",$JOB,"DUZ")
+2 if '$DATA(DUZ(0))#2
SET DUZ(0)=""
IF DUZ(0)=""
if $DATA(^VA(200,DUZ,0))
SET DUZ(0)=$PIECE(^(0),U,4)
+3 IF '$DATA(DT)
DO ^XQDATE
SET DT=$PIECE(%,".")
+4 IF '$DATA(DUZ("AG"))
IF $DATA(^XTV(8989.3,1,0))
SET DUZ("AG")=$PIECE(^(0),U,8)
+5 IF '$DATA(IOS)
SET IOS=$SELECT($DATA(^XUTL("XQ",$JOB,"IOS"))#2:^("IOS"),1:"")
+6 IF '$DATA(DTIME)
SET DTIME=$$DTIME^XUP(DUZ,IOS)
+7 IF '$DATA(DUZ("AUTO"))
SET I=$SELECT($DATA(^VA(200,DUZ,200)):$PIECE(^(200),U,6),1:"")
if '$LENGTH(I)
SET I=$SELECT($DATA(^%ZIS(1,$IO,"XUS")):$PIECE(^("XUS"),U,6),1:"")
if '$LENGTH(I)
SET I=$SELECT($DATA(^XTV(8989.3,1,"XUS")):$PIECE(^("XUS"),U,6),1:"")
if '$LENGTH(I)
SET I=1
SET DUZ("AUTO")=I
+8 IF '$DATA(DUZ("TEST"))&'$$PROD^XUPROD
Begin DoDot:1
+9 SET DUZ("TEST")=$$GET^XPAR("SYS","XQ MENUMANAGER PROMPT",1,"Q")
+10 IF $LENGTH($GET(DUZ("TEST")))<3
SET DUZ("TEST")=" <TEST ACCOUNT>"
End DoDot:1
+11 QUIT
+12 ;
INIT ;Entry for new logon, called from the top of ^XQ and ^XQ1
+1 KILL DIC,Y
if $DATA(DUZ)[0
QUIT
if '$DATA(^VA(200,DUZ,0))
QUIT
+2 ;S:'$D(XQY) XQY=^VA(200,DUZ,201)
+3 IF '$DATA(XQUSER)
SET XQUSER=$PIECE($PIECE(^VA(200,DUZ,0),U),",",2)_" "_$PIECE($PIECE(^(0),U),",")
+4 ;
+5 ;Select device tied option, primary menu, or primary window
+6 ;
+7 if '$DATA(XQY)
SET XQY=""
+8 SET %=$GET(^VA(200,DUZ,201))
SET ^XUTL("XQ",$JOB,"XQM")=+%
SET ^("XQW")=$PIECE(%,"^",2)
+9 if '$DATA(IO)
DO HOME^%ZIS
+10 IF IO]""
SET %=$GET(^%ZIS(1,IO,201))
IF %]""
SET XQY=%
+11 IF XQY']""
Begin DoDot:1
+12 SET %=$GET(^VA(200,DUZ,201))
+13 SET XQPM=$PIECE(%,U)
SET XQPW=$PIECE(%,U,2)
SET XQSD=$PIECE(%,U,3)
+14 IF XQPW']""
SET XQY=XQPM
QUIT
+15 IF XQSD="M"
SET XQY=XQPM
+16 IF '$TEST
SET XQY=XQPW
+17 QUIT
End DoDot:1
+18 ;
+19 DO SET^XQCHK
+20 SET ^XUTL("XQ",$JOB,1)=XQY_"P"_XQY_"^"_XQY0
SET ^("T")=1
+21 SET XQDIC=XQY
SET XQPSM="P"_XQY
+22 ;
+23 ; P593 Run XU USER START-UP menu option for terminal sessions only
+24 IF $EXTRACT($GET(IOST),1,2)="C-"
SET XUSQUIT=$$STARTUP()
if XUSQUIT
GOTO HALT
+25 ;
+26 ;D MERGE,MGPXU,MGSEC ;get the menu trees this user will need to jump
+27 ;
+28 ;Fire LOGIN menu template if they have one and its the first login
+29 ;of the day. XQXFLG("LLOG") is copy of ^VA(200,DUZ,1.1) before it's
+30 ;updated at XUS1+47
+31 IF $DATA(^VA(200,DUZ,19.8,"B","LOGIN"))
Begin DoDot:1
+32 if '$DATA(XQXFLG("LLOG"))
QUIT
+33 ;Get last login DT
SET XQLAST=$PIECE($PIECE(XQXFLG("LLOG"),U),".")
+34 if +XQLAST<1
QUIT
+35 IF XQLAST<DT
SET XQUR="[LOGIN"
SET XQJS=3
+36 KILL XQLAST
+37 QUIT
End DoDot:1
+38 KILL XQXFLG("LLOG")
+39 ;
UI ;Entry for TaskMan (DUZ may = 0), from ZTSK^XQ1
+1 DO DVARS
IF '$DATA(^XUTL("XQ",$JOB,0))
DO ^XQDATE
SET ^XUTL("XQ",$JOB,0)=%_U_%Y
+2 if '$DATA(XQDIC)
SET XQDIC="P"_XQY
+3 if '$DATA(XQPSM)
SET XQPSM="P"_XQY
+4 if '$DATA(XQJS)&'$DATA(ZTQUEUED)
SET XQY0=^DIC(19,XQY,0)
SET ^XUTL("XQ",$JOB,"T")=0
SET ^("DUZ")=DUZ
SET ^("XQM")=XQY
SET XQPSM="P"_XQY
+5 SET XQCY=XQY
DO ^XQCHK
IF XQCY<1
Begin DoDot:1
+6 SET XQPRMN=1
SET XQL=0
+7 if '$DATA(ZTQUEUED)
DO MES^XQCHK
DO PAUSE^XQ6
+8 SET XQY=-1
+9 QUIT
End DoDot:1
+10 ;W " ==> XQ12+59"
SET XQM3=""
IF $PIECE(XQY0,U,4)'="A"
IF $PIECE(XQY0,U,14)
IF $DATA(^DIC(19,XQY,20))
IF $LENGTH(^(20))
XECUTE ^(20)
+11 IF $DATA(XQUIT)
IF '$DATA(ZTQUEUED)
DO PM^XQUIT
IF $DATA(XQUIT)
SET XQY=-1
GOTO ^XUSCLEAN
ABT ;WARNING: XQXFLG is also used by OERR test sites.
+1 SET U="^"
+2 SET $PIECE(XQXFLG,U)=$SELECT($ORDER(^XTV(8989.3,1,"ABPKG",0))>0:1,1:0)
CMP SET $PIECE(XQXFLG,U,2)=$SELECT('$DATA(^XTV(8989.3,1,"XUCP")):0,1:^("XUCP")="Y")
+1 KILL %,%Y,PGM,X,XQCY,XQPM,XQPXU,XQPW,XQSD
+2 QUIT
MERGE ;Merge in the menu trees that this user needs, start with Primary Menu
+1 if '$DATA(^DIC(19,"AXQ",XQPSM))
QUIT
+2 IF $DATA(^XUTL("XQO","XQMERGED",XQPSM))
DO OLDF(XQPSM)
+3 ;It's already being done
if $DATA(^XUTL("XQO","XQMERGED",XQPSM))
QUIT
+4 ;
+5 LOCK +^XUTL("XQO",XQPSM):DILOCKTM
if '$TEST
QUIT
+6 SET ^XUTL("XQO","XQMERGED",XQPSM)=$HOROLOG
+7 ;
+8 KILL ^XUTL("XQO",XQPSM)
+9 MERGE ^XUTL("XQO",XQPSM)=^DIC(19,"AXQ",XQPSM)
+10 ;
+11 LOCK -^XUTL("XQO",XQPSM)
+12 KILL ^XUTL("XQO","XQMERGED",XQPSM)
+13 QUIT
+14 ;
MGPXU ;Check for XUCOMMAND
+1 if '$DATA(^DIC(19,"AXQ","PXU"))
QUIT
+2 IF $DATA(^XUTL("XQO","XQMERGED","PXU"))
DO OLDF("PXU")
+3 ;Already being merged
if $DATA(^XUTL("XQO","XQMERGED","PXU"))
QUIT
+4 ;
+5 LOCK +^XUTL("XQO","PXU"):DILOCKTM
if '$TEST
QUIT
+6 SET ^XUTL("XQO","XQMERGED","PXU")=$HOROLOG
+7 ;
+8 KILL ^XUTL("XQO","PXU")
+9 MERGE ^XUTL("XQO","PXU")=^DIC(19,"AXQ","PXU")
+10 ;
+11 LOCK -^XUTL("XQO","PXU")
+12 KILL ^XUTL("XQO","XQMERGED","PXU")
+13 QUIT
+14 ;
MGSEC ;Now the Secondary Menu trees
+1 NEW %,%1
+2 FOR %=0:0
SET %=$ORDER(^VA(200,DUZ,203,"B",%))
if %'=+%
QUIT
Begin DoDot:1
+3 SET %1="P"_%
+4 IF '$DATA(^XUTL("XQO",%1))
IF $DATA(^DIC(19,"AXQ",%1))
Begin DoDot:2
+5 IF $DATA(^XUTL("XQO","XQMERGED",%1))
DO OLDF(%1)
+6 ;Already merging as we speak
if $DATA(^XUTL("XQO","XQMERGED",%1))
QUIT
+7 SET ^XUTL("XQO","XQMERGED",%1)=$HOROLOG
+8 LOCK +^XUTL("XQO",%1):DILOCKTM
if '$TEST
QUIT
+9 IF '$DATA(^XUTL("XQO",%1))
Begin DoDot:3
+10 KILL ^XUTL("XQO",%1)
+11 MERGE ^XUTL("XQO",%1)=^DIC(19,"AXQ",%1)
+12 QUIT
End DoDot:3
+13 LOCK -^XUTL("XQO",%1)
+14 KILL ^XUTL("XQO","XQMERGED",%1)
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
OLDF(X) ;See if this flag is au current, if not KILL it
+1 ;X is the P name of the tree, e.g., P9 might be EVE
+2 if '$DATA(XQPXU)
SET XQPXU=$GET(^DIC(19,"AXQ","PXU",0))
+3 ;Assume it's rebuilding now
IF XQPXU=""
SET XQPXU=$HOROLOG
+4 NEW Y,Z
+5 ;Flag's gone
SET Y=$GET(^XUTL("XQO","XQMERGED",X))
if Y=""
QUIT
+6 SET Z=$$HDIFF^XLFDT(XQPXU,Y,2)
+7 ;Old Flag
IF Z<3600
KILL ^XUTL("XQO","XQMERGED",X)
+8 QUIT
+9 ;
LOGOPT ;Option audit
+1 if '$DATA(XQLTL)
SET XQLTL=""
+2 SET %=$PIECE($HOROLOG,",",2)
SET %=DT_(%\60#60/100+(%\3600)+(%#60/10000)/100)
+3 IF XQLTL
SET $PIECE(^XUSEC(19,XQLTL,0),U,5)=%
SET XQLTL=0
+4 SET I=1
IF XQAUDIT'=1
SET I=0
FOR J=1:2
SET K1=$PIECE(XQAUDIT,U,J)
SET K2=$PIECE(XQAUDIT,U,J+1)
if '$LENGTH(K1)!I
QUIT
IF K1=2&(K2=XQY)!(K1=3&($EXTRACT($PIECE(XQY0,U,1),1,$LENGTH(K2))=K2))
SET I=1
+5 if 'I
QUIT
SET XQLTL=%
LOCK +^XUSEC(19,0):0
SET %=^XUSEC(19,0)
SET XQLTL=XQLTL+(.00000001*$SELECT(XQLTL'=$EXTRACT($PIECE(%,U,3),1,14):10,1:$EXTRACT($PIECE(%,U,3),15,16)+1))
SET $PIECE(^(0),U,3,4)=XQLTL_"^"_($PIECE(%,U,4)+1)
LOCK -^XUSEC(19,0)
+6 DO GETENV^%ZOSV
SET XUVOL=$PIECE(Y,U,2)
SET ^XUSEC(19,XQLTL,0)=XQY_U_DUZ_U_$IO_U_$JOB_"^^"_XUVOL
+7 KILL K1,K2
+8 QUIT
XPRMP DO CHK^XM
WRITE !!,"Do you really want to ",$SELECT(XQUR="REST":"restart",1:"halt"),"? YES// "
READ X:10
if '$LENGTH(X)
SET X="Y"
+1 IF "Yy"'[$EXTRACT(X)
SET Y=1
if ^XUTL("XQ",$JOB,"T")>1
SET Y=^("T")-1
SET ^("T")=Y
SET Y=^(Y)
SET XQY0=$PIECE(Y,U,2,99)
SET XQPSM=$PIECE(Y,U,1)
SET (XQY,XQDIC)=+XQPSM
SET XQPSM=$PIECE(XQPSM,XQY,2,3)
SET XQAA="Select "_$PIECE(XQY0,U,2)_$GET(DUZ("TEST"))_" Option: "
WRITE !
GOTO ASK^XQ
+2 if XQUR="REST"
GOTO REST
if XQUR'="CON"
GOTO HALT
+3 ;
CON ;Continue option logic. Enter from ASK^XQ on timeout.
+1 WRITE !!,"Do you want to halt and continue with this option later? YES// "
READ XQUR:20
if (XQUR="")!('$TEST)
SET XQUR="Y"
+2 IF "YyNn"'[$EXTRACT(XQUR,1)
WRITE !!," If you enter 'Y' or 'RETURN' you will halt and continue here next time",!," you logon to the computer.",!," If you enter 'N' you will resume processing where you were."
GOTO CON
+3 IF "Nn"[$EXTRACT(XQUR,1)
WRITE !
SET XQUR=0
SET Y=^XUTL("XQ",$JOB,"T")
SET Y=^(Y)
SET XQY0=$PIECE(Y,U,2,99)
SET XQPSM=$PIECE(Y,U,1)
SET (XQY,XQDIC)=+XQPSM
SET XQPSM=$PIECE(XQPSM,XQY,2,3)
SET XQAA="Select "_$PIECE(XQY0,U,2)_$GET(DUZ("TEST"))_" Option: "
GOTO ASK^XQ
+4 SET X=^XUTL("XQ",$JOB,^XUTL("XQ",$JOB,"T"))
SET Y=^("XQM")
IF (+X'=+Y)
SET XQM="P"_+Y
SET XQPSM=$SELECT($DATA(^XUTL("XQO",XQM,"^",+X)):XQM,$DATA(^XUTL("XQO","PXU","^",+X)):"PXU",1:"")
if XQPSM=""
DO SS
if XQPSM'=""
SET ^VA(200,DUZ,202.1)=+X_XQPSM
+5 SET X=$PIECE($HOROLOG,",",2)
SET X=(X>41400&(X<46800))
+6 WRITE !!,$PIECE("HMM^OK^ALL RIGHT^WELL CERTAINLY^FINE","^",$RANDOM(5)+1),"... ",$PIECE("SEE YOU LATER^I'LL BE READY WHEN YOU ARE.^HURRY BACK!^HAVE A GOOD LUNCH BREAK!","^",$RANDOM(3)+X+1)
HALT ;
+1 GOTO H^XUS
REST SET XQNOHALT=1
DO ^XUSCLEAN
GOTO ^XUS
+1 ;
SS ;Search Secondaries for a particular option.
+1 if '$DATA(^VA(200,DUZ,203,0))
QUIT
if $PIECE(^VA(200,DUZ,203,0),U,4)<1
QUIT
+2 SET Y=0
FOR XQI=1:1
if XQPSM'=""
QUIT
SET Y=$ORDER(^VA(200,DUZ,203,Y))
if Y'>0
QUIT
SET %=^(Y,0)
IF $DATA(^XUTL("XQO","P"_%,"^",+X))
SET XQPSM="U"_DUZ_",P"_%
+3 QUIT
ABLOG SET %2=0
FOR %3=0:0
SET %2=$ORDER(^XTV(8989.3,1,"ABPKG",%2))
if %2'>0
QUIT
FOR %=0:0
SET %=$ORDER(^XTV(8989.3,1,"ABPKG",%2,1,%))
if %'>0
QUIT
SET %1=$PIECE(^(%,0),U)
IF $EXTRACT(XQY0,1,$LENGTH(%1))=%1
IF $EXTRACT(XQY0,$LENGTH(%1)+1)'="Z"
DO ABLOG1
+1 KILL %,%1,%2,%3,%4
+2 QUIT
ABLOG1 FOR %4=0:0
SET %4=$ORDER(^XTV(8989.3,1,"ABPKG",%2,1,%,1,%4))
if %4'>0
QUIT
SET %1=$PIECE(^(%4,0),U)
IF $EXTRACT(XQY0,1,$LENGTH(%1))=%1
QUIT
+1 IF %4'>0
if '$DATA(^XTV(8989.3,1,"ABOPT",0))
SET ^(0)="^8989.333P^"
if '$DATA(^(XQY))
SET %4=+$PIECE(^(0),U,3)
SET $PIECE(^(0),U,3,4)=$SELECT(XQY>%4:XQY,1:%4)_U_($PIECE(^(0),U,4)+1)
SET ^(0)=XQY_U_($SELECT($DATA(^(XQY,0)):$PIECE(^(0),U,2),1:0)+1)
SET %2="A"
+2 QUIT
STARTUP() ; P593 Run XU USER START-UP option
+1 ;Protect ourself.
NEW XUSER,XUSQUIT,XUDISV
+2 SET DIC="^DIC(19,"
SET X="XU USER START-UP"
SET XUSQUIT=0
+3 ;p614 Save OPTION value for <spacebar><return>
SET XUDISV=$GET(^DISV(DUZ,"^DIC(19,"))
+4 DO EN^XQOR
+5 ;p614 Restore OPTION value for <spacebar><return>
IF $GET(XUDISV)>0
SET ^DISV(DUZ,"^DIC(19,")=XUDISV
+6 KILL X,DIC
+7 ;If option set XUSQUIT will stop sign-on.
QUIT XUSQUIT
SAMPLE ; P593 sample start-up option
+1 NEW DA
+2 SET DA=+DUZ
+3 WRITE !!," Sample: Testing XU USER START-UP option for patch XU*8.0*593"
+4 WRITE !!," Sample: Prompt to edit fields in NEW PERSON file (#200)",!
+5 SET DA=+DUZ
SET DIE="^VA(200,"
SET DR="20.2;20.3;.132;.138"
DO ^DIE
+6 WRITE !!," Sample: Yes(Y) or No(N) prompt."
+7 WRITE !," Entering Y will set the variable XUSQUIT to 1 and end your session."
+8 WRITE !," Entering anything else (including ^ or <CR>) will continue."
+9 WRITE !," Do you want to end your session now"
DO YN^DICN
IF %=1
SET XUSQUIT=%
+10 WRITE !!," Sample: End of sample script."
+11 QUIT
