- 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))
