XQSMD1.m

XQSMD1 ; SEA/MJM - Secure MenuMan Delegation (cont.); 5/18/88  2:16 PM ;05/08/96  10:45 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**29**;Jul 10, 1995

 ;

 S XQK=0

GETOP ;Get options to add to (or remove from XQDOP) users.

 W !!,"Enter options you wish to ",$S(XQDOP:"REMOVE FROM",1:"DELEGATE TO")," these users"

ASK W !!,$S(XQDOP:"Remove",1:"Add")," option(s): " R XQ:DTIME S:'$T XQ=U G:XQ=U OUT G:XQ="" ^XQSMD2 I XQ="?" W !!,"Enter an option name, an option preceded by a minus, '^' to quit, or '??' for help." G ASK

 I XQ["??" S XQH="XQSMD-OPTION" D:XQ="??" EN^XQH D:XQ="???" LIST D:XQ="????" LSTFIL S XQH="XQSMD-MAIN" D:XQ="?????" EN^XQH G ASK

 S XQDEL=0 I $E(XQ,1)="-" S XQDEL=1,XQ=$E(XQ,2,99)

 I XQ="*",XQDOP G REMOV

 I XQ="*",'XQDEL S XQSTART=1,XQEND="ZZZZZ" D FIND G ASK

 I XQ="*",XQDEL K ^TMP($J,"OP"),^TMP($J,"ZN") W !," All options removed.  Start again or '^' to quit. " G ASK

 I XQ?.E1"*" S XQSTART=$E(XQ,1,$L(XQ)-1),XQEND=XQSTART_$C(127) D FIND G ASK

 ;

 ;Get a range of options allowing for name with hyphens in them

 I XQ?1E.E1"-"1E.E S XQRNG=0 D  G:'XQRNG ASK

 .S X=XQ,DIC=19,DIC(0)="MEZ" D ^DIC S:Y'<0 XQ=$P(Y,U,2) I Y>0 S XQRNG=1 Q

 .W ! S DIR("A")="Do mean the options from "_$P(XQ,"-")_" to "_$P(XQ,"-",2)_"?	(Y/N)",DIR("B")="YES",DIR(0)="Y" D ^DIR I Y S (XQN,XQSTART)=$P(XQ,"-",1),XQEND=$P(XQ,"-",2) D FIND

  .Q

  ;

  I XQ'?1E.E1"-"1E.E S X=XQ,DIC=19,DIC(0)="MEZ" D ^DIC S:Y'<0 XQ=$P(Y,U,2) I Y<0 W !," ??",*7 G ASK

 ;I XQ?1E.E1"-"1E.E W !?10,"Do mean the options from ",$P(XQ,"-")," to ",$P(XQ,"-",2) S DIR(0)="Y" D ^DIR I Y S XQSTART=$P(XQ,"-",1),XQEND=$P(XQ,"-",2) D FIND G ASK

 S X=XQ,DIC=19,DIC(0)="MEZ" D ^DIC S:Y'<0 XQ=$P(Y,U,2) I Y<0 W !," ??",*7 G ASK

 I 'XQDEL,$P(Y(0),U,13)["n" W !,*7,"This option is not delegable." G ASK

 I XQDEL K ^TMP($J,"OP",+Y),^TMP($J,"ZN",XQ) G ASK

 S ^TMP($J,"OP",+Y)="",^TMP($J,"ZN",XQ)=$P(Y(0),U,2,99) G ASK

 ;

FIND ;Find first routine in wildcard list

 S XQN="" S:$L(XQSTART)>2 XQN=$E(XQSTART,1,$L(XQSTART)-1) F XQI=0:0 S XQN=$O(^DIC(19,"B",XQN)) Q:XQN=""!($E(XQN,1,$L(XQSTART))=XQSTART)

 I XQN="" W !," No such options." G ASK

FINDR S XQSTART=XQN,XQON=$O(^DIC(19,"B",XQN,0)),XQON0=^DIC(19,+XQON,0)

 I XQDEL D DELET Q

 ;

GET ;Get the options selected and put them in ^UTILITY.

 S XQN=XQSTART S:$P(XQON0,U,13)'["n" ^TMP($J,"OP",+XQON)="",^TMP($J,"ZN",XQN)=$P(XQON0,U,2,99),XQK=XQK+1 S DIC=19,DIC(0)="MZ"

NEXT F XQI=0:0 Q:XQN=XQEND  S XQN=$O(^DIC(19,"B",XQN)) Q:XQN=""!(XQN]XQEND)  S XQON=$O(^DIC(19,"B",XQN,0)),XQON0=^DIC(19,+XQON,0) I $P(XQON0,U,13)'["n" S ^TMP($J,"OP",+XQON)="",^TMP($J,"ZN",XQN)=$P(XQON0,U,2,99),XQK=XQK+1

 Q

 ;

