XQKEY ;Seattle/Luke - Key and lock utilities ;9/14/94 10:49
;;8.0;KERNEL;;Jul 10, 1995
ADD(XQKUS,XQKEY,XQKF) ;Give a user a key
;XQKDA = the user's duz, XQKEY = the name or IEN of the key,
;XQKF = the success flag: 0:not awarded, 1:successfully
;given to the user.
S XQKF=1
;
I XQKEY'=+XQKEY D
.S XQKEYT=XQKEY
.I $O(^DIC(19.1,"B",XQKEYT,0))'>0 S XQKF=0 Q
.S XQKEY=$O(^DIC(19.1,"B",XQKEYT,0)) I XQKEY'>0 S XQKF=0 Q
.K XQKEYT
.Q
I '$D(^DIC(19.1,XQKEY,0)) S XQKF=0
;
S %=XQKF
I '% Q %
;
I $D(^VA(200,XQKUS,51,XQKEY)) Q % ;Already has it
;
S XQFDA(200.051,"+1,"_XQKUS_",",.01)=XQKEY
S XQFDA(200.051,"+1,"_XQKUS_",",1)=DUZ
S XQFDA(200.051,"+1,"_XQKUS_",",2)=DT
S XQIEN(1)=XQKEY
;
D UPDATE^DIE("","XQFDA","XQIEN")
;
S %=XQKF
Q %
;
DEL(XQKUS,XQKEY,XQKF) ;Remove a key from a user
;Remove a key (XQKEY) from a user (XQKUS) unless it's the
;PROVIDER key which is never removed
;
S XQKF=1
;
I XQKEY'=+XQKEY D
.S XQKEYT=XQKEY
.I $O(^DIC(19.1,"B",XQKEYT,0))'>0 S XQKF=0 Q
.S XQKEY=$O(^DIC(19.1,"B",XQKEYT,0)) I XQKEY'>0 S XQKF=0 Q
.K XQKEYT
.Q
I '$D(^DIC(19.1,XQKEY,0)) S XQKF=0
;
S %=XQKF
I '% Q %
;
PROV ;Check for PROVIDER key
I '$D(^DIC(19.1,"B","PROVIDER")) S XQPROV=0
E S XQPROV=$O(^DIC(19.1,"B","PROVIDER",0))
I XQKEY=XQPROV S %=0 Q %
;
I '$D(^VA(200,XQKUS,51,XQKEY)) Q % ;Doesn't have it
;
N DA,DIK
S DA(1)=XQKUS,DA=XQKEY,DIK="^VA(200,"_DA(1)_",51,"
D ^DIK
;
S %=XQKF
Q %
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQKEY 1495 printed Oct 16, 2024@18:06:35 Page 2
XQKEY ;Seattle/Luke - Key and lock utilities ;9/14/94 10:49
+1 ;;8.0;KERNEL;;Jul 10, 1995
ADD(XQKUS,XQKEY,XQKF) ;Give a user a key
+1 ;XQKDA = the user's duz, XQKEY = the name or IEN of the key,
+2 ;XQKF = the success flag: 0:not awarded, 1:successfully
+3 ;given to the user.
+4 SET XQKF=1
+5 ;
+6 IF XQKEY'=+XQKEY
Begin DoDot:1
+7 SET XQKEYT=XQKEY
+8 IF $ORDER(^DIC(19.1,"B",XQKEYT,0))'>0
SET XQKF=0
QUIT
+9 SET XQKEY=$ORDER(^DIC(19.1,"B",XQKEYT,0))
IF XQKEY'>0
SET XQKF=0
QUIT
+10 KILL XQKEYT
+11 QUIT
End DoDot:1
+12 IF '$DATA(^DIC(19.1,XQKEY,0))
SET XQKF=0
+13 ;
+14 SET %=XQKF
+15 IF '%
QUIT %
+16 ;
+17 ;Already has it
IF $DATA(^VA(200,XQKUS,51,XQKEY))
QUIT %
+18 ;
+19 SET XQFDA(200.051,"+1,"_XQKUS_",",.01)=XQKEY
+20 SET XQFDA(200.051,"+1,"_XQKUS_",",1)=DUZ
+21 SET XQFDA(200.051,"+1,"_XQKUS_",",2)=DT
+22 SET XQIEN(1)=XQKEY
+23 ;
+24 DO UPDATE^DIE("","XQFDA","XQIEN")
+25 ;
+26 SET %=XQKF
+27 QUIT %
+28 ;
DEL(XQKUS,XQKEY,XQKF) ;Remove a key from a user
+1 ;Remove a key (XQKEY) from a user (XQKUS) unless it's the
+2 ;PROVIDER key which is never removed
+3 ;
+4 SET XQKF=1
+5 ;
+6 IF XQKEY'=+XQKEY
Begin DoDot:1
+7 SET XQKEYT=XQKEY
+8 IF $ORDER(^DIC(19.1,"B",XQKEYT,0))'>0
SET XQKF=0
QUIT
+9 SET XQKEY=$ORDER(^DIC(19.1,"B",XQKEYT,0))
IF XQKEY'>0
SET XQKF=0
QUIT
+10 KILL XQKEYT
+11 QUIT
End DoDot:1
+12 IF '$DATA(^DIC(19.1,XQKEY,0))
SET XQKF=0
+13 ;
+14 SET %=XQKF
+15 IF '%
QUIT %
+16 ;
PROV ;Check for PROVIDER key
+1 IF '$DATA(^DIC(19.1,"B","PROVIDER"))
SET XQPROV=0
+2 IF '$TEST
SET XQPROV=$ORDER(^DIC(19.1,"B","PROVIDER",0))
+3 IF XQKEY=XQPROV
SET %=0
QUIT %
+4 ;
+5 ;Doesn't have it
IF '$DATA(^VA(200,XQKUS,51,XQKEY))
QUIT %
+6 ;
+7 NEW DA,DIK
+8 SET DA(1)=XQKUS
SET DA=XQKEY
SET DIK="^VA(200,"_DA(1)_",51,"
+9 DO ^DIK
+10 ;
+11 SET %=XQKF
+12 QUIT %
