| 1 | XBKERCLN ; IHS/ADC/GTH - CLEAN OUT KERNEL NAMESPACE ITEMS PRIOR TO INSTALL ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine is a modified XBPKDEL for use specifically
|
|---|
| 5 | ; to clean out KERNEL package items prior to new KERNEL
|
|---|
| 6 | ; install. This routine does not delete any security keys.
|
|---|
| 7 | ;
|
|---|
| 8 | D ^XBKVAR,ASK
|
|---|
| 9 | G:AUPKSTP EOJ
|
|---|
| 10 | F AUPKNSP="XU","XQ","XM","ZT","ZE","ZI","ZR","ZS" D PKDEL
|
|---|
| 11 | S %=1
|
|---|
| 12 | D ENASK^XQ3 ;CALL TO FIX OPTION POINTERS
|
|---|
| 13 | G EOJ
|
|---|
| 14 | ;
|
|---|
| 15 | PKDEL ;
|
|---|
| 16 | I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" G EOJ
|
|---|
| 17 | I '$D(AUPKNSP) W !,*7,"Namespace variable does not exist!" G EOJ
|
|---|
| 18 | S U="^",DUZ(0)="@",AUPKQUIT=AUPKNSP_"{"
|
|---|
| 19 | F AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D DELETE
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ASK ;ASK USER IF WANTS TO CONTINUE
|
|---|
| 23 | S AUPKSTP=0
|
|---|
| 24 | 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' "
|
|---|
| 25 | W !,"that are currently in this UCI. "
|
|---|
| 26 | W "Do you want to continue"
|
|---|
| 27 | S %=1
|
|---|
| 28 | D YN^DICN
|
|---|
| 29 | I %=0 W !!,"If you answer with a ""NO"" or a ""^"" I will stop this package deletion.",! G ASK
|
|---|
| 30 | I %=2!(%=-1) S AUPKSTP=1
|
|---|
| 31 | W !
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | DELETE ;
|
|---|
| 35 | W !!,"Now deleting `",AUPKNSP,"' namespaced ",$P(@(AUPKGLO_"0)"),U),"S..."
|
|---|
| 36 | S AUPKNSPC=AUPKNSP
|
|---|
| 37 | I $D(@(AUPKGLO_"""B"",AUPKNSPC)")) S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")),DIK=AUPKGLO D ^DIK KILL DIK,DA
|
|---|
| 38 | 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
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | LIST ; ENTRY POINT FOR LISTING NAMESPACED ITEMS
|
|---|
| 42 | I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
|
|---|
| 43 | S U="^",DUZ(0)="@"
|
|---|
| 44 | W !!,"Utility to list all Kernel namespaced items in current UCI",!
|
|---|
| 45 | D ^%ZIS
|
|---|
| 46 | G:POP EOJ
|
|---|
| 47 | U IO
|
|---|
| 48 | F AUPKNSP="XU","XQ","XM","ZT","ZE","ZI","ZR","ZS" D LIST1
|
|---|
| 49 | D ^%ZISC
|
|---|
| 50 | G EOJ
|
|---|
| 51 | ;
|
|---|
| 52 | LIST1 ;
|
|---|
| 53 | W !!,"Listing of items in namespace ",AUPKNSP,!
|
|---|
| 54 | W "--------------------------------------",!
|
|---|
| 55 | S AUPKQUIT=AUPKNSP_"{"
|
|---|
| 56 | S %=0
|
|---|
| 57 | F AUPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D LIST2
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | LIST2 ;
|
|---|
| 61 | S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSP)"))
|
|---|
| 62 | I $P(AUPKNSPC,AUPKNSP)]"" W:% ! S %=0 W "NO ",$P(@(AUPKGLO_"0)"),"^",1),"S",! Q
|
|---|
| 63 | S %=1
|
|---|
| 64 | W !,$P(@(AUPKGLO_"0)"),"^",1),"S",!
|
|---|
| 65 | S AUPKNSPC=AUPKNSP
|
|---|
| 66 | F L=0:0 S AUPKNSPC=$O(@(AUPKGLO_"""B"",AUPKNSPC)")) Q:AUPKNSPC=""!(AUPKNSPC]AUPKQUIT) S DA=$O(@(AUPKGLO_"""B"",AUPKNSPC,"""")")) W ?3,AUPKNSPC,!
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | EOJ ;
|
|---|
| 70 | KILL AUPKGLO,AUPKEY,AUPKSTP,AUPKNSP,AUPKNSPC,AUPKQUIT,AUPKRUN,AUPKDOC
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
