XPDKEY.m

XPDKEY ;SFISC/RWF,RSD - Tools to work on KEYS ;9/21/95  13:47 [ 04/02/2003   8:29 AM ]

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

 ;;8.0;KERNEL;**5**;Jul 10, 1995

 Q

 ;XPDOLD=current Key name,  XPDNEW=new Key name

 ;return 1 for success, 0 for failure

RENAME(XPDOLD,XPDNEW) ;EF. Rename a Security Key

 Q:$D(XPDOLD)+$D(XPDNEW)'=2 0

 N DA,DIERR,DIK,XPD,XPDKEY,XPDI

 S XPDKEY=$O(^DIC(19.1,"B",XPDOLD,0)) Q:XPDKEY'>0 0

 S XPD(19.1,XPDKEY_",",.01)=XPDNEW D UPDATE^DIE("","XPD")

 I $D(DIERR) Q 0

 S XPDI=0,DA=XPDKEY,DIK="^VA(200,XPDI,51,",DIK(1)=.01

 F  S XPDI=$O(^VA(200,"AB",XPDKEY,XPDI)) Q:'XPDI  S DA(1)=XPDI D EN1^DIK

 D LOCKS(XPDOLD,XPDNEW)

 Q 1

 ;

LOCKS(XPDOLD,XPDNEW) ;check file 19 for LOCKS and REVERSE/LOCK fields

 N XPD,XPDI,X,Y

 Q:$D(XPDOLD)+$D(XPDNEW)'=2

 S XPDI=0

 F  S XPDI=$O(^DIC(19,XPDI)) Q:'XPDI  S X=$G(^(XPDI,0)),Y=$G(^(3)) D:$L(X)

 .K XPD

 .S:$P(X,"^",6)=XPDOLD XPD(19,XPDI_",",3)=XPDNEW

 .S:$P(Y,"^")=XPDOLD XPD(19,XPDI_",",3.01)=XPDNEW

 .D:$D(XPD) UPDATE^DIE("","XPD")

 Q

 ;

DEL(XPDA) ; Delete a key.

 N DA,DIK,XPD,XPDKEY,XPDI

 Q:'$D(^DIC(19.1,+$G(XPDA),0))  S XPDKEY=$P(^(0),"^")

 S XPDI=0,DA=XPDA

 F  S XPDI=$O(^VA(200,"AB",XPDA,XPDI)) Q:'XPDI  D

 . S DA(1)=XPDI,DIK="^VA(200,XPDI,51," D ^DIK

 . S DIK="^VA(200,XPDI,52," D ^DIK

 K DA S DA=XPDA,DIK="^DIC(19.1,"

 D ^DIK,LOCKS(XPDKEY,"@")

 Q

 ;

LKUP(X) ;Lookup a in the KEY file.

 Q:'$L(X) ""

 I X?1N.NP Q $P($G(^DIC(19.1,X,0)),"^")

 Q $O(^DIC(19.1,"B",X,0))

XPDKEY    ;SFISC/RWF,RSD - Tools to work on KEYS ;9/21/95  13:47 [ 04/02/2003   8:29 AM ]

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

 +2       ;;8.0;KERNEL;**5**;Jul 10, 1995

 +3        QUIT 

 +4       ;XPDOLD=current Key name,  XPDNEW=new Key name

 +5       ;return 1 for success, 0 for failure

RENAME(XPDOLD,XPDNEW) ;EF. Rename a Security Key

 +1        IF $DATA(XPDOLD)+$DATA(XPDNEW)'=2

               QUIT 0

 +2        NEW DA,DIERR,DIK,XPD,XPDKEY,XPDI

 +3        SET XPDKEY=$ORDER(^DIC(19.1,"B",XPDOLD,0))

           IF XPDKEY'>0

               QUIT 0

 +4        SET XPD(19.1,XPDKEY_",",.01)=XPDNEW

           DO UPDATE^DIE("","XPD")

 +5        IF $DATA(DIERR)

               QUIT 0

 +6        SET XPDI=0

           SET DA=XPDKEY

           SET DIK="^VA(200,XPDI,51,"

           SET DIK(1)=.01

 +7        FOR 

               SET XPDI=$ORDER(^VA(200,"AB",XPDKEY,XPDI))

               IF 'XPDI

                   QUIT 

               SET DA(1)=XPDI

               DO EN1^DIK

 +8        DO LOCKS(XPDOLD,XPDNEW)

 +9        QUIT 1

 +10      ;

LOCKS(XPDOLD,XPDNEW) ;check file 19 for LOCKS and REVERSE/LOCK fields

 +1        NEW XPD,XPDI,X,Y

 +2        IF $DATA(XPDOLD)+$DATA(XPDNEW)'=2

               QUIT 

 +3        SET XPDI=0

 +4        FOR 

               SET XPDI=$ORDER(^DIC(19,XPDI))

               IF 'XPDI

                   QUIT 

               SET X=$GET(^(XPDI,0))

               SET Y=$GET(^(3))

               IF $LENGTH(X)

                   Begin DoDot:1

 +5                    KILL XPD

 +6                    IF $PIECE(X,"^",6)=XPDOLD

                           SET XPD(19,XPDI_",",3)=XPDNEW

 +7                    IF $PIECE(Y,"^")=XPDOLD

                           SET XPD(19,XPDI_",",3.01)=XPDNEW

 +8                    IF $DATA(XPD)

                           DO UPDATE^DIE("","XPD")

                   End DoDot:1

 +9        QUIT 

 +10      ;

DEL(XPDA) ; Delete a key.

 +1        NEW DA,DIK,XPD,XPDKEY,XPDI

 +2        IF '$DATA(^DIC(19.1,+$GET(XPDA),0))

               QUIT 

           SET XPDKEY=$PIECE(^(0),"^")

 +3        SET XPDI=0

           SET DA=XPDA

 +4        FOR 

               SET XPDI=$ORDER(^VA(200,"AB",XPDA,XPDI))

               IF 'XPDI

                   QUIT 

               Begin DoDot:1

 +5                SET DA(1)=XPDI

                   SET DIK="^VA(200,XPDI,51,"

                   DO ^DIK

 +6                SET DIK="^VA(200,XPDI,52,"

                   DO ^DIK

               End DoDot:1

 +7        KILL DA

           SET DA=XPDA

           SET DIK="^DIC(19.1,"

 +8        DO ^DIK

           DO LOCKS(XPDKEY,"@")

 +9        QUIT 

 +10      ;

LKUP(X)   ;Lookup a in the KEY file.

 +1        IF '$LENGTH(X)

               QUIT ""

 +2        IF X?1N.NP

               QUIT $PIECE($GET(^DIC(19.1,X,0)),"^")

 +3        QUIT $ORDER(^DIC(19.1,"B",X,0))