XQSMD21 ; SEA/MJM,JLI - Secure Menu delegation (Part IV) ;11/20/91 10:33 ;5/15/91 3:01 PM
;;8.0;KERNEL;;Jul 10, 1995
Q
;
KEYS ;Allocate or remove keys needed for these options.
W !!,"Some of these options are locked. Do you want to ",$S(XQDOP:"remove ",1:"issue "),"keys now? Y/N " R XQ:DTIME S:'$T XQ=U G:XQ[U OUT Q:XQ["N"!(XQ["n")
S XQH="XQSMD-KEYS" D:XQ["?" EN^XQH I '(XQ["Y"!(XQ["y")) W *7,!,"Enter 'Y' or 'N'" G KEYS
S XQAL=$S(XQDOP:0,1:1),XQDA=0 D OK^XQ6A ;Do the bulk key distribution software
Q
;
SHOW ;Show a user's delegated options
S U="^" I $S('$D(IOM):1,IOM=0:1,'$D(IOSL):1,'$L(IOSL):1,'$D(IOF):1,'$L(IOF):1,1:0) S IOP="HOME" D ^%ZIS I POP W !!,"**** DEVICE ERROR ****",!,"IOM, IOSL, or IOF not set properly",!,"Delegation software exiting." K POP G OUT
S DIC=200,DIC(0)="AEMQZ" D ^DIC Q:Y<0 S XQ=+Y I '$D(^VA(200,XQ,19))!('$D(^(19.5,0))) W !!,Y(0,0)," has no delegated options." K DIC,XQ Q
S XQM=^VA(200,XQ,19),XQD=$P(XQM,U,2),XQL=$P(XQM,U,3),XQM=+XQM,%=XQD,XQD=$S($E(%,4)=0:$E(%,5),1:$E(%,4,5))_"/"_$S($E(%,6)=0:$E(%,7),1:$E(%,6,7))_"/"_$E(%,2,3) K %
S XQNM=$S(XQM=+XQM&(XQM>0):$P(^VA(200,XQM,0),U,1),1:"person unknown")
W @(IOF),!!,Y(0,0)," a delegate of: ",XQNM," on ",XQD," at level ",XQL
S XQN=0 F XQI=1:1 S XQN=$O(^VA(200,XQ,19.5,"B",XQN)) Q:XQN="" I $D(^DIC(19,XQN,0)) S XQ0=^(0),^TMP($J,"XQSMD",$P(XQ0,U,1))=$P(XQ0,U,2)_U_^VA(200,XQ,19.5,XQN,0)
W !!,"OPTION (INTERNAL #)",?25,"MENU TEXT",?65,"DELEGATED (DUZ)",!
S XQN=0,XQ=""
F XQI=1:1 D:$Y+2>IOSL WAIT Q:XQ=U S XQN=$O(^TMP($J,"XQSMD",XQN)) Q:XQN="" S XQ0=^(XQN),%=$P(XQ0,U,4),XQD=$E(%,4,5)_"/"_$E(%,6,7)_"/"_$E(%,2,3) W !,$E(XQN,1,27)," (",$P(XQ0,U,2),")",?25,$P(XQ0,U,1),?65,XQD," (",$P(XQ0,U,3),")"
G OUT
;
WAIT ;Skip to top of next page
I 1 S XQ="" R:IOST["C-" !?26,"Press RETURN to continue, '^' to halt...",XQ:DTIME S:'$T XQ=U W @IOF
Q
;
OUT K C,DIC,DIK,DA,DISYS,DINUM,POP,XQ,XQD,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQNM,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)
K IOP,XQ0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSMD21 2096 printed Dec 13, 2024@02:06:31 Page 2
XQSMD21 ; SEA/MJM,JLI - Secure Menu delegation (Part IV) ;11/20/91 10:33 ;5/15/91 3:01 PM
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 QUIT
+3 ;
KEYS ;Allocate or remove keys needed for these options.
+1 WRITE !!,"Some of these options are locked. Do you want to ",$SELECT(XQDOP:"remove ",1:"issue "),"keys now? Y/N "
READ XQ:DTIME
if '$TEST
SET XQ=U
if XQ[U
GOTO OUT
if XQ["N"!(XQ["n")
QUIT
+2 SET XQH="XQSMD-KEYS"
if XQ["?"
DO EN^XQH
IF '(XQ["Y"!(XQ["y"))
WRITE *7,!,"Enter 'Y' or 'N'"
GOTO KEYS
+3 ;Do the bulk key distribution software
SET XQAL=$SELECT(XQDOP:0,1:1)
SET XQDA=0
DO OK^XQ6A
+4 QUIT
+5 ;
SHOW ;Show a user's delegated options
+1 SET U="^"
IF $SELECT('$DATA(IOM):1,IOM=0:1,'$DATA(IOSL):1,'$LENGTH(IOSL):1,'$DATA(IOF):1,'$LENGTH(IOF):1,1:0)
SET IOP="HOME"
DO ^%ZIS
IF POP
WRITE !!,"**** DEVICE ERROR ****",!,"IOM, IOSL, or IOF not set properly",!,"Delegation software exiting."
KILL POP
GOTO OUT
+2 SET DIC=200
SET DIC(0)="AEMQZ"
DO ^DIC
if Y<0
QUIT
SET XQ=+Y
IF '$DATA(^VA(200,XQ,19))!('$DATA(^(19.5,0)))
WRITE !!,Y(0,0)," has no delegated options."
KILL DIC,XQ
QUIT
+3 SET XQM=^VA(200,XQ,19)
SET XQD=$PIECE(XQM,U,2)
SET XQL=$PIECE(XQM,U,3)
SET XQM=+XQM
SET %=XQD
SET XQD=$SELECT($EXTRACT(%,4)=0:$EXTRACT(%,5),1:$EXTRACT(%,4,5))_"/"_$SELECT($EXTRACT(%,6)=0:$EXTRACT(%,7),1:$EXTRACT(%,6,7))_"/"_$EXTRACT(%,2,3)
KILL %
+4 SET XQNM=$SELECT(XQM=+XQM&(XQM>0):$PIECE(^VA(200,XQM,0),U,1),1:"person unknown")
+5 WRITE @(IOF),!!,Y(0,0)," a delegate of: ",XQNM," on ",XQD," at level ",XQL
+6 SET XQN=0
FOR XQI=1:1
SET XQN=$ORDER(^VA(200,XQ,19.5,"B",XQN))
if XQN=""
QUIT
IF $DATA(^DIC(19,XQN,0))
SET XQ0=^(0)
SET ^TMP($JOB,"XQSMD",$PIECE(XQ0,U,1))=$PIECE(XQ0,U,2)_U_^VA(200,XQ,19.5,XQN,0)
+7 WRITE !!,"OPTION (INTERNAL #)",?25,"MENU TEXT",?65,"DELEGATED (DUZ)",!
+8 SET XQN=0
SET XQ=""
+9 FOR XQI=1:1
if $Y+2>IOSL
DO WAIT
if XQ=U
QUIT
SET XQN=$ORDER(^TMP($JOB,"XQSMD",XQN))
if XQN=""
QUIT
SET XQ0=^(XQN)
SET %=$PIECE(XQ0,U,4)
SET XQD=$EXTRACT(%,4,5)_"/"_$EXTRACT(%,6,7)_"/"_$EXTRACT(%,2,3)
WRITE !,$EXTRACT(XQN,1,27)," (",$PIECE(XQ0,U,2),")",?25,$PIECE(XQ0,U,1),?65,XQD," (",$PIECE(XQ0,U,3),")"
+10 GOTO OUT
+11 ;
WAIT ;Skip to top of next page
+1 IF 1
SET XQ=""
if IOST["C-"
READ !?26,"Press RETURN to continue, '^' to halt...",XQ:DTIME
if '$TEST
SET XQ=U
WRITE @IOF
+2 QUIT
+3 ;
OUT KILL C,DIC,DIK,DA,DISYS,DINUM,POP,XQ,XQD,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQNM,XQT,XQON,XQON0,XQAL,XQDATE,XQDEL,XQDT,XQDUZ,XQLEV,XQLK,XQMG,XQMGR,XQNAM,XQNGO,XQUF,XQPRO,XQSTART,XQEND,XQHOLD,XQKEY,X,Y,XY,%,^TMP($JOB)
+1 KILL IOP,XQ0
+2 QUIT
