XQSMD6.m

XQSMD6 ;SFISC/JDS - SECURE MENU DELEGATION UTILITIES ;03/02/98  10:40 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 

 ;;8.0;KERNEL;**72**;NOV 13, 1997

 Q

 ;

 ;   Entry to lookup all Keys associated with a Menu

 ;   INPUT  - MENULIST ARRAY  ---  (passed by reference)

 ;            MENULIST(0) = Total number of Menus to start with

 ;            MENULIST(1) = 1st Menu IEN

 ;            MENULIST(2) - 2nd Menu IEN

 ;            ...etc

 ;   OUTPUT - ABORT = 1 if IEN doesn't exist  ---  (passed by reference)

 ;            XQKEY ARRAY  ---  (passed by reference)

 ;            XQKEY(0) = Total number of Keys

 ;            XQKEY(1) = 1st Key found

 ;            XQKEY(2) = 2nd Key found

 ;            ...etc

 ;

KEYS(MENULIST,XQKEY,ABORT) ;

 ;   Order thru menu structure in search of locks

 S ABORT=0 D CHECK Q:ABORT

 ;

 K ^XTMP($J,"XQSMD6")

 M ^XTMP($J,"XQSMD6")=MENULIST

 F X=1:1:MENULIST(0)  S ^XTMP($J,"XQSMD6","B",MENULIST(X))=""

 ;

 N XQJ,KEY,PIEN,CNT

 S XQJ="",XQKEY="",XQKEY(0)=0

 ;

PROCESS ;

 F CNT=1:1  S PIEN=$G(^XTMP($J,"XQSMD6",CNT)) Q:PIEN=""  D BUILD

 ;

 K ^XTMP($J,"XQSMD6"),XQKEY("B")

 Q

 ;

BUILD ;

 ;   1st check to see if this option is still on the system,

 ;   then check to see if a key is locking this option

 ;

 Q:'$D(^DIC(19,PIEN,0))

 I $P(^DIC(19,PIEN,0),U,6)]"" D KEYADD

 ;

 ;   check to see if this option has any children

 S XQJ=""

 F  S XQJ=$O(^DIC(19,PIEN,10,"B",XQJ)) Q:XQJ=""  D CHILDADD

 Q

 ;

CHILDADD ;

 ;   Add a child to the list of children

 ;   quit if child is already in the list

 ;

 Q:$D(^XTMP($J,"XQSMD6","B",XQJ))

 S ^XTMP($J,"XQSMD6",0)=^XTMP($J,"XQSMD6",0)+1

 S ^XTMP($J,"XQSMD6",^XTMP($J,"XQSMD6",0))=XQJ

 S ^XTMP($J,"XQSMD6","B",XQJ)=""

 I ^XTMP($J,"XQSMD6",0)#100=0 W "."

 Q

KEYADD ;

 ;   Add a key to the list of keys needed

 ;

 S KEY=$P(^DIC(19,PIEN,0),U,6)

 ;

 ;   quit if key is already in the list

 Q:$D(XQKEY("B",KEY))

 S XQKEY(0)=XQKEY(0)+1

 S XQKEY(XQKEY(0))=KEY

 S XQKEY("B",KEY)=""

 Q

