XQKEY.m

XQKEY ;Seattle/Luke - Key and lock utilities ;9/14/94  10:49 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;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 %

XQKEY     ;Seattle/Luke - Key and lock utilities ;9/14/94  10:49 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;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 %