source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSMD1.m@ 1635

Last change on this file since 1635 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1XQSMD1 ; SEA/MJM - Secure MenuMan Delegation (cont.); 5/18/88 2:16 PM ;9/13/96 09:23
2 ;;8.0;KERNEL;**47**;Jul 10, 1995
3 ;
4 S XQK=0
5GETOP ;Get options to add to (or remove from XQDOP) users.
6 W !!,"Enter options you wish to ",$S(XQDOP:"REMOVE FROM",1:"DELEGATE TO")," these users"
7ASK 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
8 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
9 S XQDEL=0 I $E(XQ,1)="-" S XQDEL=1,XQ=$E(XQ,2,99)
10 I XQ="*",XQDOP G REMOV
11 I XQ="*",'XQDEL S XQSTART=1,XQEND="ZZZZZ" D FIND G ASK
12 I XQ="*",XQDEL K ^TMP($J,"OP"),^TMP($J,"ZN") W !," All options removed. Start again or '^' to quit. " G ASK
13 I XQ?.E1"*" S XQSTART=$E(XQ,1,$L(XQ)-1),XQEND=XQSTART_$C(127) D FIND G ASK
14 ;
15 ;Get a range of options allowing for name with hyphens in them
16 I XQ?1E.E1"-"1E.E S XQRNG=0 D G:'XQRNG ASK
17 .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
18 .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
19 .Q
20 ;
21 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
22 ;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
23 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
24 I 'XQDEL,$P(Y(0),U,13)["n" W !,*7,"This option is not delegable." G ASK
25 I XQDEL K ^TMP($J,"OP",+Y),^TMP($J,"ZN",XQ) G ASK
26 S ^TMP($J,"OP",+Y)="",^TMP($J,"ZN",XQ)=$P(Y(0),U,2,99) G ASK
27 ;
28FIND ;Find first routine in wildcard list
29 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)
30 I XQN="" W !," No such options." G ASK
31FINDR S XQSTART=XQN,XQON=$O(^DIC(19,"B",XQN,0)),XQON0=^DIC(19,+XQON,0)
32 I XQDEL D DELET Q
33 ;
34GET ;Get the options selected and put them in ^UTILITY.
35 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"
36NEXT 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
37 Q
38 ;
39DELET 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))
40 Q
41 ;
42REMOV 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
43 I XQ'["Y"&(XQ'["y") W !!,"Please answer 'Y' or 'N'" G REMOV
44 S ZTRTN="DELM^XQSMD31",ZTDTH=$H,ZTIO="",ZTDESC="Remove previously delegated options.",ZTSAVE("XQHOLD(")="" D ^%ZTLOAD
45 W !!,"Your request has been queued, task # ",ZTSK G OUT
46 Q
47LSTFIL ;Show USER, OPTION, or user's delegated options in ^VA(200,DUZ,19.5)
48 D LIST S X="?",DIC=$S(XQUF:3,XQPRO:19,1:"^VA(200,DUZ,19.5,"),DIC(0)="Q" D ^DIC K DIC
49 Q
50 ;
51LIST ;List users and options selected so far.
52 W @IOF S (XQT,XQM)=0,XQM=$O(XQHOLD(XQM)) I XQM="" W !!," No users selected yet." Q
53 W !!,"For the following user(s):",!
54 F XQI=1:1 W:'(XQT#2) ! W ?(XQT#2*35),XQI,". ",XQHOLD(XQM) S XQT=XQT+1,XQM=$O(XQHOLD(XQM)) Q:XQM=""
55 W !!,"You will ",$S(XQDOP:"remove ",1:"delegate "),"the following options: ",!
56 S XQT=0,XQN="",XQN=$O(^TMP($J,"ZN",XQN)) I XQN="" W !!,"No menu options selected yet" Q
57 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=""
58 W !!,$S(XQDOP:" Removed ",1:" Delegated "),"by ",XQMGR," on ",XQDATE,".",!
59 Q
60 ;
61WAIT ;Skip to the head of the next page
62 I 1 S XQ="" R:IOST["C-" !!,"Press RETURN to continue, or '^' to quit.",XQ:DTIME S:'$T XQ=U W @IOF
63 Q
64 ;
65OUT 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
66 Q
Note: See TracBrowser for help on using the repository browser.