| 1 | XQSMD3 ; SEA/MJM - Secure MenuMan Delegation utilities; 5/3/88 3:34 PM ;06/01/95 12:03
|
|---|
| 2 | ;;8.0;KERNEL;**64**;Jul 10, 1995
|
|---|
| 3 | INIT S U="^",XQNGO=1,XQLEV="" S (XQDOP,XQDEL,XQPRO)=0 S:DUZ(0)="@"!($D(^XUSEC("XUMGR",DUZ))) XQPRO=1
|
|---|
| 4 | I $S('$D(IOM):1,IOM=0:1,'$D(IOSL):1,'$L(IOSL):1,'$D(IOF):1,'$L(IOF):1,'$D(IO):1,1:0) S IOP="HOME" D ^%ZIS I POP W !!,"*** DEVICE ERROR ***",!,?5,"-exiting-" G OUT
|
|---|
| 5 | S:'$D(DTIME)#2 DTIME=60
|
|---|
| 6 | S %DT="",X="T" D ^%DT S XQDT=Y X ^DD("DD") S XQDATE=Y K %DT
|
|---|
| 7 | S DIC=200,DIC(0)="FMNZ",X="`"_DUZ D ^DIC K DIC G:+Y<0 OUT S XQMGR=$P(Y(0,0),",",2)_" "_$P(Y(0,0),",",1)
|
|---|
| 8 | S:XQPRO XQLEV=0 S:'$L(XQLEV)&($D(^VA(200,DUZ,19))#2) XQLEV=$P(^(19),U,3) W:'$L(XQLEV) !,"Level problem. No action permitted." G:'$L(XQLEV) OUT
|
|---|
| 9 | ;
|
|---|
| 10 | USER1 ;Find the user who's delegated options will be transfered.
|
|---|
| 11 | R !!,"Please enter the user currently holding the options :",XQ:DTIME S:'$T XQ=U G:XQ=U OUT I '$L(XQ)!(XQ="?") W !!,"Enter delegate's name,'^' to quit,'??' for User list, or '???' for help.",! G USER1
|
|---|
| 12 | I XQ="??" S X="?",DIC=200,DIC(0)="Q" D ^DIC K DIC G USER1
|
|---|
| 13 | I XQ="???" S XQH="XQSMD-REPLICATE" D EN^XQH G USER1
|
|---|
| 14 | S X=XQ,DIC(0)="QMENZ",DIC=200 D ^DIC I +Y<1 W !!,"Not a know user. Try again or enter a '^' to quit." G USER1
|
|---|
| 15 | I '$D(^VA(200,+Y,19.5,0))!($O(^(0))="") W !!,Y(0,0)," has not been delegated any menu options to transfer." G USER1
|
|---|
| 16 | S XQPERX="^VA(200,"_+Y_",19.5,",XQU1=$P(Y(0,0),",",2)_" "_$P(Y(0,0),",",1),XQU1Y=+Y
|
|---|
| 17 | S XQU1L=$P(^VA(200,+XQU1Y,19),U,3) I XQLEV>XQU1L W !!,"You may not, in this case, remove the options of ",XQU1 S XQDEL=0 G USER2
|
|---|
| 18 | ;
|
|---|
| 19 | RPLC W !!,"Should ALL delegated options be removed from ",XQU1,!," after they have been transferred? N// " R XQ:DTIME S:'$T XQ=U G:XQ=U OUT S:'$L(XQ) XQ="N" I XQ="?" W !!,"Please enter 'Y' or 'N', '^' to quit, or '??' for help.",! G RPLC
|
|---|
| 20 | I XQ="??" S XQH="XQSMD-REMOVE" D EN^XQH G RPLC
|
|---|
| 21 | I "YyNn"'[XQ W !,"Please answer 'Y' or 'N' " G RPLC
|
|---|
| 22 | S:XQ["Y"!(XQ["y") XQDEL=1
|
|---|
| 23 | ;
|
|---|
| 24 | USER2 ;Get the name of the person to whom these options will be transfered
|
|---|
| 25 | W !!,"Please enter the user who will get the same options as ",XQU1,!," now has: " R XQ:DTIME S:'$T XQ=U G:XQ=U OUT I XQ="?"!('$L(XQ)) W !!,"Enter User's name,'^' to quit,'??' for User list, or '???'for help.",! G USER2
|
|---|
| 26 | I XQ="??" S DIC=200,X="?",DIC(0)="Q" D ^DIC K DIC G USER2
|
|---|
| 27 | I XQ="???" S XQH="XQSMD-REPLACEMENT" D EN^XQH G USER2
|
|---|
| 28 | S X=XQ,DIC=200,DIC(0)="EFMQZ" D ^DIC I +Y<1 W !!,"Sorry, this person is not in the User File. Try again or enter '^' to quit." G USER2
|
|---|
| 29 | I $D(^VA(200,+Y,0)),'$L($P(^(.1),U,2)) W !!,"Sorry, this person is not a current user. Try again or enter '^' to quit." G USER2
|
|---|
| 30 | S XQHOLD(+Y)=Y(0,0),XQU2=$P(Y(0,0),",",2)_" "_$P(Y(0,0),",",1)
|
|---|
| 31 | I +XQU1Y=+Y W !!,"Sorry, this is illogical: it's the same person!" G USER2
|
|---|
| 32 | I +Y=+DUZ W !!,"Sorry, you can't be your own delegate." G OUT
|
|---|
| 33 | ;
|
|---|
| 34 | ASK ;See if we all understand eachother.
|
|---|
| 35 | W !!!,"You want to assign the options currently held by ",XQU1,!,?5,"to ",XQU2
|
|---|
| 36 | W:XQDEL " and remove them from ",XQU1
|
|---|
| 37 | W !!,"Is this correct? Y/N " R XQ:DTIME S:'$T XQ=U G:XQ=U OUT G:XQ["N"!(XQ["n") INIT S XQH="XQSMD-OK" I XQ["?" D EN^XQH G ASK
|
|---|
| 38 | I XQ'["Y"&(XQ'["y") W !!,*7,"Please answer 'Y' or 'N'." G ASK
|
|---|
| 39 | I XQDEL W !!,"Request to remove delegated options from ",XQU1," will be queued. "
|
|---|
| 40 | ;
|
|---|
| 41 | G ^XQSMD31
|
|---|
| 42 | ;
|
|---|
| 43 | OUT K DIC,DIK,DA,DISYS,DINUM,POP,XQ,XQD,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQT,XQON,XQON0,XQAL,XQDATE,XQDEL,XQDT,XQDUZ,XQLEV,XQLK,XQMG,XQMGR,XQNAM,XQNGO,XQUF,XQPRO,XQSTART,XQEND,XQHOLD,XQKEY,X,Y,XY,%,^TMP($J),XQDOP,C
|
|---|
| 44 | Q
|
|---|
