source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSMD6.m@ 1578

Last change on this file since 1578 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1XQSMD6 ;SFISC/JDS - SECURE MENU DELEGATION UTILITIES ;03/02/98 10:40
2 ;;8.0;KERNEL;**72**;NOV 13, 1997
3 Q
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 ;
18KEYS(MENULIST,XQKEY,ABORT) ;
19 ; Order thru menu structure in search of locks
20 S ABORT=0 D CHECK Q:ABORT
21 ;
22 K ^XTMP($J,"XQSMD6")
23 M ^XTMP($J,"XQSMD6")=MENULIST
24 F X=1:1:MENULIST(0) S ^XTMP($J,"XQSMD6","B",MENULIST(X))=""
25 ;
26 N XQJ,KEY,PIEN,CNT
27 S XQJ="",XQKEY="",XQKEY(0)=0
28 ;
29PROCESS ;
30 F CNT=1:1 S PIEN=$G(^XTMP($J,"XQSMD6",CNT)) Q:PIEN="" D BUILD
31 ;
32 K ^XTMP($J,"XQSMD6"),XQKEY("B")
33 Q
34 ;
35BUILD ;
36 ; 1st check to see if this option is still on the system,
37 ; then check to see if a key is locking this option
38 ;
39 Q:'$D(^DIC(19,PIEN,0))
40 I $P(^DIC(19,PIEN,0),U,6)]"" D KEYADD
41 ;
42 ; check to see if this option has any children
43 S XQJ=""
44 F S XQJ=$O(^DIC(19,PIEN,10,"B",XQJ)) Q:XQJ="" D CHILDADD
45 Q
46 ;
47CHILDADD ;
48 ; Add a child to the list of children
49 ; quit if child is already in the list
50 ;
51 Q:$D(^XTMP($J,"XQSMD6","B",XQJ))
52 S ^XTMP($J,"XQSMD6",0)=^XTMP($J,"XQSMD6",0)+1
53 S ^XTMP($J,"XQSMD6",^XTMP($J,"XQSMD6",0))=XQJ
54 S ^XTMP($J,"XQSMD6","B",XQJ)=""
55 I ^XTMP($J,"XQSMD6",0)#100=0 W "."
56 Q
57KEYADD ;
58 ; Add a key to the list of keys needed
59 ;
60 S KEY=$P(^DIC(19,PIEN,0),U,6)
61 ;
62 ; quit if key is already in the list
63 Q:$D(XQKEY("B",KEY))
64 S XQKEY(0)=XQKEY(0)+1
65 S XQKEY(XQKEY(0))=KEY
66 S XQKEY("B",KEY)=""
67 Q
68CHECK ;
69 ; ensure that IEN passed in is in option file ^DIC(19,
70 ;
71 I '$D(^DIC(19,MENULIST(1),0)) D
72 . S ABORT=1
73 . W !!,?7,"Aborting key search, Option File IEN "_IEN_" doesn't exist!",!!
74 Q
Note: See TracBrowser for help on using the repository browser.