XBKERCLN ; IHS/ADC/GTH - CLEAN OUT KERNEL NAMESPACE ITEMS PRIOR TO INSTALL ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; This routine is a modified XBPKDEL for use specifically
; to clean out KERNEL package items prior to new KERNEL
; install. This routine does not delete any security keys.
;
D ^XBKVAR,ASK
G:AUPKSTP EOJ
F AUPKNSP="XU","XQ","XM","ZT","ZE","ZI","ZR","ZS" D PKDEL
S %=1
D ENASK^XQ3 ;CALL TO FIX OPTION POINTERS
G EOJ
;
PKDEL ;
I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" G EOJ
I '$D(AUPKNSP) W !,*7,"Namespace variable does not exist!" G EOJ
S U="^",DUZ(0)="@",AUPKQUIT=AUPKNSP_"{"
F AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D DELETE
Q
;
ASK ;ASK USER IF WANTS TO CONTINUE
S AUPKSTP=0
W !!,*7,"This routine will delete all options, sort,input,print templates,",!,"bulletins, functions, ",$S($D(AUPKEY):"help frames and security keys",1:"and help frames")," namespaced `XU,XQ,XM,ZT,ZE,ZI,ZR,ZS' "
W !,"that are currently in this UCI. "
W "Do you want to continue"
S %=1
D YN^DICN
I %=0 W !!,"If you answer with a ""NO"" or a ""^"" I will stop this package deletion.",! G ASK
I %=2!(%=-1) S AUPKSTP=1
W !
Q
;
DELETE ;
W !!,"Now deleting `",AUPKNSP,"' namespaced ",$P(@(AUPKGLO_"0)"),U),"S..."
S AUPKNSPC=AUPKNSP
I $D(@(AUPKGLO_"""B"",AUPKNSPC)")) S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")),DIK=AUPKGLO D ^DIK KILL DIK,DA
F L=0:0 S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSPC)")) Q:AUPKNSPC=""!(AUPKNSPC]AUPKQUIT) S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")) W !?3,AUPKNSPC S DIK=AUPKGLO D ^DIK KILL DIK,DA
Q
;
LIST ; ENTRY POINT FOR LISTING NAMESPACED ITEMS
I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
S U="^",DUZ(0)="@"
W !!,"Utility to list all Kernel namespaced items in current UCI",!
D ^%ZIS
G:POP EOJ
U IO
F AUPKNSP="XU","XQ","XM","ZT","ZE","ZI","ZR","ZS" D LIST1
D ^%ZISC
G EOJ
;
LIST1 ;
W !!,"Listing of items in namespace ",AUPKNSP,!
W "--------------------------------------",!
S AUPKQUIT=AUPKNSP_"{"
S %=0
F AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D LIST2
Q
;
LIST2 ;
S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSP)"))
I $P(AUPKNSPC,AUPKNSP)]"" W:% ! S %=0 W "NO ",$P(@(AUPKGLO_"0)"),"^",1),"S",! Q
S %=1
W !,$P(@(AUPKGLO_"0)"),"^",1),"S",!
S AUPKNSPC=AUPKNSP
F L=0:0 S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSPC)")) Q:AUPKNSPC=""!(AUPKNSPC]AUPKQUIT) S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")) W ?3,AUPKNSPC,!
Q
;
EOJ ;
KILL AUPKGLO,AUPKEY,AUPKSTP,AUPKNSP,AUPKNSPC,AUPKQUIT,AUPKRUN,AUPKDOC
Q
;
XBKERCLN ; IHS/ADC/GTH - CLEAN OUT KERNEL NAMESPACE ITEMS PRIOR TO INSTALL ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; This routine is a modified XBPKDEL for use specifically
+4 ; to clean out KERNEL package items prior to new KERNEL
+5 ; install. This routine does not delete any security keys.
+6 ;
+7 DO ^XBKVAR
DO ASK
+8 IF AUPKSTP
GOTO EOJ
+9 FOR AUPKNSP="XU","XQ","XM","ZT","ZE","ZI","ZR","ZS"
DO PKDEL
+10 SET %=1
+11 ;CALL TO FIX OPTION POINTERS
DO ENASK^XQ3
+12 GOTO EOJ
+13 ;
PKDEL ;
+1 IF '$DATA(^DIC(0))
WRITE !,*7,"Filemanager does not exist in this UCI!"
GOTO EOJ
+2 IF '$DATA(AUPKNSP)
WRITE !,*7,"Namespace variable does not exist!"
GOTO EOJ
+3 SET U="^"
SET DUZ(0)="@"
SET AUPKQUIT=AUPKNSP_"{"
+4 FOR AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC"","
DO DELETE
+5 QUIT
+6 ;
ASK ;ASK USER IF WANTS TO CONTINUE
+1 SET AUPKSTP=0
+2 WRITE !!,*7,"This routine will delete all options, sort,input,print templates,",!,"bulletins, functions, ",$SELECT($DATA(AUPKEY):"help frames and security keys",1:"and help frames")," namespaced `XU,XQ,XM,ZT,ZE,ZI,ZR,ZS' "
+3 WRITE !,"that are currently in this UCI. "
+4 WRITE "Do you want to continue"
+5 SET %=1
+6 DO YN^DICN
+7 IF %=0
WRITE !!,"If you answer with a ""NO"" or a ""^"" I will stop this package deletion.",!
GOTO ASK
+8 IF %=2!(%=-1)
SET AUPKSTP=1
+9 WRITE !
+10 QUIT
+11 ;
DELETE ;
+1 WRITE !!,"Now deleting `",AUPKNSP,"' namespaced ",$PIECE(@(AUPKGLO_"0)"),U),"S..."
+2 SET AUPKNSPC=AUPKNSP
+3 IF $DATA(@(AUPKGLO_"""B"",AUPKNSPC)"))
SET DA=$ORDER(@(AUPKGLO_"""B"",AUPKNSPC,"""")"))
SET DIK=AUPKGLO
DO ^DIK
KILL DIK,DA
+4 FOR L=0:0
SET AUPKNSPC=$ORDER(@(AUPKGLO_"""B"",AUPKNSPC)"))
IF AUPKNSPC=""!(AUPKNSPC]AUPKQUIT)
QUIT
SET DA=$ORDER(@(AUPKGLO_"""B"",AUPKNSPC,"""")"))
WRITE !?3,AUPKNSPC
SET DIK=AUPKGLO
DO ^DIK
KILL DIK,DA
+5 QUIT
+6 ;
LIST ; ENTRY POINT FOR LISTING NAMESPACED ITEMS
+1 IF '$DATA(^DIC(0))
WRITE !,*7,"Filemanager does not exist in this UCI!"
QUIT
+2 SET U="^"
SET DUZ(0)="@"
+3 WRITE !!,"Utility to list all Kernel namespaced items in current UCI",!
+4 DO ^%ZIS
+5 IF POP
GOTO EOJ
+6 USE IO
+7 FOR AUPKNSP="XU","XQ","XM","ZT","ZE","ZI","ZR","ZS"
DO LIST1
+8 DO ^%ZISC
+9 GOTO EOJ
+10 ;
LIST1 ;
+1 WRITE !!,"Listing of items in namespace ",AUPKNSP,!
+2 WRITE "--------------------------------------",!
+3 SET AUPKQUIT=AUPKNSP_"{"
+4 SET %=0
+5 FOR AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC"","
DO LIST2
+6 QUIT
+7 ;
LIST2 ;
+1 SET AUPKNSPC=$ORDER(@(AUPKGLO_"""B"",AUPKNSP)"))
+2 IF $PIECE(AUPKNSPC,AUPKNSP)]""
IF %
WRITE !
SET %=0
WRITE "NO ",$PIECE(@(AUPKGLO_"0)"),"^",1),"S",!
QUIT
+3 SET %=1
+4 WRITE !,$PIECE(@(AUPKGLO_"0)"),"^",1),"S",!
+5 SET AUPKNSPC=AUPKNSP
+6 FOR L=0:0
SET AUPKNSPC=$ORDER(@(AUPKGLO_"""B"",AUPKNSPC)"))
IF AUPKNSPC=""!(AUPKNSPC]AUPKQUIT)
QUIT
SET DA=$ORDER(@(AUPKGLO_"""B"",AUPKNSPC,"""")"))
WRITE ?3,AUPKNSPC,!
+7 QUIT
+8 ;
EOJ ;
+1 KILL AUPKGLO,AUPKEY,AUPKSTP,AUPKNSP,AUPKNSPC,AUPKQUIT,AUPKRUN,AUPKDOC
+2 QUIT
+3 ;