DELET S XQN=XQSTART,XQDEL=0 F XQI=0:0 K ^TMP($J,"OP",+XQON),^TMP($J,"ZN",XQN) S XQN=$O(^DIC(19,"B",XQN)),XQX=XQK-1 Q:XQN=""!(XQN]XQEND)  S XQON=$O(^DIC(19,"B",XQN,0))

 Q

 ;

REMOV R !!,"Remove all options previously delegated to all users in your list? ",XQ:DTIME S:'$T XQ=U G:XQ[U OUT I XQ["N"!(XQ["n") W !!,"OK, you may continue building a list of options to remove." G ASK

 I XQ'["Y"&(XQ'["y") W !!,"Please answer 'Y' or 'N'" G REMOV

 S ZTRTN="DELM^XQSMD31",ZTDTH=$H,ZTIO="",ZTDESC="Remove previously delegated options.",ZTSAVE("XQHOLD(")="" D ^%ZTLOAD

 W !!,"Your request has been queued, task # ",ZTSK G OUT

 Q

LSTFIL ;Show USER, OPTION, or user's delegated options in ^VA(200,DUZ,19.5)

 D LIST S X="?",DIC=$S(XQUF:3,XQPRO:19,1:"^VA(200,DUZ,19.5,"),DIC(0)="Q" D ^DIC K DIC

 Q

 ;

LIST ;List users and options selected so far.

 W @IOF S (XQT,XQM)=0,XQM=$O(XQHOLD(XQM)) I XQM="" W !!," No users selected yet." Q

 W !!,"For the following user(s):",!

 F XQI=1:1 W:'(XQT#2) ! W ?(XQT#2*35),XQI,". ",XQHOLD(XQM) S XQT=XQT+1,XQM=$O(XQHOLD(XQM)) Q:XQM=""

 W !!,"You will ",$S(XQDOP:"remove ",1:"delegate "),"the following options: ",!

 S XQT=0,XQN="",XQN=$O(^TMP($J,"ZN",XQN)) I XQN="" W !!,"No menu options selected yet" Q

 F XQI=0:0 D:$Y+3>IOSL WAIT Q:XQ=U  W !,XQN,"   ",$P(^TMP($J,"ZN",XQN),U,1) S XQN=$O(^(XQN)) Q:XQN=""

 W !!,$S(XQDOP:" Removed ",1:" Delegated "),"by ",XQMGR," on ",XQDATE,".",!

 Q

 ;

