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/XQKEY.m@ 862

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1XQKEY ;Seattle/Luke - Key and lock utilities ;9/14/94 10:49
2 ;;8.0;KERNEL;;Jul 10, 1995
3ADD(XQKUS,XQKEY,XQKF) ;Give a user a key
4 ;XQKDA = the user's duz, XQKEY = the name or IEN of the key,
5 ;XQKF = the success flag: 0:not awarded, 1:successfully
6 ;given to the user.
7 S XQKF=1
8 ;
9 I XQKEY'=+XQKEY D
10 .S XQKEYT=XQKEY
11 .I $O(^DIC(19.1,"B",XQKEYT,0))'>0 S XQKF=0 Q
12 .S XQKEY=$O(^DIC(19.1,"B",XQKEYT,0)) I XQKEY'>0 S XQKF=0 Q
13 .K XQKEYT
14 .Q
15 I '$D(^DIC(19.1,XQKEY,0)) S XQKF=0
16 ;
17 S %=XQKF
18 I '% Q %
19 ;
20 I $D(^VA(200,XQKUS,51,XQKEY)) Q % ;Already has it
21 ;
22 S XQFDA(200.051,"+1,"_XQKUS_",",.01)=XQKEY
23 S XQFDA(200.051,"+1,"_XQKUS_",",1)=DUZ
24 S XQFDA(200.051,"+1,"_XQKUS_",",2)=DT
25 S XQIEN(1)=XQKEY
26 ;
27 D UPDATE^DIE("","XQFDA","XQIEN")
28 ;
29 S %=XQKF
30 Q %
31 ;
32DEL(XQKUS,XQKEY,XQKF) ;Remove a key from a user
33 ;Remove a key (XQKEY) from a user (XQKUS) unless it's the
34 ;PROVIDER key which is never removed
35 ;
36 S XQKF=1
37 ;
38 I XQKEY'=+XQKEY D
39 .S XQKEYT=XQKEY
40 .I $O(^DIC(19.1,"B",XQKEYT,0))'>0 S XQKF=0 Q
41 .S XQKEY=$O(^DIC(19.1,"B",XQKEYT,0)) I XQKEY'>0 S XQKF=0 Q
42 .K XQKEYT
43 .Q
44 I '$D(^DIC(19.1,XQKEY,0)) S XQKF=0
45 ;
46 S %=XQKF
47 I '% Q %
48 ;
49PROV ;Check for PROVIDER key
50 I '$D(^DIC(19.1,"B","PROVIDER")) S XQPROV=0
51 E S XQPROV=$O(^DIC(19.1,"B","PROVIDER",0))
52 I XQKEY=XQPROV S %=0 Q %
53 ;
54 I '$D(^VA(200,XQKUS,51,XQKEY)) Q % ;Doesn't have it
55 ;
56 N DA,DIK
57 S DA(1)=XQKUS,DA=XQKEY,DIK="^VA(200,"_DA(1)_",51,"
58 D ^DIK
59 ;
60 S %=XQKF
61 Q %
Note: See TracBrowser for help on using the repository browser.