source: IHS-VA_UTILITIES-XB/trunk/XBKERCLN.m@ 1400

Last change on this file since 1400 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.6 KB
Line 
1XBKERCLN ; 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 ;
15PKDEL ;
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 ;
22ASK ;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 ;
34DELETE ;
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 ;
41LIST ; 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 ;
52LIST1 ;
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 ;
60LIST2 ;
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 ;
69EOJ ;
70 KILL AUPKGLO,AUPKEY,AUPKSTP,AUPKNSP,AUPKNSPC,AUPKQUIT,AUPKRUN,AUPKDOC
71 Q
72 ;
Note: See TracBrowser for help on using the repository browser.