XQSMD6 ;SFISC/JDS - SECURE MENU DELEGATION UTILITIES ;03/02/98 10:40
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSMD6 2164 printed Apr 09, 2024@21:13 Page 2
XQSMD6 ;SFISC/JDS - SECURE MENU DELEGATION UTILITIES ;03/02/98 10:40
+1 ;;8.0;KERNEL;**72**;NOV 13, 1997
+2 QUIT
+3 ;
+4 ; Entry to lookup all Keys associated with a Menu
+5 ; INPUT - MENULIST ARRAY --- (passed by reference)
+6 ; MENULIST(0) = Total number of Menus to start with
+7 ; MENULIST(1) = 1st Menu IEN
+8 ; MENULIST(2) - 2nd Menu IEN
+9 ; ...etc
+10 ; OUTPUT - ABORT = 1 if IEN doesn't exist --- (passed by reference)
+11 ; XQKEY ARRAY --- (passed by reference)
+12 ; XQKEY(0) = Total number of Keys
+13 ; XQKEY(1) = 1st Key found
+14 ; XQKEY(2) = 2nd Key found
+15 ; ...etc
+16 ;
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
