source: IHS-VA_UTILITIES-XB/trunk/XBBPI.m@ 1368

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

Modified directory structure; moved routines.

File size: 3.0 KB
Line 
1XBBPI ; 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 ;
9START ;
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 ;
18PACKAGE ;
19 S DIC="^DIC(9.4,",DIC(0)="AEMQ"
20 D ^DIC
21 KILL DIC
22 Q
23 ;
24BUILD ;
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 ;
55CHECKRTN ;
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
60CR2 ;
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 ;
66EOJ ;
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 ;
74EOJ2 ;
75 W !,"Package ",XBBPPRFX," has no pre-initialization routine entry!",!
76 Q
77 ;
78EOJ3 ;
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 ;
84DTA ;
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
Note: See TracBrowser for help on using the repository browser.