- 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 Feb 18, 2025@23:32:12 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 %