WAIT ;Skip to the head of the next page

 I 1 S XQ="" R:IOST["C-" !!,"Press RETURN to continue, or '^' to quit.",XQ:DTIME S:'$T XQ=U W @IOF

 Q

 ;

OUT K DIC,DIC(0),POP,XQ,XQAL,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQT,XQD,XQDATE,XQDEL,XQDUZ,XQDT,XQLEV,XQLK,XQMG,XQMGR,XQNM,XQNAM,XQUF,XQPRO,XQRNG,XQSTART,XQEND,XQHOLD,XQKEY,XQON,XQON0,X,Y,XY,%,^TMP($J),ZTSK

 Q

XQSMD1    ; SEA/MJM - Secure MenuMan Delegation (cont.); 5/18/88  2:16 PM ;05/08/96  10:45 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**29**;Jul 10, 1995

 +3       ;

 +4        SET XQK=0

GETOP     ;Get options to add to (or remove from XQDOP) users.

 +1        WRITE !!,"Enter options you wish to ",$SELECT(XQDOP:"REMOVE FROM",1:"DELEGATE TO")," these users"

ASK        WRITE !!,$SELECT(XQDOP:"Remove",1:"Add")," option(s): "

           READ XQ:DTIME

           IF '$TEST

               SET XQ=U

           IF XQ=U

               GOTO OUT

           IF XQ=""

               GOTO ^XQSMD2

           IF XQ="?"

               WRITE !!,"Enter an option name, an option preceded by a minus, '^' to quit, or '??' for help."

               GOTO ASK

 +1        IF XQ["??"

               SET XQH="XQSMD-OPTION"

               IF XQ="??"

                   DO EN^XQH

               IF XQ="???"

                   DO LIST

               IF XQ="????"

                   DO LSTFIL

               SET XQH="XQSMD-MAIN"

               IF XQ="?????"

                   DO EN^XQH

               GOTO ASK

 +2        SET XQDEL=0

           IF $EXTRACT(XQ,1)="-"

               SET XQDEL=1

               SET XQ=$EXTRACT(XQ,2,99)

 +3        IF XQ="*"

               IF XQDOP

                   GOTO REMOV

 +4        IF XQ="*"

               IF 'XQDEL

                   SET XQSTART=1

                   SET XQEND="ZZZZZ"

                   DO FIND

                   GOTO ASK

 +5        IF XQ="*"

               IF XQDEL

                   KILL ^TMP($JOB,"OP"),^TMP($JOB,"ZN")

                   WRITE !," All options removed.  Start again or '^' to quit. "

                   GOTO ASK

 +6        IF XQ?.E1"*"

               SET XQSTART=$EXTRACT(XQ,1,$LENGTH(XQ)-1)

               SET XQEND=XQSTART_$CHAR(127)

               DO FIND

               GOTO ASK

 +7       ;

 +8       ;Get a range of options allowing for name with hyphens in them

 +9        IF XQ?1E.E1"-"1E.E

               SET XQRNG=0

               Begin DoDot:1

 +10               SET X=XQ

                   SET DIC=19

                   SET DIC(0)="MEZ"

                   DO ^DIC

                   IF Y'<0

                       SET XQ=$PIECE(Y,U,2)

                   IF Y>0

                       SET XQRNG=1

                       QUIT 

 +11               WRITE !

                   SET DIR("A")="Do mean the options from "_$PIECE(XQ,"-")_" to "_$PIECE(XQ,"-",2)_"?	(Y/N)"

                   SET DIR("B")="YES"

                   SET DIR(0)="Y"

                   DO ^DIR

                   IF Y

                       SET (XQN,XQSTART)=$PIECE(XQ,"-",1)

                       SET XQEND=$PIECE(XQ,"-",2)

                       DO FIND

 +12               QUIT 

               End DoDot:1

               IF 'XQRNG

                   GOTO ASK

 +13      ;

 +14       IF XQ'?1E.E1"-"1E.E

               SET X=XQ

               SET DIC=19

               SET DIC(0)="MEZ"

               DO ^DIC

               IF Y'<0

                   SET XQ=$PIECE(Y,U,2)

               IF Y<0

                   WRITE !," ??",*7

                   GOTO ASK

 +15      ;I XQ?1E.E1"-"1E.E W !?10,"Do mean the options from ",$P(XQ,"-")," to ",$P(XQ,"-",2) S DIR(0)="Y" D ^DIR I Y S XQSTART=$P(XQ,"-",1),XQEND=$P(XQ,"-",2) D FIND G ASK

 +16       SET X=XQ

           SET DIC=19

           SET DIC(0)="MEZ"

           DO ^DIC

           IF Y'<0

               SET XQ=$PIECE(Y,U,2)

           IF Y<0

               WRITE !," ??",*7

               GOTO ASK

 +17       IF 'XQDEL

               IF $PIECE(Y(0),U,13)["n"

                   WRITE !,*7,"This option is not delegable."

                   GOTO ASK

 +18       IF XQDEL

               KILL ^TMP($JOB,"OP",+Y),^TMP($JOB,"ZN",XQ)

               GOTO ASK

 +19       SET ^TMP($JOB,"OP",+Y)=""

           SET ^TMP($JOB,"ZN",XQ)=$PIECE(Y(0),U,2,99)

           GOTO ASK

 +20      ;

FIND      ;Find first routine in wildcard list

 +1        SET XQN=""

           IF $LENGTH(XQSTART)>2

               SET XQN=$EXTRACT(XQSTART,1,$LENGTH(XQSTART)-1)

           FOR XQI=0:0

               SET XQN=$ORDER(^DIC(19,"B",XQN))

               IF XQN=""!($EXTRACT(XQN,1,$LENGTH(XQSTART))=XQSTART)

                   QUIT 

 +2        IF XQN=""

               WRITE !," No such options."

               GOTO ASK

FINDR      SET XQSTART=XQN

           SET XQON=$ORDER(^DIC(19,"B",XQN,0))

           SET XQON0=^DIC(19,+XQON,0)

 +1        IF XQDEL

               DO DELET

               QUIT 

 +2       ;

GET       ;Get the options selected and put them in ^UTILITY.

 +1        SET XQN=XQSTART

           IF $PIECE(XQON0,U,13)'["n"

               SET ^TMP($JOB,"OP",+XQON)=""

               SET ^TMP($JOB,"ZN",XQN)=$PIECE(XQON0,U,2,99)

               SET XQK=XQK+1

           SET DIC=19

           SET DIC(0)="MZ"

NEXT       FOR XQI=0:0

               IF XQN=XQEND

                   QUIT 

               SET XQN=$ORDER(^DIC(19,"B",XQN))

               IF XQN=""!(XQN]XQEND)

                   QUIT 

               SET XQON=$ORDER(^DIC(19,"B",XQN,0))

               SET XQON0=^DIC(19,+XQON,0)

               IF $PIECE(XQON0,U,13)'["n"

                   SET ^TMP($JOB,"OP",+XQON)=""

                   SET ^TMP($JOB,"ZN",XQN)=$PIECE(XQON0,U,2,99)

                   SET XQK=XQK+1

 +1        QUIT 

 +2       ;

DELET      SET XQN=XQSTART

           SET XQDEL=0

           FOR XQI=0:0

               KILL ^TMP($JOB,"OP",+XQON),^TMP($JOB,"ZN",XQN)

               SET XQN=$ORDER(^DIC(19,"B",XQN))

               SET XQX=XQK-1

               IF XQN=""!(XQN]XQEND)

                   QUIT 

               SET XQON=$ORDER(^DIC(19,"B",XQN,0))

 +1        QUIT 

 +2       ;

REMOV      READ !!,"Remove all options previously delegated to all users in your list? ",XQ:DTIME

           IF '$TEST

               SET XQ=U

           IF XQ[U

               GOTO OUT

           IF XQ["N"!(XQ["n")

               WRITE !!,"OK, you may continue building a list of options to remove."

               GOTO ASK

 +1        IF XQ'["Y"&(XQ'["y")

               WRITE !!,"Please answer 'Y' or 'N'"

               GOTO REMOV

 +2        SET ZTRTN="DELM^XQSMD31"

           SET ZTDTH=$HOROLOG

           SET ZTIO=""

           SET ZTDESC="Remove previously delegated options."

           SET ZTSAVE("XQHOLD(")=""

           DO ^%ZTLOAD

 +3        WRITE !!,"Your request has been queued, task # ",ZTSK

           GOTO OUT

 +4        QUIT 

LSTFIL    ;Show USER, OPTION, or user's delegated options in ^VA(200,DUZ,19.5)

 +1        DO LIST

           SET X="?"

           SET DIC=$SELECT(XQUF:3,XQPRO:19,1:"^VA(200,DUZ,19.5,")

           SET DIC(0)="Q"

           DO ^DIC

           KILL DIC

 +2        QUIT 

 +3       ;

LIST      ;List users and options selected so far.

 +1        WRITE @IOF

           SET (XQT,XQM)=0

           SET XQM=$ORDER(XQHOLD(XQM))

           IF XQM=""

               WRITE !!," No users selected yet."

               QUIT 

 +2        WRITE !!,"For the following user(s):",!

 +3        FOR XQI=1:1

               IF '(XQT#2)

                   WRITE !

               WRITE ?(XQT#2*35),XQI,". ",XQHOLD(XQM)

               SET XQT=XQT+1

               SET XQM=$ORDER(XQHOLD(XQM))

               IF XQM=""

                   QUIT 

 +4        WRITE !!,"You will ",$SELECT(XQDOP:"remove ",1:"delegate "),"the following options: ",!

 +5        SET XQT=0

           SET XQN=""

           SET XQN=$ORDER(^TMP($JOB,"ZN",XQN))

           IF XQN=""

               WRITE !!,"No menu options selected yet"

               QUIT 

 +6        FOR XQI=0:0

               IF $Y+3>IOSL

                   DO WAIT

               IF XQ=U

                   QUIT 

               WRITE !,XQN,"   ",$PIECE(^TMP($JOB,"ZN",XQN),U,1)

               SET XQN=$ORDER(^(XQN))

               IF XQN=""

                   QUIT 

 +7        WRITE !!,$SELECT(XQDOP:" Removed ",1:" Delegated "),"by ",XQMGR," on ",XQDATE,".",!

 +8        QUIT 

 +9       ;

WAIT      ;Skip to the head of the next page

 +1        IF 1

               SET XQ=""

               IF IOST["C-"

                   READ !!,"Press RETURN to continue, or '^' to quit.",XQ:DTIME

               IF '$TEST

                   SET XQ=U

               WRITE @IOF

 +2        QUIT 

 +3       ;

OUT        KILL DIC,DIC(0),POP,XQ,XQAL,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQT,XQD,XQDATE,XQDEL,XQDUZ,XQDT,XQLEV,XQLK,XQMG,XQMGR,XQNM,XQNAM,XQUF,XQPRO,XQRNG,XQSTART,XQEND,XQHOLD,XQKEY,XQON,XQON0,X,Y,XY,%,^TMP($JOB),ZTSK

 +1        QUIT