AKMOSUSR ;BRJ/OHPD/TUCSON ASSIGN ALL SECURITY KEYS TO SUPER USER [ 04/02/2003 8:51 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;2.0;IHS KERNEL UTILITIES;;JUN 28, 1993
;IHS/MFD fix at ASSGNKEY+3
;IHS/MFD,JCM fix to use DIE and work with KERNEL 7
;IHS/JLS 10/31/96 fix at EN+1 for version check
;IHS/MFD FINDKEY+2, check for provider key so it isn't given out here
;IHS/JDM OK+6 THRU 8 AND ASSGNKEY+1 THRU 3, prompt for namespace or 'all' and assign keys per response.
EN ;
I "20217.18.0"'[+$G(^DD(9.4,0,"VR")) W *7,!,"You must have KERNEL 7/FILEMAN 19 loaded to use this routine!!" Q
W !,$T(+0),*7,?12,"Please enter the name of your ""SUPER USER"".",!!,?20,"<ADAM,ADAM> // " R AKMOSUSR S AKMOSUSR=$S(AKMOSUSR="":"ADAM,ADAM",1:AKMOSUSR)
W !,$T(+0),?12,"This program will check the security key file (^DIC(19.1))",!,?12,"and assign all security keys to your ""SUPERUSER""."
W !!,$T(+0),?12,"OK to continue <Y>es or <N>o? <No> // " R AKMOANS S AKMOANS=$S(AKMOANS="":"N",1:AKMOANS)
I '(AKMOANS?1"Y".E!(AKMOANS?1"y".E)) W !!,$T(+0),?12,"That's a NO-GO!!" G XIT
OK ;
D ^XBKSET S DUZ(0)="@"
W ! S AKMOXUSR=0,AKMODUZ="" F AKMOL=0:0 S AKMOXUSR=$O(^VA(200,"B",AKMOXUSR)) Q:AKMOXUSR="" I AKMOXUSR=AKMOSUSR S AKMODUZ=$O(^VA(200,"B",AKMOXUSR,AKMODUZ)) Q
I '+AKMODUZ W !!,*7,?5,"Cannot continue!! Superuser <",AKMOSUSR,"> was not found in the USER (^VA(200)) file." G XIT
D FINDKEYS
I '+AKMOKDFN W !!,*7,$T(+0),?12,"OOPS - - Your Security Key file (^DIC(19.1)) ""B"" cross reference is missing or incorrect.",!!,?12,$T(+0)," cannot continue. No action taken!!" G XIT
K DIR S DIR(0)="F^1:4^K:X'?.U X",DIR("A")="('ALL'=ALL) NAMESPACE? ",DIR("?")="Must enter 3-4 Uppercase Characters" D ^DIR
I X["^"!($D(DTOUT))!($D(DUOUT)) W !,"ABORTING..." G XIT
S AKMONSPC=X
F AKMOL=1:1:AKMOHITX D ASSGNKEY
W !!,$T(+0),?12,"Superuser <",AKMOSUSR,"> had or was assigned each security key."
XIT ;
W !!,*7,$T(+0),?12,"<DONE>"
K AKMOANS,AKMOL,AKMOLAST,AKMOHLDR,AKMOSKEY,AKMOHIT,AKMODT,AKMOXUSR,AKMODUZ,AKMOHITS,AKMOHITX,AKMOKDFN,U,X,Y,%DT
Q
FINDKEYS ; FIND THE SECURITY KEYS IN ^DIC(19.1,
S U="^",X="T",(AKMOSKEY,AKMOHITX)=0,(%DT,AKMOKDFN)="" D ^%DT S AKMODT=Y
;F AKMOL=0:0 S AKMOSKEY=$O(^DIC(19.1,"B",AKMOSKEY)) Q:AKMOSKEY=""!(AKMOSKEY"PROVIDER") S AKMOKDFN=$O(^DIC(19.1,"B",AKMOSKEY,"")) Q:'+AKMOKDFN D FINDHLDR
F AKMOL=0:0 S AKMOSKEY=$O(^DIC(19.1,"B",AKMOSKEY)) Q:AKMOSKEY="" S AKMOKDFN=$O(^DIC(19.1,"B",AKMOSKEY,"")) Q:'+AKMOKDFN D FINDHLDR ;IHS/ORDC/LJF 4/14/94 REMOVED CHECK FOR PROVIDER KEY
Q
FINDHLDR ; CHECK TO SEE IF XUSR ALREADY HOLDS THE KEY
Q:AKMOSKEY="PROVIDER" ;IHS/ORDC/LJF 4/14/94 don't give provider key to programmers
I '$D(^VA(200,AKMODUZ,51,AKMOKDFN)) S AKMOHITX=AKMOHITX+1,AKMOHITS(AKMOHITX)=AKMOSKEY_U_AKMOKDFN
Q
S (AKMOHLDR,AKMOHIT,AKMOLAST)=0 F AKMOL=0:0 S AKMOHLDR=$O(^VA(200,AKMOKDFN,51,AKMOHLDR)) Q:'+AKMOHLDR S AKMOLAST=AKMOHLDR I $P(^(AKMOHLDR,0),U,1)=AKMODUZ S AKMOHIT=1 Q
I 'AKMOHIT S AKMOHITX=AKMOHITX+1,AKMONXT=AKMOLAST+1,AKMOHITS(AKMOHITX)=AKMOSKEY_U_AKMOKDFN_U_AKMONXT
;W !,$T(+0),?12,AKMOSKEY,?35,$S(AKMOHIT:" already ",1:" "),"assigned to <",AKMOSUSR,">." ;IHS/MFD commented out
Q
ASSGNKEY ; ASSIGN XUSR THIS SECURITY KEY
S AKMOKNAM=$P(AKMOHITS(AKMOL),"^",2),AKMOKNAM=$P(^DIC(19.1,AKMOKNAM,0),U,1),AKMONSLT=$L(AKMONSPC)
Q:AKMONSPC'="ALL"&($E(AKMOKNAM,1,AKMONSLT)'=AKMONSPC)
U IO(0) W !,AKMOSUSR,?30," ASSIGNED KEY: ",?50,AKMOKNAM
S DIE="^VA(200,",DA=AKMODUZ,DR="51///`"_$P(AKMOHITS(AKMOL),"^",2)
S DR(2,200.051)="1////.5;2////"_AKMODT_";3////"_AKMODT
D ^DIE K DIE,DR,DA
Q
AKMOSUSR ;BRJ/OHPD/TUCSON ASSIGN ALL SECURITY KEYS TO SUPER USER [ 04/02/2003 8:51 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;2.0;IHS KERNEL UTILITIES;;JUN 28, 1993
+3 ;IHS/MFD fix at ASSGNKEY+3
+4 ;IHS/MFD,JCM fix to use DIE and work with KERNEL 7
+5 ;IHS/JLS 10/31/96 fix at EN+1 for version check
+6 ;IHS/MFD FINDKEY+2, check for provider key so it isn't given out here
+7 ;IHS/JDM OK+6 THRU 8 AND ASSGNKEY+1 THRU 3, prompt for namespace or 'all' and assign keys per response.
EN ;
+1 IF "20217.18.0"'[+$GET(^DD(9.4,0,"VR"))
WRITE *7,!,"You must have KERNEL 7/FILEMAN 19 loaded to use this routine!!"
QUIT
+2 WRITE !,$TEXT(+0),*7,?12,"Please enter the name of your ""SUPER USER"".",!!,?20,"<ADAM,ADAM> // "
READ AKMOSUSR
SET AKMOSUSR=$SELECT(AKMOSUSR="":"ADAM,ADAM",1:AKMOSUSR)
+3 WRITE !,$TEXT(+0),?12,"This program will check the security key file (^DIC(19.1))",!,?12,"and assign all security keys to your ""SUPERUSER""."
+4 WRITE !!,$TEXT(+0),?12,"OK to continue <Y>es or <N>o? <No> // "
READ AKMOANS
SET AKMOANS=$SELECT(AKMOANS="":"N",1:AKMOANS)
+5 IF '(AKMOANS?1"Y".E!(AKMOANS?1"y".E))
WRITE !!,$TEXT(+0),?12,"That's a NO-GO!!"
GOTO XIT
OK ;
+1 DO ^XBKSET
SET DUZ(0)="@"
+2 WRITE !
SET AKMOXUSR=0
SET AKMODUZ=""
FOR AKMOL=0:0
SET AKMOXUSR=$ORDER(^VA(200,"B",AKMOXUSR))
IF AKMOXUSR=""
QUIT
IF AKMOXUSR=AKMOSUSR
SET AKMODUZ=$ORDER(^VA(200,"B",AKMOXUSR,AKMODUZ))
QUIT
+3 IF '+AKMODUZ
WRITE !!,*7,?5,"Cannot continue!! Superuser <",AKMOSUSR,"> was not found in the USER (^VA(200)) file."
GOTO XIT
+4 DO FINDKEYS
+5 IF '+AKMOKDFN
WRITE !!,*7,$TEXT(+0),?12,"OOPS - - Your Security Key file (^DIC(19.1)) ""B"" cross reference is missing or incorrect.",!!,?12,$TEXT(+0)," cannot continue. No action taken!!"
GOTO XIT
+6 KILL DIR
SET DIR(0)="F^1:4^K:X'?.U X"
SET DIR("A")="('ALL'=ALL) NAMESPACE? "
SET DIR("?")="Must enter 3-4 Uppercase Characters"
DO ^DIR
+7 IF X["^"!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !,"ABORTING..."
GOTO XIT
+8 SET AKMONSPC=X
+9 FOR AKMOL=1:1:AKMOHITX
DO ASSGNKEY
+10 WRITE !!,$TEXT(+0),?12,"Superuser <",AKMOSUSR,"> had or was assigned each security key."
XIT ;
+1 WRITE !!,*7,$TEXT(+0),?12,"<DONE>"
+2 KILL AKMOANS,AKMOL,AKMOLAST,AKMOHLDR,AKMOSKEY,AKMOHIT,AKMODT,AKMOXUSR,AKMODUZ,AKMOHITS,AKMOHITX,AKMOKDFN,U,X,Y,%DT
+3 QUIT
FINDKEYS ; FIND THE SECURITY KEYS IN ^DIC(19.1,
+1 SET U="^"
SET X="T"
SET (AKMOSKEY,AKMOHITX)=0
SET (%DT,AKMOKDFN)=""
DO ^%DT
SET AKMODT=Y
+2 ;F AKMOL=0:0 S AKMOSKEY=$O(^DIC(19.1,"B",AKMOSKEY)) Q:AKMOSKEY=""!(AKMOSKEY"PROVIDER") S AKMOKDFN=$O(^DIC(19.1,"B",AKMOSKEY,"")) Q:'+AKMOKDFN D FINDHLDR
+3 ;IHS/ORDC/LJF 4/14/94 REMOVED CHECK FOR PROVIDER KEY
FOR AKMOL=0:0
SET AKMOSKEY=$ORDER(^DIC(19.1,"B",AKMOSKEY))
IF AKMOSKEY=""
QUIT
SET AKMOKDFN=$ORDER(^DIC(19.1,"B",AKMOSKEY,""))
IF '+AKMOKDFN
QUIT
DO FINDHLDR
+4 QUIT
FINDHLDR ; CHECK TO SEE IF XUSR ALREADY HOLDS THE KEY
+1 ;IHS/ORDC/LJF 4/14/94 don't give provider key to programmers
IF AKMOSKEY="PROVIDER"
QUIT
+2 IF '$DATA(^VA(200,AKMODUZ,51,AKMOKDFN))
SET AKMOHITX=AKMOHITX+1
SET AKMOHITS(AKMOHITX)=AKMOSKEY_U_AKMOKDFN
+3 QUIT
+4 SET (AKMOHLDR,AKMOHIT,AKMOLAST)=0
FOR AKMOL=0:0
SET AKMOHLDR=$ORDER(^VA(200,AKMOKDFN,51,AKMOHLDR))
IF '+AKMOHLDR
QUIT
SET AKMOLAST=AKMOHLDR
IF $PIECE(^(AKMOHLDR,0),U,1)=AKMODUZ
SET AKMOHIT=1
QUIT
+5 IF 'AKMOHIT
SET AKMOHITX=AKMOHITX+1
SET AKMONXT=AKMOLAST+1
SET AKMOHITS(AKMOHITX)=AKMOSKEY_U_AKMOKDFN_U_AKMONXT
+6 ;W !,$T(+0),?12,AKMOSKEY,?35,$S(AKMOHIT:" already ",1:" "),"assigned to <",AKMOSUSR,">." ;IHS/MFD commented out
+7 QUIT
ASSGNKEY ; ASSIGN XUSR THIS SECURITY KEY
+1 SET AKMOKNAM=$PIECE(AKMOHITS(AKMOL),"^",2)
SET AKMOKNAM=$PIECE(^DIC(19.1,AKMOKNAM,0),U,1)
SET AKMONSLT=$LENGTH(AKMONSPC)
+2 IF AKMONSPC'="ALL"&($EXTRACT(AKMOKNAM,1,AKMONSLT)'=AKMONSPC)
QUIT
+3 USE IO(0)
WRITE !,AKMOSUSR,?30," ASSIGNED KEY: ",?50,AKMOKNAM
+4 SET DIE="^VA(200,"
SET DA=AKMODUZ
SET DR="51///`"_$PIECE(AKMOHITS(AKMOL),"^",2)
+5 SET DR(2,200.051)="1////.5;2////"_AKMODT_";3////"_AKMODT
+6 DO ^DIE
KILL DIE,DR,DA
+7 QUIT
