- XQ7 ;SF-ISC..SEA/JLI - MICROSURGERY OF XUTL MENU TREES ;01/09/2001 13:29 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XQ7 ;SF-ISC..SEA/JLI - MICROSURGERY OF XUTL MENU TREES ;01/09/2001 13:29 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;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
