XBPKDEL	; IHS/ADC/GTH - REMOVE OPTIONS, INPUT,SORT,PRINT TEMPLATES, HELP FRAMES, BULLETINS, FUNCTIONS, AND IF INDICATED, SECURITY KEYS FOR A PACKAGE ; [ 12/11/2000   3:13 PM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - Also delete Forms, Protocols, and List templates. Add support for routine XBPKDEL1.
	;
	; XBPKNSP must be set to the namespace, e.g. "AICD" if this
	; routine is called from a preinit.
	;
	; If you want security keys deleted, set XBPKEY=1 if this
	; routine is called from a preinit.
	;
	; Call LIST^XBPKDEL to list all namespaced options,
	; templates, etc.
	;
	; Call RUN^XBPKDEL to delete all namespaced options,
	; templates, etc.
	;
	; The RUN and LIST entry points are for programmer use and
	; are not to be called from a preinit.  Preinit calls
	; XBPKDEL directly with variables set as indicated above.
	;
START	;
	I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
	I '$D(XBPKNSP) W !,*7,"Namespace variable does not exist!" Q
	S U="^",DUZ(0)="@",XBPKQUIT=XBPKNSP_"{"
	I $D(XBPKRUN) S XBPKDOC="This routine"
	E  S XBPKDOC="The preinit for this package"
	D ASK
	G:XBPKSTP A
	; F XBPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D DELETE ; XB*3*8
	F XBPKGLO="^DIBT(","^DIPT(","^SD(409.61,","^DIE(","^DIST(.403,","^DIC(19,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC"",","^ORD(101," D DELETE ; XB*3*8
	I $D(XBPKEY) S XBPKGLO="^DIC(19.1," D DELETE ;DELETE SECURITY KEYS WITH THIS NAMESPACE
	W !
	S %=1 D ENASK^XQ3 ;CALL TO FIX OPTION POINTERS
	W !,*7,"Be sure to give users a new primary menu option if one of the menu options",!,"deleted within this namespace had been used as a primary menu option."
A	;
	D EOJ
	Q
	;
ASK	;ASK USER IF WANTS TO CONTINUE
	S XBPKSTP=0
	; W !!,*7,XBPKDOC," will delete all options, sort, input," ; XB*3*8
	; W !,"and print templates, bulletins, functions, " ; XB*3*8
	; W $S($D(XBPKEY):"help frames and security keys",1:"and help frames") ; XB*3*8
	; W !,"namespaced '",XBPKNSP,"' that are currently in this UCI.  " ; XB*3*8
	; XB*3*8 begin block
	KILL ^UTILITY($J,"W")
	NEW DIW,DIWL,DIWR,DIWF,DIWT
	S DIWL=1,DIWR=(IOM-10),DIWF="W"
	W !!,*7
	S X=XBPKDOC
	D ^DIWP
	S X="will delete all options, templates (sort, input, list, and print), forms, bulletins, functions, protocols, "
	D ^DIWP
	S X=$S($D(XBPKEY):"help frames and security keys",1:"and help frames")_" namespaced '"_XBPKNSP_"' that are currently in this UCI."
	D ^DIWP,^DIWW
	KILL ^UTILITY($J,"W")
	; XB*3*8 end block
	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 package initialization.",! G ASK
	I %=2!(%=-1) W:'$D(XBPKRUN) !!,*7,"Package initialization process stopped!" S XBPKSTP=1 KILL DIFQ ;KILLING DIFQ STOPS THE INITIALIZATION PROCESS
	W !
	Q
	;
DELETE	;
	W !!,"Now deleting `",XBPKNSP,"' namespaced ",$P(@(XBPKGLO_"0)"),U),"S..."
	S XBPKNSPC=XBPKNSP
	I $D(@(XBPKGLO_"""B"",XBPKNSPC)")) S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")),DIK=XBPKGLO D ^DIK KILL DIK,DA
	; F L=0:0 S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSPC)")) Q:XBPKNSPC=""!(XBPKNSPC]XBPKQUIT)  S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")) W !?3,XBPKNSPC S DIK=XBPKGLO D ^DIK KILL DIK,DA ; XB*3*8
	F L=0:0 S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSPC)")) Q:XBPKNSPC=""!(XBPKNSPC]XBPKQUIT)  S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")) W !?3,XBPKNSPC D  S DIK=XBPKGLO D ^DIK KILL DIK,DA ; XB*3*8
	. ; XB*3*8 begin block
	. ; Delete key from holders
	. Q:XBPKGLO'="^DIC(19.1,"
	. S XBPKKIEN=DA
	. NEW DA
	. S XBPKHIEN=0
	. F  S XBPKHIEN=$O(^XUSEC(XBPKNSPC,XBPKHIEN)) Q:'XBPKHIEN  D
	.. S DIE="^VA(200,XBPKHIEN,51,",DA(1)=XBPKHIEN,DA=XBPKKIEN,DR=".01///@"
	.. D ^DIE
	.. Q
	. Q
	; XB*3*8 end block
	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 namespaced items in current UCI",!
	D GETNSP
	G:XBPKNSP["^"!("^"[XBPKNSP) EOJ
	; W !!,"Listing of items in namespace ",XBPKNSP,! ; XB*3*8
	W @IOF,!!,"Listing of items in namespace ",XBPKNSP,! ; XB*3*8
	W "--------------------------------------",!
	S XBPKQUIT=XBPKNSP_"{",XBPKF=0
	; F XBPKGLO="^DIBT(","^DIPT(","^DIE(","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC""," D LIST2 ; XB*3*8
	F XBPKGLO="^DIBT(","^DIPT(","^SD(409.61,","^DIE(","^DIST(.403,","^DIC(19,","^DIC(19.1,","^XMB(3.6,","^DIC(9.2,","^DD(""FUNC"",","^ORD(101," D LIST2 ; XB*3*8
	G EOJ
	;
LIST2	;
	S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSP)"))
	I $P(XBPKNSPC,XBPKNSP)]"" W:XBPKF ! S XBPKF=0 W "NO ",$P(@(XBPKGLO_"0)"),"^",1),"S",! Q
	S XBPKF=1
	W !,$P(@(XBPKGLO_"0)"),"^",1),"S",!
	S XBPKNSPC=XBPKNSP
	F  Q:$D(DUOUT)  S XBPKNSPC=$O(@(XBPKGLO_"""B"",XBPKNSPC)")) Q:XBPKNSPC=""!(XBPKNSPC]XBPKQUIT)  S DA=$O(@(XBPKGLO_"""B"",XBPKNSPC,"""")")) W ?3,XBPKNSPC,! I $Y>(IOSL-5) D PAUSE
	Q
	;
PAUSE	; Screen control for LIST
	S Y=$$DIR^XBDIR("E")
	; W @IOF ; XB*3*8
	W @IOF,! ; XB*3*8
	Q
	;
RUN	; ENTRY POINT FOR ACQUIRING CONTROL ARGUMENTS AND DOING DELETIONS
	I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
	I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
	W !!,"Utility to delete all namespaced items in current UCI",!
	D GETNSP
	G:XBPKNSP["^"!("^"[XBPKNSP) EOJ
	D GETKEY
	I $D(XBPKEY),XBPKEY="^" G EOJ
	S XBPKRUN=""
	G XBPKDEL
	;
GETNSP	; CODE TO ACQUIRE NAMESPACE
	R "Namespace to process: ",XBPKNSP:600,!
	Q:("^"[XBPKNSP)!(XBPKNSP["^")
	I XBPKNSP["?" W "Enter null line or '^' to quit.",!
	I XBPKNSP'?1U1.7UN W "Namespace must begin with an upper-case letter and",!," consist only of upper-case letters and numbers",! G GETNSP
	Q
	;
GETKEY	; CODE TO ACQUIRE SECURITY KEY FLAG
	W "Do you want to delete security keys"
	S %=1
	D YN^DICN
	I %=0 W !!,"If you answer with a ""NO"" security keys will not be deleted.",! G ASK
	I %=2!(%=-1) S:%=-1 XBPKEY="^"
	E  S XBPKEY=""
	Q
	;
EOJ	;EP - Clean up after this routine or XBPKDEL1 ; XB*3*8
	; KILL XBPKF,XBPKGLO,XBPKEY,XBPKSTP,XBPKNSP,XBPKNSPC,XBPKQUIT,XBPKRUN,XBPKDOC,DUOUT,DTOUT ; XB*3*8
	KILL XBPKF,XBPKGLO,XBPKHIEN,XBPKKIEN,XBPKEY,XBPKSTP,XBPKNSP,XBPKNSPC,XBPKQUIT,XBPKRUN,XBPKDOC,DUOUT,DTOUT ; XB*3*8
	Q
	;