Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XQKEY

XQKEY.m

Go to the documentation of this file.
  1. XQKEY ;Seattle/Luke - Key and lock utilities ;9/14/94 10:49
  1. ;;8.0;KERNEL;;Jul 10, 1995
  1. ADD(XQKUS,XQKEY,XQKF) ;Give a user a key
  1. ;XQKDA = the user's duz, XQKEY = the name or IEN of the key,
  1. ;XQKF = the success flag: 0:not awarded, 1:successfully
  1. ;given to the user.
  1. S XQKF=1
  1. ;
  1. I XQKEY'=+XQKEY D
  1. .S XQKEYT=XQKEY
  1. .I $O(^DIC(19.1,"B",XQKEYT,0))'>0 S XQKF=0 Q
  1. .S XQKEY=$O(^DIC(19.1,"B",XQKEYT,0)) I XQKEY'>0 S XQKF=0 Q
  1. .K XQKEYT
  1. .Q
  1. I '$D(^DIC(19.1,XQKEY,0)) S XQKF=0
  1. ;
  1. S %=XQKF
  1. I '% Q %
  1. ;
  1. I $D(^VA(200,XQKUS,51,XQKEY)) Q % ;Already has it
  1. ;
  1. S XQFDA(200.051,"+1,"_XQKUS_",",.01)=XQKEY
  1. S XQFDA(200.051,"+1,"_XQKUS_",",1)=DUZ
  1. S XQFDA(200.051,"+1,"_XQKUS_",",2)=DT
  1. S XQIEN(1)=XQKEY
  1. ;
  1. D UPDATE^DIE("","XQFDA","XQIEN")
  1. ;
  1. S %=XQKF
  1. Q %
  1. ;
  1. DEL(XQKUS,XQKEY,XQKF) ;Remove a key from a user
  1. ;Remove a key (XQKEY) from a user (XQKUS) unless it's the
  1. ;PROVIDER key which is never removed
  1. ;
  1. S XQKF=1
  1. ;
  1. I XQKEY'=+XQKEY D
  1. .S XQKEYT=XQKEY
  1. .I $O(^DIC(19.1,"B",XQKEYT,0))'>0 S XQKF=0 Q
  1. .S XQKEY=$O(^DIC(19.1,"B",XQKEYT,0)) I XQKEY'>0 S XQKF=0 Q
  1. .K XQKEYT
  1. .Q
  1. I '$D(^DIC(19.1,XQKEY,0)) S XQKF=0
  1. ;
  1. S %=XQKF
  1. I '% Q %
  1. ;
  1. PROV ;Check for PROVIDER key
  1. I '$D(^DIC(19.1,"B","PROVIDER")) S XQPROV=0
  1. E S XQPROV=$O(^DIC(19.1,"B","PROVIDER",0))
  1. I XQKEY=XQPROV S %=0 Q %
  1. ;
  1. I '$D(^VA(200,XQKUS,51,XQKEY)) Q % ;Doesn't have it
  1. ;
  1. N DA,DIK
  1. S DA(1)=XQKUS,DA=XQKEY,DIK="^VA(200,"_DA(1)_",51,"
  1. D ^DIK
  1. ;
  1. S %=XQKF
  1. Q %