Routine: XQSMD31

XQSMD31 ;SEA/MJM - Secure Menu Delegation (Cont.) ;01/19/2006

 ;;8.0;KERNEL;**372**;Jul 10, 1995;Build 5

 ;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

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

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

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

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

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)

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

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

XQSMD31   ;SEA/MJM - Secure Menu Delegation (Cont.) ;01/19/2006

 +1       ;;8.0;KERNEL;**372**;Jul 10, 1995;Build 5

 +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

XQSMD31.m