XQSMD31 ;SEA/MJM - Secure Menu Delegation (Cont.) ;01/19/2006
;;8.0;KERNEL;**372**;Jul 10, 1995;Build 3
;Continued from XQSMD3
DOIT ;Set up the parameters for a calls to %XY^%RCR and XQSMD2
S %X=XQPERX
S %Y="^TMP($J,""OP""," D %XY^%RCR K ^TMP($J,"OP",0),^("B") S DIC=19,DIC(0)="MNF"
S XQN="" F XQI=0:0 S XQN=$O(^TMP($J,"OP",XQN)) Q:XQN="" S X=+XQN D ^DIC I +Y>0 S ^TMP($J,"OP",+Y)="",^TMP($J,"ZN",$P(^DIC(19,+Y,0),U,1))=$P(^(0),U,2,99) K ^TMP($J,"OP",+XQN,0)
;
KILL ;Delete the delegated options of XQU1 and clean up.
I XQDEL S DA(1)=XQU1Y,DA="",ZTRTN="DEL^XQSMD31",ZTSAVE("DA(")="",ZTIO="",ZTDTH=$H,ZTDESC="Delete delegated option set for "_XQU1 D ^%ZTLOAD S XQDEL=0
K %X,%Y,DIC,XQPERX,XQU1,XQU1Y,XQU2,ZTSK
;
G BUILD^XQSMD2
;
DEL ;Taskman entry for killing off delegated option sets
S DIK="^VA(200,"_DA(1)_",19.5,",DA=0
F XQI=0:0 S DA=$O(^VA(200,DA(1),19.5,DA)) Q:DA="" D ^DIK
K DIK,DA
Q
;
DELM ;Taskman entry for deleting option sets from multiple users.
S DA(1)=0 F XQJ=0:0 S DA(1)=$O(XQHOLD(DA(1))) Q:DA(1)="" S DIK="^VA(200,"_DA(1)_",19.5,",DA=0 F XQI=0:0 S DA=$O(^VA(200,DA(1),19.5,DA)) Q:DA="" D ^DIK
Q
;
ZTSK ;Taskman entry for adding and deleting delegated options (XQSMD2)
S XQLEV=XQLEV+1,DR="19////"_DUZ_";19.2///"_XQLEV,DIE=200,XQM=0
F XQJ=1:1 S XQM=$O(XQHOLD(XQM)) Q:XQM="" S DA=XQM D:$D(^VA(200,DA,19))[0!($O(^(19.5,0))="") ^DIE D @$S(XQDOP:"REM",1:"ADD")
D GIVOPT ; Give USER MENU OPTION as a secondary option if the user doesn't already have it.
K DIE,DR,DA,XQLEV,XQM,XQDOP,XQJ,XQK,XQN,XQPRO,XQUF,XQHOLD,ZTSK
Q
;
ADD ;Add options that have been delegated to this user.
S DA(1)=XQM,DIC="^VA(200,"_DA(1)_",19.5,",DIC(0)="NFL",DLAYGO=200,XQN="",XQUF=0 I '$D(^VA(200,XQM,19.5,0)) S ^(0)="^200.19P^^"
F XQK=0:0 S XQN=$O(^TMP($J,"OP",XQN)) Q:XQN="" D:'XQPRO CHCK I 'XQUF S (X,DINUM)=XQN D:$D(^VA(200,DA(1),19.5,X,0))[0 FILE^DICN S XQUF=0
Q
;
REM ;Remove delegated options from this delegate.
S DA(1)=XQM,DIK="^VA(200,"_DA(1)_",19.5,",XQN="",XQUF=0 F XQL=0:0 S XQN=$O(^TMP($J,"OP",XQN)) Q:XQN="" D:'XQPRO CHCK I 'XQUF S DA=XQN D:$D(^VA(200,DA(1),19.5,DA,0)) ^DIK S XQUF=0
Q
;
CHCK ;See if this person has this option before delegating it.
S:'$D(^VA(200,DUZ,19.5,XQN,0))#2 XQUF=1 I XQUF S XQON=^DIC(19,XQN,0)
Q
;
GIVOPT ; GIVE USER MENU SO HE CAN USE THE DELEGATED CAPABILITY
;
S X="XQSMD USER MENU",DIC=19,DIC(0)="MX" D ^DIC Q:Y'>0
S XQSMDX=$P(Y,U,2),DA(1)=0 F I=1:1 S DA(1)=$O(XQHOLD(DA(1))) Q:DA(1)="" S X=XQSMDX,DIC="^VA(200,"_DA(1)_",203,",P=3.03,DIC(0)="ML",DLAYGO=200 S:'$D(@(DIC_"0)")) @(DIC_"0)")="^200.03P" D ^DIC
K XQSMDX
Q
;
OUT K DIC,DIK,DA,DISYS,DINUM,POP,XQ,XQD,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQT,XQON,XQON0,XQAL,XQDATE,XQDEL,XQDT,XQLEV,XQLK,XQMG,XQMGR,XQNAM,XQNGO,XQUF,XQPRO,XQSTART,XQEND,XQHOLD,XQKEY,X,Y,XY,%,^TMP($J),C,XQU1L
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSMD31 2854 printed Apr 09, 2024@21:18:38 Page 2
XQSMD31 ;SEA/MJM - Secure Menu Delegation (Cont.) ;01/19/2006
+1 ;;8.0;KERNEL;**372**;Jul 10, 1995;Build 3
+2 ;Continued from XQSMD3
DOIT ;Set up the parameters for a calls to %XY^%RCR and XQSMD2
+1 SET %X=XQPERX
+2 SET %Y="^TMP($J,""OP"","
DO %XY^%RCR
KILL ^TMP($JOB,"OP",0),^("B")
SET DIC=19
SET DIC(0)="MNF"
+3 SET XQN=""
FOR XQI=0:0
SET XQN=$ORDER(^TMP($JOB,"OP",XQN))
if XQN=""
QUIT
SET X=+XQN
DO ^DIC
IF +Y>0
SET ^TMP($JOB,"OP",+Y)=""
SET ^TMP($JOB,"ZN",$PIECE(^DIC(19,+Y,0),U,1))=$PIECE(^(0),U,2,99)
KILL ^TMP($JOB,"OP",+XQN,0)
+4 ;
KILL ;Delete the delegated options of XQU1 and clean up.
+1 IF XQDEL
SET DA(1)=XQU1Y
SET DA=""
SET ZTRTN="DEL^XQSMD31"
SET ZTSAVE("DA(")=""
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="Delete delegated option set for "_XQU1
DO ^%ZTLOAD
SET XQDEL=0
+2 KILL %X,%Y,DIC,XQPERX,XQU1,XQU1Y,XQU2,ZTSK
+3 ;
+4 GOTO BUILD^XQSMD2
+5 ;
DEL ;Taskman entry for killing off delegated option sets
+1 SET DIK="^VA(200,"_DA(1)_",19.5,"
SET DA=0
+2 FOR XQI=0:0
SET DA=$ORDER(^VA(200,DA(1),19.5,DA))
if DA=""
QUIT
DO ^DIK
+3 KILL DIK,DA
+4 QUIT
+5 ;
DELM ;Taskman entry for deleting option sets from multiple users.
+1 SET DA(1)=0
FOR XQJ=0:0
SET DA(1)=$ORDER(XQHOLD(DA(1)))
if DA(1)=""
QUIT
SET DIK="^VA(200,"_DA(1)_",19.5,"
SET DA=0
FOR XQI=0:0
SET DA=$ORDER(^VA(200,DA(1),19.5,DA))
if DA=""
QUIT
DO ^DIK
+2 QUIT
+3 ;
ZTSK ;Taskman entry for adding and deleting delegated options (XQSMD2)
+1 SET XQLEV=XQLEV+1
SET DR="19////"_DUZ_";19.2///"_XQLEV
SET DIE=200
SET XQM=0
+2 FOR XQJ=1:1
SET XQM=$ORDER(XQHOLD(XQM))
if XQM=""
QUIT
SET DA=XQM
if $DATA(^VA(200,DA,19))[0!($ORDER(^(19.5,0))="")
DO ^DIE
DO @$SELECT(XQDOP:"REM",1:"ADD")
+3 ; Give USER MENU OPTION as a secondary option if the user doesn't already have it.
DO GIVOPT
+4 KILL DIE,DR,DA,XQLEV,XQM,XQDOP,XQJ,XQK,XQN,XQPRO,XQUF,XQHOLD,ZTSK
+5 QUIT
+6 ;
ADD ;Add options that have been delegated to this user.
+1 SET DA(1)=XQM
SET DIC="^VA(200,"_DA(1)_",19.5,"
SET DIC(0)="NFL"
SET DLAYGO=200
SET XQN=""
SET XQUF=0
IF '$DATA(^VA(200,XQM,19.5,0))
SET ^(0)="^200.19P^^"
+2 FOR XQK=0:0
SET XQN=$ORDER(^TMP($JOB,"OP",XQN))
if XQN=""
QUIT
if 'XQPRO
DO CHCK
IF 'XQUF
SET (X,DINUM)=XQN
if $DATA(^VA(200,DA(1),19.5,X,0))[0
DO FILE^DICN
SET XQUF=0
+3 QUIT
+4 ;
REM ;Remove delegated options from this delegate.
+1 SET DA(1)=XQM
SET DIK="^VA(200,"_DA(1)_",19.5,"
SET XQN=""
SET XQUF=0
FOR XQL=0:0
SET XQN=$ORDER(^TMP($JOB,"OP",XQN))
if XQN=""
QUIT
if 'XQPRO
DO CHCK
IF 'XQUF
SET DA=XQN
if $DATA(^VA(200,DA(1),19.5,DA,0))
DO ^DIK
SET XQUF=0
+2 QUIT
+3 ;
CHCK ;See if this person has this option before delegating it.
+1 if '$DATA(^VA(200,DUZ,19.5,XQN,0))#2
SET XQUF=1
IF XQUF
SET XQON=^DIC(19,XQN,0)
+2 QUIT
+3 ;
GIVOPT ; GIVE USER MENU SO HE CAN USE THE DELEGATED CAPABILITY
+1 ;
+2 SET X="XQSMD USER MENU"
SET DIC=19
SET DIC(0)="MX"
DO ^DIC
if Y'>0
QUIT
+3 SET XQSMDX=$PIECE(Y,U,2)
SET DA(1)=0
FOR I=1:1
SET DA(1)=$ORDER(XQHOLD(DA(1)))
if DA(1)=""
QUIT
SET X=XQSMDX
SET DIC="^VA(200,"_DA(1)_",203,"
SET P=3.03
SET DIC(0)="ML"
SET DLAYGO=200
if '$DATA(@(DIC_"0)"))
SET @(DIC_"0)")="^200.03P"
DO ^DIC
+4 KILL XQSMDX
+5 QUIT
+6 ;
OUT KILL DIC,DIK,DA,DISYS,DINUM,POP,XQ,XQD,XQH,XQI,XQJ,XQK,XQL,XQM,XQN,XQT,XQON,XQON0,XQAL,XQDATE,XQDEL,XQDT,XQLEV,XQLK,XQMG,XQMGR,XQNAM,XQNGO,XQUF,XQPRO,XQSTART,XQEND,XQHOLD,XQKEY,X,Y,XY,%,^TMP($JOB),C,XQU1L
+1 QUIT
