source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDKEY.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1XPDKEY ;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
6RENAME(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 ;
17LOCKS(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 ;
28DEL(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 ;
39LKUP(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))
Note: See TracBrowser for help on using the repository browser.