XQ7 ;SF-ISC..SEA/JLI - MICROSURGERY OF XUTL MENU TREES ;01/09/2001 13:29
;;8.0;KERNEL;**44,60,155**;Jul 10, 1995
REDO ; All changes to an option come here, i.e., menu text, locks, prohibited times, etc.
S XQFLAG=DA
S %H=$H F %=0:0 S %=$O(^DIC(19,"AD",DA,%)) Q:%'>0 S ^DIC(19,%,99)=%H I '$D(^DIC(19,%,0)) K ^DIC(19,%),^DIC(19,"AD",DA,%)
F %=0:0 S %=$O(^VA(200,"AD",DA,%)) Q:%'>0 S ^VA(200,%,203.1)=%H
;
FLAG ;
S ^DIC(19,"AT",$$NOW^XLFDT(),XQFLAG)=""
K %,%H,XQFLAG
Q
;
REDOX ;
S %H=$H,^DIC(19,DA(1),99)=%H
F %=0:0 S %=$O(^VA(200,"AD",DA(1),%)) Q:%'>0 S ^VA(200,%,203.1)=%H
Q
;
REDOXI ; Insertion of an item on a menu
D REDOX
S XQFLAG=DA(1)_"I"_X G FLAG
;
REDOXD ; Deletion of an item from a menu
D REDOX
S XQFLAG=DA(1)_"D"_X G FLAG
;
REDOXS ; Change or addition of a synonym
D REDOX
S XQFLAG=DA(1)_"S"_(+^DIC(19,DA(1),10,DA,0)) G FLAG
;
REDOXZ ; Change in display order, does not affect trees
D REDOX K %,%H
Q
REDOXP ; Check for new primary menu added to user file
Q:$D(^XUTL("XQO","P"_X))
S XQFLAG=X_"P"_X G FLAG
;
CK ;Called from several places in ^DD(19,
I $D(DIFROM) Q
S %=$P(^DIC(19,D0,0),U,6),%Y=$P(^DIC(19,D0,0),U,1) I $S($L(%):$D(^XUSEC(%,DUZ)),1:1)
Q:'$T
I DUZ(0)="@"!$D(^XUSEC("XUMGR",DUZ))!$D(^VA(200,DUZ,19.5,Y,0))
Q:'$T
CK1 S %=$P(^DIC(19,D0,0),U,4),%Y=$P(^DIC(19,Y,0),U,4) I $S((%'="O"&(%'="Q"))&(%Y'="Q"):1,(%="O"&(%Y="O")):1,(%="Q"&((%Y="O")!(%Y="Q"))):1,1:0)
Q
DEV ;See if device is legit for this option. Called by CHK1+5^XQ71.
S (%,XQSJ)=0 Q:'$D(^DIC(19,+XQW,3.96,0))
F XQSL=1:1 S %=$O(^DIC(19,+XQW,3.96,%)) Q:%=""!(%'=+%) S:XQSIO=^(%,0) XQSJ=1
Q
UP S X=$$UP^XLFSTR(X) ;F XQSA=1:1 Q:X?.NUP S %=$A(X,XQSA) I %<123,%>96 S X=$E(X,1,XQSA-1)_$C(%-32)_$E(X,XQSA+1,255)
Q
;
KICK ;Kick off microsurgery here and all compute servers
D CHEK^XQ83
Q:'$D(^%ZIS(14.5))
N XQ,XQVOL,XQTIM,ZTCPU
S XQTIM=$P($H,",")-1_","_$P($H,",",2)
S XQ=0 F S XQ=$O(^%ZIS(14.5,XQ)) Q:XQ=""!(XQ'=+XQ) I $P(^(XQ,0),U,11) D
.S ZTCPU=$P(^%ZIS(14.5,XQ,0),U) D CHEK^XQ83
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ7 2063 printed Dec 13, 2024@02:04:56 Page 2
XQ7 ;SF-ISC..SEA/JLI - MICROSURGERY OF XUTL MENU TREES ;01/09/2001 13:29
+1 ;;8.0;KERNEL;**44,60,155**;Jul 10, 1995
REDO ; All changes to an option come here, i.e., menu text, locks, prohibited times, etc.
+1 SET XQFLAG=DA
+2 SET %H=$HOROLOG
FOR %=0:0
SET %=$ORDER(^DIC(19,"AD",DA,%))
if %'>0
QUIT
SET ^DIC(19,%,99)=%H
IF '$DATA(^DIC(19,%,0))
KILL ^DIC(19,%),^DIC(19,"AD",DA,%)
+3 FOR %=0:0
SET %=$ORDER(^VA(200,"AD",DA,%))
if %'>0
QUIT
SET ^VA(200,%,203.1)=%H
+4 ;
FLAG ;
+1 SET ^DIC(19,"AT",$$NOW^XLFDT(),XQFLAG)=""
+2 KILL %,%H,XQFLAG
+3 QUIT
+4 ;
REDOX ;
+1 SET %H=$HOROLOG
SET ^DIC(19,DA(1),99)=%H
+2 FOR %=0:0
SET %=$ORDER(^VA(200,"AD",DA(1),%))
if %'>0
QUIT
SET ^VA(200,%,203.1)=%H
+3 QUIT
+4 ;
REDOXI ; Insertion of an item on a menu
+1 DO REDOX
+2 SET XQFLAG=DA(1)_"I"_X
GOTO FLAG
+3 ;
REDOXD ; Deletion of an item from a menu
+1 DO REDOX
+2 SET XQFLAG=DA(1)_"D"_X
GOTO FLAG
+3 ;
REDOXS ; Change or addition of a synonym
+1 DO REDOX
+2 SET XQFLAG=DA(1)_"S"_(+^DIC(19,DA(1),10,DA,0))
GOTO FLAG
+3 ;
REDOXZ ; Change in display order, does not affect trees
+1 DO REDOX
KILL %,%H
+2 QUIT
REDOXP ; Check for new primary menu added to user file
+1 if $DATA(^XUTL("XQO","P"_X))
QUIT
+2 SET XQFLAG=X_"P"_X
GOTO FLAG
+3 ;
CK ;Called from several places in ^DD(19,
+1 IF $DATA(DIFROM)
QUIT
+2 SET %=$PIECE(^DIC(19,D0,0),U,6)
SET %Y=$PIECE(^DIC(19,D0,0),U,1)
IF $SELECT($LENGTH(%):$DATA(^XUSEC(%,DUZ)),1:1)
+3 if '$TEST
QUIT
+4 IF DUZ(0)="@"!$DATA(^XUSEC("XUMGR",DUZ))!$DATA(^VA(200,DUZ,19.5,Y,0))
+5 if '$TEST
QUIT
CK1 SET %=$PIECE(^DIC(19,D0,0),U,4)
SET %Y=$PIECE(^DIC(19,Y,0),U,4)
IF $SELECT((%'="O"&(%'="Q"))&(%Y'="Q"):1,(%="O"&(%Y="O")):1,(%="Q"&((%Y="O")!(%Y="Q"))):1,1:0)
+1 QUIT
DEV ;See if device is legit for this option. Called by CHK1+5^XQ71.
+1 SET (%,XQSJ)=0
if '$DATA(^DIC(19,+XQW,3.96,0))
QUIT
+2 FOR XQSL=1:1
SET %=$ORDER(^DIC(19,+XQW,3.96,%))
if %=""!(%'=+%)
QUIT
if XQSIO=^(%,0)
SET XQSJ=1
+3 QUIT
UP ;F XQSA=1:1 Q:X?.NUP S %=$A(X,XQSA) I %<123,%>96 S X=$E(X,1,XQSA-1)_$C(%-32)_$E(X,XQSA+1,255)
SET X=$$UP^XLFSTR(X)
+1 QUIT
+2 ;
KICK ;Kick off microsurgery here and all compute servers
+1 DO CHEK^XQ83
+2 if '$DATA(^%ZIS(14.5))
QUIT
+3 NEW XQ,XQVOL,XQTIM,ZTCPU
+4 SET XQTIM=$PIECE($HOROLOG,",")-1_","_$PIECE($HOROLOG,",",2)
+5 SET XQ=0
FOR
SET XQ=$ORDER(^%ZIS(14.5,XQ))
if XQ=""!(XQ'=+XQ)
QUIT
IF $PIECE(^(XQ,0),U,11)
Begin DoDot:1
+6 SET ZTCPU=$PIECE(^%ZIS(14.5,XQ,0),U)
DO CHEK^XQ83
End DoDot:1
+7 QUIT
