| 1 | XPDKEY ;SFISC/RWF,RSD - Tools to work on KEYS ;9/21/95 13:47
|
|---|
| 2 | ;;8.0;KERNEL;**5**;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;XPDOLD=current Key name, XPDNEW=new Key name
|
|---|
| 5 | ;return 1 for success, 0 for failure
|
|---|
| 6 | RENAME(XPDOLD,XPDNEW) ;EF. Rename a Security Key
|
|---|
| 7 | Q:$D(XPDOLD)+$D(XPDNEW)'=2 0
|
|---|
| 8 | N DA,DIERR,DIK,XPD,XPDKEY,XPDI
|
|---|
| 9 | S XPDKEY=$O(^DIC(19.1,"B",XPDOLD,0)) Q:XPDKEY'>0 0
|
|---|
| 10 | S XPD(19.1,XPDKEY_",",.01)=XPDNEW D UPDATE^DIE("","XPD")
|
|---|
| 11 | I $D(DIERR) Q 0
|
|---|
| 12 | S XPDI=0,DA=XPDKEY,DIK="^VA(200,XPDI,51,",DIK(1)=.01
|
|---|
| 13 | F S XPDI=$O(^VA(200,"AB",XPDKEY,XPDI)) Q:'XPDI S DA(1)=XPDI D EN1^DIK
|
|---|
| 14 | D LOCKS(XPDOLD,XPDNEW)
|
|---|
| 15 | Q 1
|
|---|
| 16 | ;
|
|---|
| 17 | LOCKS(XPDOLD,XPDNEW) ;check file 19 for LOCKS and REVERSE/LOCK fields
|
|---|
| 18 | N XPD,XPDI,X,Y
|
|---|
| 19 | Q:$D(XPDOLD)+$D(XPDNEW)'=2
|
|---|
| 20 | S XPDI=0
|
|---|
| 21 | F S XPDI=$O(^DIC(19,XPDI)) Q:'XPDI S X=$G(^(XPDI,0)),Y=$G(^(3)) D:$L(X)
|
|---|
| 22 | .K XPD
|
|---|
| 23 | .S:$P(X,"^",6)=XPDOLD XPD(19,XPDI_",",3)=XPDNEW
|
|---|
| 24 | .S:$P(Y,"^")=XPDOLD XPD(19,XPDI_",",3.01)=XPDNEW
|
|---|
| 25 | .D:$D(XPD) UPDATE^DIE("","XPD")
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DEL(XPDA) ; Delete a key.
|
|---|
| 29 | N DA,DIK,XPD,XPDKEY,XPDI
|
|---|
| 30 | Q:'$D(^DIC(19.1,+$G(XPDA),0)) S XPDKEY=$P(^(0),"^")
|
|---|
| 31 | S XPDI=0,DA=XPDA
|
|---|
| 32 | F S XPDI=$O(^VA(200,"AB",XPDA,XPDI)) Q:'XPDI D
|
|---|
| 33 | . S DA(1)=XPDI,DIK="^VA(200,XPDI,51," D ^DIK
|
|---|
| 34 | . S DIK="^VA(200,XPDI,52," D ^DIK
|
|---|
| 35 | K DA S DA=XPDA,DIK="^DIC(19.1,"
|
|---|
| 36 | D ^DIK,LOCKS(XPDKEY,"@")
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | LKUP(X) ;Lookup a in the KEY file.
|
|---|
| 40 | Q:'$L(X) ""
|
|---|
| 41 | I X?1N.NP Q $P($G(^DIC(19.1,X,0)),"^")
|
|---|
| 42 | Q $O(^DIC(19.1,"B",X,0))
|
|---|
