| 1 | XBBPI ; IHS/ADC/GTH - BUILD PACKAGE PRE-INIT ROUTINE ; [ 02/07/97 3:02 PM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine builds a pre-init routine for a specified
|
|---|
| 5 | ; package. The pre-init routine will delete FileMan
|
|---|
| 6 | ; dictionaries being created by the package. Data
|
|---|
| 7 | ; globals and templates will be saved.
|
|---|
| 8 | ;
|
|---|
| 9 | START ;
|
|---|
| 10 | D ^XBKVAR
|
|---|
| 11 | W !!,"This routine will build a pre-init routine for the specified package."
|
|---|
| 12 | W !,"The pre-init routine will call XBKD to delete the FileMan dictionaries"
|
|---|
| 13 | W !,"being created by the package. Data globals and templates will be saved.",!!
|
|---|
| 14 | F XBBPLOOP=0:0 D PACKAGE Q:Y<0 D BUILD
|
|---|
| 15 | KILL %,XBBPLOOP
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | PACKAGE ;
|
|---|
| 19 | S DIC="^DIC(9.4,",DIC(0)="AEMQ"
|
|---|
| 20 | D ^DIC
|
|---|
| 21 | KILL DIC
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | BUILD ;
|
|---|
| 25 | S XBBPDFN=+Y,XBBPPRFX=$P(^DIC(9.4,XBBPDFN,0),U,2),Y=DT
|
|---|
| 26 | D DD^%DT
|
|---|
| 27 | S XBBPVER=$G(^DIC(9.4,XBBPDFN,"VERSION"))_";"_$P(^DIC(9.4,XBBPDFN,0),U,1)_";;"_Y,XBBPPGM=XBBPPRFX_"PREI"
|
|---|
| 28 | D CHECKRTN
|
|---|
| 29 | I XBBPFLG D EOJ3 W !!,"Bye",! Q
|
|---|
| 30 | KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
|
|---|
| 31 | W "."
|
|---|
| 32 | S (XBBPX,XBBPFLE)=0
|
|---|
| 33 | F XBBPL=0:0 S XBBPFLE=$O(^DIC(9.4,XBBPDFN,4,"B",XBBPFLE)) Q:XBBPFLE'=+XBBPFLE S ^UTILITY("XBBPI",$J,XBBPFLE)=""
|
|---|
| 34 | W "."
|
|---|
| 35 | S XBBPFLG=0,XBBPFLE=""
|
|---|
| 36 | 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!"
|
|---|
| 37 | I XBBPFLG W !!,"All files in package must exist. Fix and rerun.",!! D EOJ Q
|
|---|
| 38 | W "."
|
|---|
| 39 | S XBBPFLE=""
|
|---|
| 40 | F XBBPL=0:0 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE S ^(XBBPFLE)="^UTILITY(""XBDSET"",$J,"_XBBPFLE_")=S^S"
|
|---|
| 41 | W "."
|
|---|
| 42 | S %DT="",X="T"
|
|---|
| 43 | D ^%DT
|
|---|
| 44 | X ^DD("DD")
|
|---|
| 45 | S ^UTILITY("XBBPPGM",$J,1,0)=XBBPPGM_" ; CREATED BY XBBPI ON "_Y
|
|---|
| 46 | S ^UTILITY("XBBPPGM",$J,2,0)=" ;;"_XBBPVER
|
|---|
| 47 | F XBBPI=1:1:3 S ^UTILITY("XBBPPGM",$J,XBBPI+2,0)=$P($T(DTA+XBBPI),";;",2,99)
|
|---|
| 48 | S XBBPFLE=0
|
|---|
| 49 | F XBBPI=6:1 S XBBPFLE=$O(^UTILITY("XBBPI",$J,XBBPFLE)) Q:XBBPFLE'=+XBBPFLE S XBBPY=^(XBBPFLE),^UTILITY("XBBPPGM",$J,XBBPI,0)=" ;;"_XBBPY
|
|---|
| 50 | S DIE="^UTILITY(""XBBPPGM"",$J,",X=XBBPPGM,XCN=0
|
|---|
| 51 | X ^%ZOSF("SAVE")
|
|---|
| 52 | D EOJ
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | CHECKRTN ;
|
|---|
| 56 | S XBBPFLG=0
|
|---|
| 57 | Q:'$D(^DD("OS"))#2
|
|---|
| 58 | Q:'$D(^DD("OS",^DD("OS"),18))#2 S X=XBBPPGM X ^(18)
|
|---|
| 59 | E Q
|
|---|
| 60 | CR2 ;
|
|---|
| 61 | W !!,XBBPPGM," already exists. Want to recreate it (Y/N) Y//"
|
|---|
| 62 | D YN^DICN
|
|---|
| 63 | S:$E(%Y)="N" XBBPFLG=1
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | EOJ ;
|
|---|
| 67 | W !!,"Routine ",XBBPPGM," has been filed.",!!
|
|---|
| 68 | I '$D(^DIC(9.4,XBBPDFN,"INI")) D EOJ2
|
|---|
| 69 | I $D(^DIC(9.4,XBBPDFN,"INI")),$P(^("INI"),U)="" D EOJ2 I 1
|
|---|
| 70 | 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),"!"
|
|---|
| 71 | D EOJ3
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | EOJ2 ;
|
|---|
| 75 | W !,"Package ",XBBPPRFX," has no pre-initialization routine entry!",!
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | EOJ3 ;
|
|---|
| 79 | KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
|
|---|
| 80 | KILL %,%DT,DIE,XCN
|
|---|
| 81 | KILL XBBPDFN,XBBPFLE,XBBPFLG,XBBPI,XBBPL,XBBPP,XBBPPGM,XBBPPRFX,XBBPX,XBBPY,XBBPVER
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | DTA ;
|
|---|
| 85 | ;; 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
|
|---|
| 86 | ;; K XBBPI,XBBPIX,XBBPIY D EN2^XBKD
|
|---|
| 87 | ;;Q Q
|
|---|