CHECK ;

 ;   ensure that IEN passed in is in option file ^DIC(19,

 ;

 I '$D(^DIC(19,MENULIST(1),0))  D

 . S ABORT=1

 . W !!,?7,"Aborting key search, Option File IEN "_IEN_" doesn't exist!",!!

 Q

XQSMD6    ;SFISC/JDS - SECURE MENU DELEGATION UTILITIES ;03/02/98  10:40 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1005,1007**;APR 1, 2003 

 +2       ;;8.0;KERNEL;**72**;NOV 13, 1997

 +3        QUIT 

 +4       ;

 +5       ;   Entry to lookup all Keys associated with a Menu

 +6       ;   INPUT  - MENULIST ARRAY  ---  (passed by reference)

 +7       ;            MENULIST(0) = Total number of Menus to start with

 +8       ;            MENULIST(1) = 1st Menu IEN

 +9       ;            MENULIST(2) - 2nd Menu IEN

 +10      ;            ...etc

 +11      ;   OUTPUT - ABORT = 1 if IEN doesn't exist  ---  (passed by reference)

 +12      ;            XQKEY ARRAY  ---  (passed by reference)

 +13      ;            XQKEY(0) = Total number of Keys

 +14      ;            XQKEY(1) = 1st Key found

 +15      ;            XQKEY(2) = 2nd Key found

 +16      ;            ...etc

 +17      ;

KEYS(MENULIST,XQKEY,ABORT) ;

 +1       ;   Order thru menu structure in search of locks

 +2        SET ABORT=0

           DO CHECK

           IF ABORT

               QUIT 

 +3       ;

 +4        KILL ^XTMP($JOB,"XQSMD6")

 +5        MERGE ^XTMP($JOB,"XQSMD6")=MENULIST

 +6        FOR X=1:1:MENULIST(0)

               SET ^XTMP($JOB,"XQSMD6","B",MENULIST(X))=""

 +7       ;

 +8        NEW XQJ,KEY,PIEN,CNT

 +9        SET XQJ=""

           SET XQKEY=""

           SET XQKEY(0)=0

 +10      ;

PROCESS   ;

 +1        FOR CNT=1:1

               SET PIEN=$GET(^XTMP($JOB,"XQSMD6",CNT))

               IF PIEN=""

                   QUIT 

               DO BUILD

 +2       ;

 +3        KILL ^XTMP($JOB,"XQSMD6"),XQKEY("B")

 +4        QUIT 

 +5       ;

BUILD     ;

 +1       ;   1st check to see if this option is still on the system,

 +2       ;   then check to see if a key is locking this option

 +3       ;

 +4        IF '$DATA(^DIC(19,PIEN,0))

               QUIT 

 +5        IF $PIECE(^DIC(19,PIEN,0),U,6)]""

               DO KEYADD

 +6       ;

 +7       ;   check to see if this option has any children

 +8        SET XQJ=""

 +9        FOR 

               SET XQJ=$ORDER(^DIC(19,PIEN,10,"B",XQJ))

               IF XQJ=""

                   QUIT 

               DO CHILDADD

 +10       QUIT 

 +11      ;

CHILDADD  ;

 +1       ;   Add a child to the list of children

 +2       ;   quit if child is already in the list

 +3       ;

 +4        IF $DATA(^XTMP($JOB,"XQSMD6","B",XQJ))

               QUIT 

 +5        SET ^XTMP($JOB,"XQSMD6",0)=^XTMP($JOB,"XQSMD6",0)+1

 +6        SET ^XTMP($JOB,"XQSMD6",^XTMP($JOB,"XQSMD6",0))=XQJ

 +7        SET ^XTMP($JOB,"XQSMD6","B",XQJ)=""

 +8        IF ^XTMP($JOB,"XQSMD6",0)#100=0

               WRITE "."

 +9        QUIT 

KEYADD    ;

 +1       ;   Add a key to the list of keys needed

 +2       ;

 +3        SET KEY=$PIECE(^DIC(19,PIEN,0),U,6)

 +4       ;

 +5       ;   quit if key is already in the list

 +6        IF $DATA(XQKEY("B",KEY))

               QUIT 

 +7        SET XQKEY(0)=XQKEY(0)+1

 +8        SET XQKEY(XQKEY(0))=KEY

 +9        SET XQKEY("B",KEY)=""

 +10       QUIT 

CHECK     ;

 +1       ;   ensure that IEN passed in is in option file ^DIC(19,

 +2       ;

 +3        IF '$DATA(^DIC(19,MENULIST(1),0))

               Begin DoDot:1

 +4                SET ABORT=1

 +5                WRITE !!,?7,"Aborting key search, Option File IEN "_IEN_" doesn't exist!",!!

               End DoDot:1

 +6        QUIT