XQSMD5.m

XQSMD5 ;SEA/JLI,MJM - SECURE MENU DELEGATE EDIT USER OPTIONS ;10/15/98  12:22 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**72,99**;Jul 10, 1995

 Q

 ;

ENTRY ; Main Entry point to edit primary (if applicable) and secondary options

 ;

 ;   check to see if you have options to delegate

 I $O(^VA(200,DUZ,19.5,0))'>0 W !,$C(7),"No Delegated Options Available to Give Out",! Q

 ;

 ;   get user to delegate options to

 S Y=$$LOOKUP^XUSER("QA") G:Y'>0 EXIT S (XQDA,DA)=+Y

 ;

 ;   check user's primary menu, if user has primary and it's not one

 ;   of the ones that you can delegate, goto secondary options,

 ;   otherwise fall through and edit primary options

 S XQPRI=$S($D(^VA(200,DA,201)):+^(201),1:0) I XQPRI,'$D(^VA(200,DUZ,19.5,XQPRI,0)) G SEC

 ;

 ;   either change primary option or leave as is and go to secondary

 K DIC

 S XQOLD=XQPRI,DIC="^VA(200,"_DUZ_",19.5,",DIC(0)="QMAE",DA(1)=DUZ,DIC("A")="     PRIMARY MENU OPTION: " S:XQPRI>0 DIC("B")=$P(^DIC(19,XQPRI,0),U,1) D ^DIC I +Y=XQOLD!(+Y'>0) G SEC

 ;

 ;   changing primary option

 S (X,XQPRI)=+Y,X=$P(^DIC(19,X,0),U,1),DIE="^VA(200,",DA=XQDA,DR="201///"_X_";" D ^DIE

 ;

 ;   delete old keys associated with old primary menu

 I XQOLD  D

 .S MENUOLD(0)=1,MENUOLD(1)=XQOLD,XQANS=""

 .D KEYS^XQSMD6(.MENUOLD,.XQKEY,.ABORT) K MENUOLD

 .I XQKEY(0)  D

 ..D ADJUST

 ..Q:'ONEGOOD

 ..M XQ2=XQKEY

 ..W !,"...Removing KEYS associated with previous PRIMARY menu"

 ..D KEYDEL

 ..Q

 K XQ2,XQKEY

 ;

 ;   add new keys associated with new primary menu if you have

 ;   been delegated those keys

 G:'$D(^VA(200,DUZ,52)) SEC

 S MENUPRI(0)=1,MENUPRI(1)=XQPRI

 D KEYS^XQSMD6(.MENUPRI,.XQKEY,.ABORT) K MENUPRI

 D:XQKEY(0) KEYADD

 K XQKEY

 ;

 ;   fall through to secondary options

 ;

SEC ; Enter Secondary Menu Options from delegated options

 K DIC

 W ! S DIC="^VA(200,"_DUZ_",19.5,",DIC(0)="QMAE",DA(1)=DUZ,DIC("A")="     SECONDARY MENU OPTION: " D ^DIC G:Y'>0 ENTRY

 S XQX=$P(Y,U,2)

 S:'$D(^VA(200,XQDA,203,0)) ^(0)="^200.03P" S (XQXNAME,X)=$P(^DIC(19,+Y,0),U,1),DIC="^VA(200,"_XQDA_",203,",DIC(0)="ML",DLAYGO=200,DA(1)=XQDA D ^DIC

 ;

 S XQADD=+$P(Y,U,3),XQSEC=+Y D KEY:XQADD,DEL:'XQADD K ^DIC(200,XQDA,203.1)

 G SEC

 ;

EXIT ;

 K D0,DA,DI,DIC,DIE,DR,DQ,I,J,ONEGOOD,P,X,XQ1,XQ2,XQ3,XQADD,XQANS,XQCOMMON,XQDA,XQJ,XQKEY,XQKEYIEN,XQOLD,XQPRI,XQSEC,XQX,XQXNAME,Y,Z

 Q

 ;

DEL ;   delete delegated menu

 W !,$C(7),"Want to Delete ",XQXNAME," as a Secondary Option? Y// "

 R Z:DTIME Q:'$T!(Z[U)  S:Z="" Z="Y" Q:"Yy"'[$E(Z)

 ;

 ;   check to see if users has any keys delegated

 G:'$D(^VA(200,DUZ,52,0)) MENUDEL

 ;

 ;   build list of users primary ans secondary menus

 S MENU1(0)=1,MENU1(1)=XQPRI,XQJ=""

 F  S XQJ=$O(^VA(200,XQDA,203,"B",XQJ)) Q:XQJ=""  D

 . Q:XQJ=XQX

 . S MENU1(0)=MENU1(0)+1,MENU1(MENU1(0))=XQJ

 . Q

 ;

 ;   get list of keys for primary and all secondary menus in XQ1

 D KEYS^XQSMD6(.MENU1,.XQ1,.ABORT) K MENU1

 ;

 ;   get list of keys for delegated menu in XQ2

 S MENU2(0)=1,MENU2(1)=XQX

 D KEYS^XQSMD6(.MENU2,.XQ2,.ABORT) K MENU2

 ;

 ;   compare the two list and inform the user if delegated menu

 ;   has keys unique to the delegated menu, store in XQ3

 S XQANS="N",ONEGOOD=0

 D:XQ2(0)>0 COMPARE

 D:ONEGOOD INFORM

 ;

 ;   user timeout or "^" aborted

 I $G(DTOUT)!($G(DUOUT)) W !!,$C(7),"No action taken, menu delegation still active!" Q

 ;

 ;   delete keys if user respond with 'Unique' or 'All'

 I XQANS="U"!(XQANS="A") D KEYDEL

 ;

MENUDEL ;

 ;   delete menu from user's secondary menu's multiple

 S DIE="^VA(200,"_XQDA_",203,",DR=".01///@",DA=XQSEC,DA(1)=XQDA D ^DIE

 ;

 W !!,$C(7),"Delegated Menu: "_XQXNAME_" has been removed!"

 Q

 ;

KEY ;   get list of keys

 N MENULIST,XQKEY,ABORT

 S MENULIST(0)=1,MENULIST(1)=XQX

 D KEYS^XQSMD6(.MENULIST,.XQKEY,.ABORT)

 Q:ABORT

 D:XQKEY(0) KEYADD

 W !!,$C(7),"Delegated Menu: "_XQXNAME_" has been added!"

 Q

 ;

KEYDEL ;   delete keys

 F I=1:1:XQ2(0)  D

 .Q:XQ2(I)=""

 .S XQCOMMON=0,XQKEYIEN=""

 .I XQANS="U" F J=1:1:XQ3(0) S:XQ2(1)=XQ3(J) XQCOMMON=1

 .Q:XQCOMMON

 .S XQKEYIEN=$O(^DIC(19.1,"B",XQ2(I),0))

 .S DIE="^VA(200,"_XQDA_",51,",DR=".01///@",DA=XQKEYIEN,DA(1)=XQDA D ^DIE

 .W !,$C(7),"Key: "_XQ2(I)_" has been removed!"

 .Q

 Q

 ;

KEYADD ;   add keys

 ;   adjust list to ones that have been delegated to you

 D ADJUST Q:'ONEGOOD

 W !!,$C(7),"The following Keys LOCK options within this menu structure",!

 F I=1:1:XQKEY(0) W:XQKEY(I)'="" !,?5,XQKEY(I)

 W !!,$C(7),"Do you want to ALLOCATE these Keys to this User?  N// "

 R Z:DTIME Q:'$T!(Z[U)  S:Z="" Z="N" Q:"Nn"[$E(Z)

 ;

 K DIC

 S DIC="^VA(200,"_XQDA_",51,",DIC(0)="NMQ",DIC("P")="200.051PA",DA(1)=XQDA

 F I=1:1:XQKEY(0)  D

 .Q:XQKEY(I)=""

 .S X=$O(^DIC(19.1,"B",XQKEY(I),0)),DINUM=X

 .I '$D(^VA(200,XQDA,51,"B",X,X)) D FILE^DICN W !,$C(7),"Key: "_XQKEY(I)_" has been added!"

 .Q

 Q

 ;

COMPARE ;   compare keys used in the delegated menu against keys the user

 ;   will need based on their primary and secondary menus

 N KEYIEN

 S XQ3="",XQ3(0)=0

 F I=1:1:XQ2(0)  D

 .S KEYIEN=$O(^DIC(19.1,"B",XQ2(I),0))

 .I '$G(^VA(200,DUZ,52,KEYIEN,0)) S XQ2(I)="" Q

 .S ONEGOOD=1

 .F J=1:1:XQ1(0)  D

 ..Q:XQ2(I)'=XQ1(J)

 ..S XQ3(0)=XQ3(0)+1,XQ3(XQ3(0))=XQ2(I)

 ..Q

 Q

 ; 

INFORM ;   inform the user of the keys situation

 W !!,$C(7),"The following Keys LOCK options within this menu structure.",!

 F I=1:1:XQ2(0) W:XQ2(I)'="" !,?5,XQ2(I)

 W:XQ3(0) !!,$C(7),"The following are Keys from the list above that this User has potential needs",!,"for within their current assigned Menu's (Primary and all Secondaries)."

 W:XQ3(0) !,"Selecting 'U' will remove all keys EXCEPT those noted below.",!  F I=1:1:XQ3(0) W !,?5,XQ3(I)

 S DIR(0)="S^A:ALL  Remove all Keys associated with this Menu;N:NONE  Do not remove any Keys associated with this Menu"_$S(XQ3(0):";U:UNIQUE  Only remove Keys unique to this Menu",1:"")

 D ^DIR S XQANS=Y

 Q

 ;

ADJUST ;   adjust the list of keys to ones that the user (DUZ) has 

 ;   been delegated [node ^VA(200,DUZ,52,]

 N I,KEYIEN

 S ONEGOOD=0

 F I=1:1:XQKEY(0)  D

 . S KEYIEN=$O(^DIC(19.1,"B",XQKEY(I),0))

 . I $G(^VA(200,DUZ,52,KEYIEN,0)) S ONEGOOD=1 Q

 . S XQKEY(I)=""

 . Q

 Q

XQSMD5    ;SEA/JLI,MJM - SECURE MENU DELEGATE EDIT USER OPTIONS ;10/15/98  12:22 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**72,99**;Jul 10, 1995

 +3        QUIT 

 +4       ;

ENTRY     ; Main Entry point to edit primary (if applicable) and secondary options

 +1       ;

 +2       ;   check to see if you have options to delegate

 +3        IF $ORDER(^VA(200,DUZ,19.5,0))'>0

               WRITE !,$CHAR(7),"No Delegated Options Available to Give Out",!

               QUIT 

 +4       ;

 +5       ;   get user to delegate options to

 +6        SET Y=$$LOOKUP^XUSER("QA")

           IF Y'>0

               GOTO EXIT

           SET (XQDA,DA)=+Y

 +7       ;

 +8       ;   check user's primary menu, if user has primary and it's not one

 +9       ;   of the ones that you can delegate, goto secondary options,

 +10      ;   otherwise fall through and edit primary options

 +11       SET XQPRI=$SELECT($DATA(^VA(200,DA,201)):+^(201),1:0)

           IF XQPRI

               IF '$DATA(^VA(200,DUZ,19.5,XQPRI,0))

                   GOTO SEC

 +12      ;

 +13      ;   either change primary option or leave as is and go to secondary

 +14       KILL DIC

 +15       SET XQOLD=XQPRI

           SET DIC="^VA(200,"_DUZ_",19.5,"

           SET DIC(0)="QMAE"

           SET DA(1)=DUZ

           SET DIC("A")="     PRIMARY MENU OPTION: "

           IF XQPRI>0

               SET DIC("B")=$PIECE(^DIC(19,XQPRI,0),U,1)

           DO ^DIC

           IF +Y=XQOLD!(+Y'>0)

               GOTO SEC

 +16      ;

 +17      ;   changing primary option

 +18       SET (X,XQPRI)=+Y

           SET X=$PIECE(^DIC(19,X,0),U,1)

           SET DIE="^VA(200,"

           SET DA=XQDA

           SET DR="201///"_X_";"

           DO ^DIE

 +19      ;

 +20      ;   delete old keys associated with old primary menu

 +21       IF XQOLD

               Begin DoDot:1

 +22               SET MENUOLD(0)=1

                   SET MENUOLD(1)=XQOLD

                   SET XQANS=""

 +23               DO KEYS^XQSMD6(.MENUOLD,.XQKEY,.ABORT)

                   KILL MENUOLD

 +24               IF XQKEY(0)

                       Begin DoDot:2

 +25                       DO ADJUST

 +26                       IF 'ONEGOOD

                               QUIT 

 +27                       MERGE XQ2=XQKEY

 +28                       WRITE !,"...Removing KEYS associated with previous PRIMARY menu"

 +29                       DO KEYDEL

 +30                       QUIT 

                       End DoDot:2

               End DoDot:1

 +31       KILL XQ2,XQKEY

 +32      ;

 +33      ;   add new keys associated with new primary menu if you have

 +34      ;   been delegated those keys

 +35       IF '$DATA(^VA(200,DUZ,52))

               GOTO SEC

 +36       SET MENUPRI(0)=1

           SET MENUPRI(1)=XQPRI

 +37       DO KEYS^XQSMD6(.MENUPRI,.XQKEY,.ABORT)

           KILL MENUPRI

 +38       IF XQKEY(0)

               DO KEYADD

 +39       KILL XQKEY

 +40      ;

 +41      ;   fall through to secondary options

 +42      ;

SEC       ; Enter Secondary Menu Options from delegated options

 +1        KILL DIC

 +2        WRITE !

           SET DIC="^VA(200,"_DUZ_",19.5,"

           SET DIC(0)="QMAE"

           SET DA(1)=DUZ

           SET DIC("A")="     SECONDARY MENU OPTION: "

           DO ^DIC

           IF Y'>0

               GOTO ENTRY

 +3        SET XQX=$PIECE(Y,U,2)

 +4        IF '$DATA(^VA(200,XQDA,203,0))

               SET ^(0)="^200.03P"

           SET (XQXNAME,X)=$PIECE(^DIC(19,+Y,0),U,1)

           SET DIC="^VA(200,"_XQDA_",203,"

           SET DIC(0)="ML"

           SET DLAYGO=200

           SET DA(1)=XQDA

           DO ^DIC

 +5       ;

 +6        SET XQADD=+$PIECE(Y,U,3)

           SET XQSEC=+Y

           IF XQADD

               DO KEY

           IF 'XQADD

               DO DEL

           KILL ^DIC(200,XQDA,203.1)

 +7        GOTO SEC

 +8       ;

EXIT      ;

 +1        KILL D0,DA,DI,DIC,DIE,DR,DQ,I,J,ONEGOOD,P,X,XQ1,XQ2,XQ3,XQADD,XQANS,XQCOMMON,XQDA,XQJ,XQKEY,XQKEYIEN,XQOLD,XQPRI,XQSEC,XQX,XQXNAME,Y,Z

 +2        QUIT 

 +3       ;

DEL       ;   delete delegated menu

 +1        WRITE !,$CHAR(7),"Want to Delete ",XQXNAME," as a Secondary Option? Y// "

 +2        READ Z:DTIME

           IF '$TEST!(Z[U)

               QUIT 

           IF Z=""

               SET Z="Y"

           IF "Yy"'[$EXTRACT(Z)

               QUIT 

 +3       ;

 +4       ;   check to see if users has any keys delegated

 +5        IF '$DATA(^VA(200,DUZ,52,0))

               GOTO MENUDEL

 +6       ;

 +7       ;   build list of users primary ans secondary menus

 +8        SET MENU1(0)=1

           SET MENU1(1)=XQPRI

           SET XQJ=""

 +9        FOR 

               SET XQJ=$ORDER(^VA(200,XQDA,203,"B",XQJ))

               IF XQJ=""

                   QUIT 

               Begin DoDot:1

 +10               IF XQJ=XQX

                       QUIT 

 +11               SET MENU1(0)=MENU1(0)+1

                   SET MENU1(MENU1(0))=XQJ

 +12               QUIT 

               End DoDot:1

 +13      ;

 +14      ;   get list of keys for primary and all secondary menus in XQ1

 +15       DO KEYS^XQSMD6(.MENU1,.XQ1,.ABORT)

           KILL MENU1

 +16      ;

 +17      ;   get list of keys for delegated menu in XQ2

 +18       SET MENU2(0)=1

           SET MENU2(1)=XQX

 +19       DO KEYS^XQSMD6(.MENU2,.XQ2,.ABORT)

           KILL MENU2

 +20      ;

 +21      ;   compare the two list and inform the user if delegated menu

 +22      ;   has keys unique to the delegated menu, store in XQ3

 +23       SET XQANS="N"

           SET ONEGOOD=0

 +24       IF XQ2(0)>0

               DO COMPARE

 +25       IF ONEGOOD

               DO INFORM

 +26      ;

 +27      ;   user timeout or "^" aborted

 +28       IF $GET(DTOUT)!($GET(DUOUT))

               WRITE !!,$CHAR(7),"No action taken, menu delegation still active!"

               QUIT 

 +29      ;

 +30      ;   delete keys if user respond with 'Unique' or 'All'

 +31       IF XQANS="U"!(XQANS="A")

               DO KEYDEL

 +32      ;

MENUDEL   ;

 +1       ;   delete menu from user's secondary menu's multiple

 +2        SET DIE="^VA(200,"_XQDA_",203,"

           SET DR=".01///@"

           SET DA=XQSEC

           SET DA(1)=XQDA

           DO ^DIE

 +3       ;

 +4        WRITE !!,$CHAR(7),"Delegated Menu: "_XQXNAME_" has been removed!"

 +5        QUIT 

 +6       ;

KEY       ;   get list of keys

 +1        NEW MENULIST,XQKEY,ABORT

 +2        SET MENULIST(0)=1

           SET MENULIST(1)=XQX

 +3        DO KEYS^XQSMD6(.MENULIST,.XQKEY,.ABORT)

 +4        IF ABORT

               QUIT 

 +5        IF XQKEY(0)

               DO KEYADD

 +6        WRITE !!,$CHAR(7),"Delegated Menu: "_XQXNAME_" has been added!"

 +7        QUIT 

 +8       ;

KEYDEL    ;   delete keys

 +1        FOR I=1:1:XQ2(0)

               Begin DoDot:1

 +2                IF XQ2(I)=""

                       QUIT 

 +3                SET XQCOMMON=0

                   SET XQKEYIEN=""

 +4                IF XQANS="U"

                       FOR J=1:1:XQ3(0)

                           IF XQ2(1)=XQ3(J)

                               SET XQCOMMON=1

 +5                IF XQCOMMON

                       QUIT 

 +6                SET XQKEYIEN=$ORDER(^DIC(19.1,"B",XQ2(I),0))

 +7                SET DIE="^VA(200,"_XQDA_",51,"

                   SET DR=".01///@"

                   SET DA=XQKEYIEN

                   SET DA(1)=XQDA

                   DO ^DIE

 +8                WRITE !,$CHAR(7),"Key: "_XQ2(I)_" has been removed!"

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

 +11      ;

KEYADD    ;   add keys

 +1       ;   adjust list to ones that have been delegated to you

 +2        DO ADJUST

           IF 'ONEGOOD

               QUIT 

 +3        WRITE !!,$CHAR(7),"The following Keys LOCK options within this menu structure",!

 +4        FOR I=1:1:XQKEY(0)

               IF XQKEY(I)'=""

                   WRITE !,?5,XQKEY(I)

 +5        WRITE !!,$CHAR(7),"Do you want to ALLOCATE these Keys to this User?  N// "

 +6        READ Z:DTIME

           IF '$TEST!(Z[U)

               QUIT 

           IF Z=""

               SET Z="N"

           IF "Nn"[$EXTRACT(Z)

               QUIT 

 +7       ;

 +8        KILL DIC

 +9        SET DIC="^VA(200,"_XQDA_",51,"

           SET DIC(0)="NMQ"

           SET DIC("P")="200.051PA"

           SET DA(1)=XQDA

 +10       FOR I=1:1:XQKEY(0)

               Begin DoDot:1

 +11               IF XQKEY(I)=""

                       QUIT 

 +12               SET X=$ORDER(^DIC(19.1,"B",XQKEY(I),0))

                   SET DINUM=X

 +13               IF '$DATA(^VA(200,XQDA,51,"B",X,X))

                       DO FILE^DICN

                       WRITE !,$CHAR(7),"Key: "_XQKEY(I)_" has been added!"

 +14               QUIT 

               End DoDot:1

 +15       QUIT 

 +16      ;

COMPARE   ;   compare keys used in the delegated menu against keys the user

 +1       ;   will need based on their primary and secondary menus

 +2        NEW KEYIEN

 +3        SET XQ3=""

           SET XQ3(0)=0

 +4        FOR I=1:1:XQ2(0)

               Begin DoDot:1

 +5                SET KEYIEN=$ORDER(^DIC(19.1,"B",XQ2(I),0))

 +6                IF '$GET(^VA(200,DUZ,52,KEYIEN,0))

                       SET XQ2(I)=""

                       QUIT 

 +7                SET ONEGOOD=1

 +8                FOR J=1:1:XQ1(0)

                       Begin DoDot:2

 +9                        IF XQ2(I)'=XQ1(J)

                               QUIT 

 +10                       SET XQ3(0)=XQ3(0)+1

                           SET XQ3(XQ3(0))=XQ2(I)

 +11                       QUIT 

                       End DoDot:2

               End DoDot:1

 +12       QUIT 

 +13      ; 

INFORM    ;   inform the user of the keys situation

 +1        WRITE !!,$CHAR(7),"The following Keys LOCK options within this menu structure.",!

 +2        FOR I=1:1:XQ2(0)

               IF XQ2(I)'=""

                   WRITE !,?5,XQ2(I)

 +3        IF XQ3(0)

               WRITE !!,$CHAR(7),"The following are Keys from the list above that this User has potential needs",!,"for within their current assigned Menu's (Primary and all Secondaries)."

 +4        IF XQ3(0)

               WRITE !,"Selecting 'U' will remove all keys EXCEPT those noted below.",!

           FOR I=1:1:XQ3(0)

               WRITE !,?5,XQ3(I)

 +5        SET DIR(0)="S^A:ALL  Remove all Keys associated with this Menu;N:NONE  Do not remove any Keys associated with this Menu"_$SELECT(XQ3(0):";U:UNIQUE  Only remove Keys unique to this Menu",1:"")

 +6        DO ^DIR

           SET XQANS=Y

 +7        QUIT 

 +8       ;

ADJUST    ;   adjust the list of keys to ones that the user (DUZ) has 

 +1       ;   been delegated [node ^VA(200,DUZ,52,]

 +2        NEW I,KEYIEN

 +3        SET ONEGOOD=0

 +4        FOR I=1:1:XQKEY(0)

               Begin DoDot:1

 +5                SET KEYIEN=$ORDER(^DIC(19.1,"B",XQKEY(I),0))

 +6                IF $GET(^VA(200,DUZ,52,KEYIEN,0))

                       SET ONEGOOD=1

                       QUIT 

 +7                SET XQKEY(I)=""

 +8                QUIT 

               End DoDot:1

 +9        QUIT