XPDKEY ;SFISC/RWF,RSD - Tools to work on KEYS ;9/21/95 13:47
;;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))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDKEY 1402 printed Oct 16, 2024@18:05:10 Page 2
XPDKEY ;SFISC/RWF,RSD - Tools to work on KEYS ;9/21/95 13:47
+1 ;;8.0;KERNEL;**5**;Jul 10, 1995
+2 QUIT
+3 ;XPDOLD=current Key name, XPDNEW=new Key name
+4 ;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))
