XBBPI	; IHS/ADC/GTH - BUILD PACKAGE PRE-INIT ROUTINE ; [ 02/07/97   3:02 PM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	;
	; This routine builds a pre-init routine for a specified
	; package. The pre-init routine will delete FileMan
	; dictionaries being created by the package.  Data
	; globals and templates will be saved.
	;
START	;
	D ^XBKVAR
	W !!,"This routine will build a pre-init routine for the specified package."
	W !,"The pre-init routine will call XBKD to delete the FileMan dictionaries"
	W !,"being created by the package.  Data globals and templates will be saved.",!!
	F XBBPLOOP=0:0 D PACKAGE Q:Y<0  D BUILD
	KILL %,XBBPLOOP
	Q
	;
PACKAGE	;
	S DIC="^DIC(9.4,",DIC(0)="AEMQ"
	D ^DIC
	KILL DIC
	Q
	;
BUILD	;
	S XBBPDFN=+Y,XBBPPRFX=$P(^DIC(9.4,XBBPDFN,0),U,2),Y=DT
	D DD^%DT
	S XBBPVER=$G(^DIC(9.4,XBBPDFN,"VERSION"))_";"_$P(^DIC(9.4,XBBPDFN,0),U,1)_";;"_Y,XBBPPGM=XBBPPRFX_"PREI"
	D CHECKRTN
	I XBBPFLG D EOJ3 W !!,"Bye",! Q
	KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
	W "."
	S (XBBPX,XBBPFLE)=0
	F XBBPL=0:0 S XBBPFLE=$O(^DIC(9.4,XBBPDFN,4,"B",XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  S ^UTILITY("XBBPI",$J,XBBPFLE)=""
	W "."
	S XBBPFLG=0,XBBPFLE=""
	F XBBPL=0:0 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  I '$D(^DIC(XBBPFLE)) S XBBPFLG=1 W !,XBBPFLE," does not exist in ^DIC!"
	I XBBPFLG W !!,"All files in package must exist.  Fix and rerun.",!! D EOJ Q
	W "."
	S XBBPFLE=""
	F XBBPL=0:0 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  S ^(XBBPFLE)="^UTILITY(""XBDSET"",$J,"_XBBPFLE_")=S^S"
	W "."
	S %DT="",X="T"
	D ^%DT
	X ^DD("DD")
	S ^UTILITY("XBBPPGM",$J,1,0)=XBBPPGM_" ; CREATED BY XBBPI ON "_Y
	S ^UTILITY("XBBPPGM",$J,2,0)=" ;;"_XBBPVER
	F XBBPI=1:1:3 S ^UTILITY("XBBPPGM",$J,XBBPI+2,0)=$P($T(DTA+XBBPI),";;",2,99)
	S XBBPFLE=0
	F XBBPI=6:1 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE  S XBBPY=^(XBBPFLE),^UTILITY("XBBPPGM",$J,XBBPI,0)=" ;;"_XBBPY
	S DIE="^UTILITY(""XBBPPGM"",$J,",X=XBBPPGM,XCN=0
	X ^%ZOSF("SAVE")
	D EOJ
	Q
	;
CHECKRTN	;
	S XBBPFLG=0
	Q:'$D(^DD("OS"))#2
	Q:'$D(^DD("OS",^DD("OS"),18))#2  S X=XBBPPGM X ^(18)
	E  Q
CR2	;
	W !!,XBBPPGM," already exists.  Want to recreate it (Y/N) Y//"
	D YN^DICN
	S:$E(%Y)="N" XBBPFLG=1
	Q
	;
EOJ	;
	W !!,"Routine ",XBBPPGM," has been filed.",!!
	I '$D(^DIC(9.4,XBBPDFN,"INI")) D EOJ2
	I $D(^DIC(9.4,XBBPDFN,"INI")),$P(^("INI"),U)="" D EOJ2 I 1
	E  I $D(^DIC(9.4,XBBPDFN,"INI")),$P(^("INI"),U)'=XBBPPGM W !!,"Package ",XBBPPRFX," has a pre-initialization routine entry but it is ",$P(^("INI"),U),"!"
	D EOJ3
	Q
	;
EOJ2	;
	W !,"Package ",XBBPPRFX," has no pre-initialization routine entry!",!
	Q
	;
EOJ3	;
	KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
	KILL %,%DT,DIE,XCN
	KILL XBBPDFN,XBBPFLE,XBBPFLG,XBBPI,XBBPL,XBBPP,XBBPPGM,XBBPPRFX,XBBPX,XBBPY,XBBPVER
	Q
	;
DTA	;
	;; K ^UTILITY("XBDSET",$J) F XBBPI=1:1 S XBBPIX=$P($T(Q+XBBPI),";;",2) Q:XBBPIX=""  S XBBPIY=$P(XBBPIX,"=",2,99),XBBPIX=$P(XBBPIX,"=",1) S @XBBPIX=XBBPIY
	;; K XBBPI,XBBPIX,XBBPIY D EN2^XBKD
	;;Q Q