- 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 ;
