- 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
