source: cprs/branches/tmg-cprs/m_files/TMGXPDL1.m@ 1548

Last change on this file since 1548 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 11.4 KB
Line 
1TMGXPDL1 ;TMG/kst/Custom version of XPDIL1 ;09/17/08
2 ;;1.0;TMG-LIB;**1**;09/17/08
3
4 ;"Original header....
5 ;"XPDIL1 ;SFISC/RSD - cont. of load Distribution Global ;11/14/2002 07:35
6 ;" ;;8.0;KERNEL;**15,17,39,41,44,66,68,76,85,100,108,229**;Jul 10, 1995
7
8PKG(XPDA,Option,Msg)
9 ;"Purspose: Check Package file
10 ;"Input: Options -- PASS BY REFERENCE. Entries are required unless marked optional
11 ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
12 ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
13 ;" Errors are stored in Msg("ERROR",x)=Message
14 ;" Msg("ERROR")=count of last error
15 ;" Message are store in Msg(x)=Message
16 ;" Msg=count of last message+1
17
18 N XPD,XPDCP,XPDNM,XPDNOQUE,XPDPKG,X,Y,%
19 new abort set abort=0
20 S XPDNM=$P(XPDT(XPDIT),U,2)
21 do AddMsg^TMGPAT2(" "_XPDNM,0,.Msg)
22
23 ;"check KIDS version against sites version, skip if package is Kernel
24 I $$PKG^TMGXPDUT(XPDNM)'["KERNEL" D ;"not interactive routine
25 . ;"this is part of a Kernel multi package
26 . Q:$O(XPDT("NM","KERNEL"))["KERNEL"
27 . S Y=$G(^XTMP("XPDI",XPDA,"VER"))
28 . I $$VERSION^TMGXPDUT("XU")<Y do
29 . . do AddMsg^TMGPAT2("Need Version "_+Y_" of KERNEL!",1,.Msg)
30 . . S XPDQUIT=1
31 . I $$VERSION^TMGXPDUT("VA FILEMAN")<$P(Y,U,2) do
32 . . do AddMsg^TMGPAT2("Need Version "_+$P(Y,U,2)_" of VA FILEMAN!",1,.Msg)
33 . . S XPDQUIT=1
34 I $D(XPDQUIT) set abort=1 goto PCKDone
35
36 ;"get national package name
37 S %=$O(^XTMP("XPDI",XPDA,"PKG",0))
38 set XPDPKG(0)=$G(^(+%,0))
39 set XPDPKG=%
40 ;"XPDPKG=new ien^old ien
41 I XPDPKG D S XPDPKG=+Y_U_XPDPKG
42 . N D,DIC
43 . S DIC="^DIC(9.4,",DIC(0)="X",X=$P(XPDPKG(0),U)
44 . D ^DIC Q:Y>0
45 . ;"if lookup fails try Prefix, C x-ref
46 . S X=$P(XPDPKG(0),U,2),D="C"
47 . D IX^DIC
48
49 ;"add package to Install file
50 I XPDPKG>0 do
51 . S XPD(9.7,XPDA_",",1)=+XPDPKG
52 . D FILE^DIE("","XPD")
53
54 ;"XPDSKPE= does site want to run Environ. Check
55 I '$G(XPDSKPE),($$ENV(0,.Msg)=1) goto PCKDone
56
57 ;"global package can't have pre or post inits
58 if $D(XPDGP) goto PCKDone
59
60 ;"create pre-init checkpoint
61 S XPDCP="INI"
62 I '$$NEWCP^TMGXPDUT("XPD PREINSTALL COMPLETED") set abort=1 goto PCKDone
63 S %=$$INRTN("INI")
64
65 ;"check for routine, use as call back
66 I $L(%),'$$NEWCP^TMGXPDUT("XPD PREINSTALL STARTED",%) set abort=1 goto PCKDone
67
68 ;"create post-init checkpoint
69 S XPDCP="INIT"
70 I '$$NEWCP^TMGXPDUT("XPD POSTINSTALL COMPLETED") set abort=1 goto PCKDone
71 S %=$$INRTN("INIT")
72
73 I $L(%),'$$NEWCP^TMGXPDUT("XPD POSTINSTALL STARTED",%) set abort=1 goto PCKDone
74 ;"create fileman and components check points and file rest of data
75 do XPCK^XPDIK("FIA")
76 do XPCK^XPDIK("KRN")
77PCKDone
78 if abort=1 do
79 . do AddMsg^TMGPAT2("Aborting",1,.Msg)
80 . do ABORT^TMGXPDI(XPDA,1,,.Msg)
81
82 Q
83
84INST(XPDNM,Option,Msg)
85 ;"Purpose: add to Install file
86 ;"Input: XPDNM -- Name to match agains .01 field from file 9.7
87 ;" Options -- PASS BY REFERENCE. Entries are required unless marked optional
88 ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
89 ;" when question normally asked of user.
90 ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
91 ;" Errors are stored in Msg("ERROR",x)=Message
92 ;" Msg("ERROR")=count of last error
93 ;" Message are store in Msg(x)=Message
94 ;" Msg=count of last message+1
95 ;"Output:
96 ;"Result: 0=error, or IEN in Install File (9.7) of newly added entry
97
98 N %X,DIC,DIR,DIRUT,DLAYGO,X,XPD,XPDA,XPDIE,XPDDIQ,Y,SH
99
100 ;"check if Build was already installed
101 ;"XPD=0 abort install, else XPD=ien in Install file
102 I $D(^XPD(9.7,"B",XPDNM)) do
103 . new IEN set IEN=$order(^XPD(9.7,"B",XPDNM,"")) ;"//kt added
104 . ;"set XPDQUIT=1 ;"//kt added
105 . S (SH,Y)=0
106 . do AddMsg^TMGPAT2("Build "_XPDNM_" has been loaded before [IEN #"_IEN_" in File INSTALL (9.7)]",0,.Msg)
107 . ;"do AddMsg^TMGPAT2("Here is when: ",0,.Msg)
108 . F S Y=$O(^XPD(9.7,"B",XPDNM,Y)) Q:'Y D
109 . . Q:'$D(^XPD(9.7,Y,0)) S %=^(0)
110 . . ;"do AddMsg^TMGPAT2(" "_$P(%,U),0,.Msg)
111 . . I $P(%,U,9)<3,$D(^XTMP("XPDI",Y)) do quit
112 . . . do AddMsg^TMGPAT2(" **Transport Global already exists**",0,.Msg)
113 . . . S XPD=0
114 . . S %X=$X
115 . . do AddMsg^TMGPAT2(" "_$$EXTERNAL^DILFD(9.7,.02,"",$P(%,U,9)),0,.Msg)
116 . . do AddMsg^TMGPAT2(" "_$P(%,U)_" was loaded on "_$$FMTE^XLFDT($P($G(^XPD(9.7,Y,1)),U)),0,.Msg)
117 . Q:$D(XPD) ;"quit if transport global exist
118 . set XPD=0 ;"signal quit -- //kt added
119 if $D(XPD) set XPDA=XPD goto INSTDone
120
121 ;"Add to Install file, must be new
122 S DIC="^XPD(9.7,",DIC(0)="XL",DLAYGO=9.7,X=""""_XPDNM_""""
123 D ^DIC
124 I Y<0 do goto INSTDone
125 . S SH=0
126 . do AddMsg^TMGPAT2("Can't ADD Build "_XPDNM_" to Install File",1,.Msg)
127 . ;"do AddMsg^TMGPAT2($piece(Y,"^",2)_" already exists in INSTALLATION file (9.7), IEN=#"_+Y,1,.Msg)
128 . set XPDA=0
129
130 ;"set starting package to Y, if it is not already defined
131 S:'XPDST XPDST=+Y
132 ;"XPDT array keeps track of all packages in this distribution
133 S XPDA=+Y
134 set XPDT(XPDIT)=XPDA_U_XPDNM
135 set XPDT("DA",XPDA)=XPDIT
136 set XPDT("NM",XPDNM)=XPDIT
137 S %="XPDIE(9.7,"""_XPDA_","")"
138 set @%@(.02)=0 ;"STATUS
139 set @%@(2)=$$NOW^XLFDT ;"DATE LOADED
140 set @%@(3)=XPDST ;"STARTING PACKAGE
141 set @%@(4)=XPDIT ;"INSTALL ORDER
142 set @%@(5)="" ;"QUEUED TASK NUMBER
143 set @%@(6)=XPDST("H1") ;"FILE COMMENT
144 new TMGMSG
145 D FILE^DIE("","XPDIE","TMGMSG")
146 I '$D(SH) do ;"SH is set when some other part of INST shows the name
147 . set Msg(Msg)=" "_XPDNM,Msg=Msg+1
148INSTDone
149 Q XPDA
150
151
152
153ENV(XPDENV,Msg)
154 ;"Purpose: Enviroment check & version check
155 ;"Input-- XPDENV 0=loading distribution, 1=installing
156 ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
157 ;" Errors are stored in Msg("ERROR",x)=Message
158 ;" Msg("ERROR")=count of last error
159 ;" Message are store in Msg(x)=Message
160 ;" Msg=count of last message+1
161 ;"Output: Globally scoped variables set as follows:
162 ;" XPDQUIT quit current package install, 1=kill global, 2=leave global
163 ;" XPDQUIT(package) quit package install, 1=kill, 2=leave
164 ;" XPDABORT quit the entire distribution, 1=kill, 2=leave
165 ;"Returns: 0=ok, 1=rejected kill global, 2=rejected leave global
166
167 N %,DIR,XPDI,XPDQUIT,XPDABORT,XPDDONE,XPDGREF,XPDMBREQ
168 M X=DUZ
169 N DUZ
170 M DUZ=X
171 S DUZ(0)="@" ;"See that ENV check has full FM priv.
172 S XPDGREF="^XTMP(""XPDI"","_XPDA_",""TEMP"")"
173 S XPDMBREQ=$G(^XTMP("XPDI",XPDA,"MBREQ"))
174 S $P(^XPD(9.7,XPDA,0),U,7)=XPDMBREQ
175 ;"check version number
176 I XPDPKG>0 D I $G(XPDQUIT) D ABORT^TMGXPDI(XPDA,1,,.Msg) Q 1
177 . N DIR,DIRUT,X,Y
178 . S %=+$$VER^TMGXPDUT(XPDNM)
179 . S Y=+$G(^DIC(9.4,+XPDPKG,"VERSION"))
180 . S X=XPDNM["*"
181 . ;"If patch, version must be the same
182 . I X,%'=Y do
183 . . do AddMsg^TMGPAT2("This Patch is for Version "_%_", you are running Version "_Y,1,.Msg)
184 . . S XPDQUIT=1
185 . ;"if package, version must be greater or equal
186 . I 'X,%<Y do
187 . . do AddMsg^TMGPAT2("You have a Version greater than mine!",1,.Msg)
188 . . S XPDQUIT=1
189 . Q:'$G(XPDQUIT)
190 . I $G(XPDMBREQ) D Q
191 . . D MES^TMGXPDUT("**ABORT** Required Build "_XPDNM_", did not pass internal KIDS checks!",.Msg)
192 . . D ABRTALL^TMGXPDI(1,,.Msg)
193 . . D NONE^TMGXPDI
194 . . S XPDQUIT=0,XPDDONE=1
195 . . Q
196 . ;"NEED TO CHANGE BELOW IF GOING TO MAKE NON-INTERACTIVE...
197 . S DIR(0)="Y",DIR("A")="Want to continue installing this build",DIR("B")="NO"
198 . D ^DIR
199 . I Y K XPDQUIT
200 . Q
201 Q:$G(XPDDONE) 1
202
203 S %=$$REQB(.Msg)
204 I % S (XPDABORT,XPDREQAB)=% G ABORT
205 S %=$G(^XTMP("XPDI",XPDA,"PRE")) D:%]""
206 . do AddMsg^TMGPAT2("Will first run the Environment Check Routine, "_%,0,.Msg)
207 . D SAVE^XPDIJ(%)
208 . new saved
209 . do IOCapON^TMGKERNL
210 . D @("^"_%)
211 . do IOCapOFF^TMGKERNL("saved")
212 . if $data(saved) do AddMsg^TMGPAT2(.saved,0,.Msg)
213
214
215ABORT I $G(XPDABORT) D Q XPDABORT
216 . ;"if during load & leave global quit
217 . I 'XPDENV,XPDABORT=2 Q
218 . D ABRTALL^TMGXPDI(XPDABORT,,.Msg)
219 Q:'$D(XPDQUIT) 0
220 I $G(XPDQUIT) D ABORT^TMGXPDI(XPDA,XPDQUIT,,.Msg)
221 S XPDI=""
222
223 ;"don't do if loading & leave global, need to keep XPDT(array)
224 F S XPDI=$O(XPDQUIT(XPDI)) Q:XPDI="" D:'(XPDQUIT(XPDI)=2&'XPDENV)
225 . S %=$G(XPDT("NM",XPDI))
226 . D:% ABORT^TMGXPDI(+XPDT(%),XPDQUIT(XPDI),,.Msg)
227 S XPDQUIT=$S($G(XPDQUIT):XPDQUIT,'$O(XPDT(0))!'$D(^XTMP("XPDI",XPDA)):1,1:0)
228 Q XPDQUIT
229 ;
230
231
232REQB(Msg)
233 ;"Purpose: check for Required Builds
234 ;"Input: Msg -- PASS BY REFERENCE, an OUT PARAMETER.
235 ;" Errors are stored in Msg("ERROR",x)=Message
236 ;" Msg("ERROR")=count of last error
237 ;" Message are store in Msg(x)=Message
238 ;" Msg=count of last message+1
239 ;"returns 0=ok, 1=failed kill global, 2=failed leave global
240
241 N XPDACT,XPDBLD,XPDI,XPDQ,XPDQUIT,XPDX,XPDX0,X,Y
242 S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDQUIT=0,XPDI=0
243 Q:'$D(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"REQB")) 0
244 F S XPDI=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"REQB",XPDI)) Q:'XPDI D
245 . S XPDX0=^(XPDI,0)
246 . S XPDQ=0,XPDX=$P(XPDX0,U),XPDACT=$P(XPDX0,U,2)
247 . S X=$$PKG^TMGXPDUT(XPDX)
248 . S Y=$$VER^TMGXPDUT(XPDX)
249 . S Z=$$VERSION^TMGXPDUT(X)
250 .;"Quit if current version is greater than what we are checking for
251 . Q:Z>Y
252 . I XPDX'["*" S:Z<Y XPDQ=2
253 . E S:'$$PATCH^TMGXPDUT(XPDX) XPDQ=1
254 . ;"Quit if patch is already on system
255 . Q:'XPDQ
256 . ;"quit if patch is sequenced prior within this build
257 . I $D(XPDT("NM",XPDX)),(XPDT("NM",XPDX)<XPDT("NM",XPDNM)) S XPDQ=0 Q
258 . S XPDQUIT=$S(XPDACT>XPDQUIT:XPDACT,1:XPDQUIT)
259 . ;"XPDACT=0 warning, =1 abort & kill global, =2 abort
260 . new s set s=$S(XPDACT:"**INSTALL ABORTED**",1:"**WARNING**")_$S(XPDQ=1:" Patch ",1:" Package ")
261 . set s=s_XPDX_" is Required "_$S(XPDACT:"to install",1:"for")_" this package!!"
262 . do AddMsg^TMGPAT2(s,1,.Msg)
263 Q:'XPDQUIT 0
264 ;"Don't do if leave global and loading
265 D:'(XPDQUIT=2&'XPDENV) ABORT^TMGXPDI(XPDA,XPDQUIT,,.Msg)
266 Q XPDQUIT
267 ;
268
269INRTN(X)
270 ;"return a routine that can be run
271 N Y
272 S Y=$G(^XTMP("XPDI",XPDA,X)) Q:Y="" ""
273 S Y=$S(Y["^":Y,1:"^"_Y)
274 Q Y
Note: See TracBrowser for help on using the repository browser.