1 | TMGXPDL1 ;TMG/kst/Custom version of XPDIL1 ;09/17/08
|
---|
2 | ;;1.0;TMG-LIB;**1**;09/17/08
|
---|
3 |
|
---|
4 | ;"Original header....
|
---|
5 | ;"XPDI ;SFISC/RSD - Install Process ;9/16/02 13:29
|
---|
6 | ;" ;;8.0;KERNEL;**10,21,39,41,44,58,68,108,145,184,229**;Jul 10, 1995
|
---|
7 |
|
---|
8 | SCRN()
|
---|
9 | new result set result=0
|
---|
10 | write "#",Y,": ",$P(^(0),U,1)
|
---|
11 | write " STATUS="
|
---|
12 | new s set s=$P(^(0),U,9)
|
---|
13 | write $s(s=0:"Loaded",s=1:"Queued",s=2:"Started",s=3:"completed",s=4:"de-installed",1:"??"),!
|
---|
14 | I $P(^(0),U,9) goto SDone
|
---|
15 | write "INSTALL ORDER=",$P(^(0),U,5)," STARTING PACKAGE=",$P(^(0),U,4),!
|
---|
16 | write "^XPD(9.7,""ASP"",Y,*): ",!
|
---|
17 | if $data(^XPD(9.7,"ASP",Y)) zwr ^XPD(9.7,"ASP",Y,*)
|
---|
18 | else write "(empty)",!
|
---|
19 | I '$D(^XPD(9.7,"ASP",Y,1,Y)) goto SDone
|
---|
20 | write "^XTMP(""XPDI"",Y):",!
|
---|
21 | if $data(^XTMP("XPDI",Y)) zwr ^XTMP("XPDI",Y)
|
---|
22 | else write "(empty)",!
|
---|
23 | I '$D(^XTMP("XPDI",Y)) goto SDone
|
---|
24 | write "SUCCESS!!",!
|
---|
25 | set result=1
|
---|
26 | SDone
|
---|
27 | quit result
|
---|
28 |
|
---|
29 |
|
---|
30 | EN(InstallName,Option,Msg)
|
---|
31 | ;"Purpose: Install an entry from file 9.7 INSTALL
|
---|
32 | ;"Input: InstallName -- Name of package to install (or the install name the user was told to use.)
|
---|
33 | ;" Option -- PASS BY REFERENCE. An array filled with answers to user interaction questions.
|
---|
34 | ;" Option(QuestionText)=1 for YES, 0 for NO
|
---|
35 | ;" Option(QuestionText,"DEFAULT")=default user answer
|
---|
36 | ;" Msg -- PASS BY REFERANCE, an OUT PARAMETER
|
---|
37 | ;" Errors are stored in Msg("ERROR",x)=Message
|
---|
38 | ;" Msg("ERROR")=count of last error
|
---|
39 | ;" Message are store in Msg(x)=Message
|
---|
40 | ;" Msg=count of last message+1
|
---|
41 |
|
---|
42 | N DIR,DIRUT,POP,XPD,XPDA,XPDD,XPDIJ,XPDDIQ,XPDIT,XPDIABT
|
---|
43 | N XPDNM,XPDNOQUE,XPDPKG,XPDREQAB,XPDST,XPDSET,XPDSET1,XPDT
|
---|
44 | N XPDQUIT,XPDQUES,Y,ZTSK,%
|
---|
45 |
|
---|
46 | S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"
|
---|
47 | ;"S %="new temp set temp=$$SCRN^TMGXPDI() w ""temp="",temp,! IF temp"
|
---|
48 | S XPDST=$$LOOK^TMGXPDI1(%,,.InstallName,.Msg) ;"returns IEN or 0 if fail
|
---|
49 | I 'XPDST!$D(XPDQUIT) Q
|
---|
50 | S XPDIT=0
|
---|
51 | S (XPDSET,XPDSET1)=$P(^XPD(9.7,XPDST,0),U)
|
---|
52 | K ^TMP($J)
|
---|
53 |
|
---|
54 | ;"Check each part of XPDT array
|
---|
55 | F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D Q:'$D(XPDT)!$D(XPDQUIT)
|
---|
56 | . S XPDA=+XPDT(XPDIT)
|
---|
57 | . S XPDNM=$P(XPDT(XPDIT),U,2)
|
---|
58 | . S XPDPKG=+$P($G(^XPD(9.7,+XPDT(XPDIT),0)),U,2)
|
---|
59 | . S %=$P(^(0),U,5)
|
---|
60 | . do AddMsg^TMGPAT2("Checking Install for Package "_XPDNM,0,.Msg)
|
---|
61 | . ;"Check that Install file was created correctly
|
---|
62 | . I '$D(^XPD(9.7,XPDA,"INI"))!'$D(^("INIT")) do Q
|
---|
63 | . . do AddMsg^TMGPAT2("**INSTALL FILE IS CORRUPTED**",1,.Msg)
|
---|
64 | . . S XPDQUIT=1
|
---|
65 | . ;"Run enviroment check routine
|
---|
66 | . ;"XPDREQAB req. build missing, =2 global killed
|
---|
67 | . I $$ENV^TMGXPDL1(1) S:$G(XPDREQAB)=2 XPDQUIT=1 Q
|
---|
68 | . ;"save variables that are setup in environ. chck. routine
|
---|
69 | . I $D(XPDNOQUE)!$D(XPDDIQ) D
|
---|
70 | . . I $D(XPDNOQUE) S ^XTMP("XPDI",XPDA,"ENVVAR","XPDNOQUE")=XPDNOQUE
|
---|
71 | . . I $D(XPDDIQ) M ^XTMP("XPDI",XPDA,"ENVVAR","XPDDIQ")=XPDDIQ
|
---|
72 | . D QUES^TMGXPDI1(XPDA,.Option)
|
---|
73 | . Q:'$D(XPDT(+XPDIT))!$D(XPDQUIT)
|
---|
74 | . ;"XPDIJ=XPDA if XPDIJ routine is part of Build
|
---|
75 | . I $D(^XTMP("XPDI",XPDA,"RTN","XPDIJ")) S XPDIJ=XPDA
|
---|
76 | . D XQSET^TMGXPDI1(XPDA)
|
---|
77 |
|
---|
78 | ;"NONE = no Build to install
|
---|
79 | G NONE:'$O(XPDT(""))!$D(XPDQUIT)!($G(XPDREQAB))
|
---|
80 | ;"check that we have all Builds to install
|
---|
81 | S XPDA=XPDST,XPDNM=XPDSET,Y=0
|
---|
82 | F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S %=+$O(^(Y,0)) I '$D(XPDT("DA",%)) G NONE
|
---|
83 | do AddMsg^TMGPAT2(" ",0,.Msg)
|
---|
84 | ;"See if a Master Build
|
---|
85 | S %=$O(^XTMP("XPDI",XPDA,"BLD",0))
|
---|
86 | S %=$P(^(%,0),U,3)
|
---|
87 | I %=1 S XPDT("MASTER")=XPDA
|
---|
88 |
|
---|
89 | ;"Inhibit Logon Question
|
---|
90 | D DIR^TMGXPDIQ("XPI",,.Option) I $D(DIRUT) D ABRTALL(2) Q
|
---|
91 | ;"disable options question
|
---|
92 | D DIR^TMGXPDIQ("XPZ",,.Option) I $D(DIRUT) D ABRTALL(2) Q
|
---|
93 | ;"XPDSET=set name,(also build name), of options that will be disabled
|
---|
94 | ;"XPDSET1=setname or null if they don't want to disable
|
---|
95 | D I XPDSET1="^" D ABRTALL(2) Q
|
---|
96 | . ;if they say no, set XPDET1=""
|
---|
97 | . S:'$G(XPDQUES("XPZ1")) XPDSET1="",Y=0
|
---|
98 | . S ^XTMP("XQOO",XPDSET,0)=XPDSET_" is being installed by KIDS^"_DT_U_DUZ
|
---|
99 | . I XPDSET1]"" D Q:XPDSET1="^"!(XPDSET1="")
|
---|
100 | . . ;"merge the options/protocols that were put in ^TMP($J,"XQOO",build name)
|
---|
101 | . . M ^XTMP("XQOO",XPDSET)=^TMP($J,"XQOO",XPDSET)
|
---|
102 | . . D INIT^XQOO(.XPDSET1) Q:"^"[XPDSET1
|
---|
103 | . . N DIR S DIR(0)="N^0:60:0",DIR("B")=0
|
---|
104 | . . S DIR("A")="Delay Install (Minutes)"
|
---|
105 | . . S DIR("?")="Enter the number of minutes to delay the installing of Routines after the Disable of Options"
|
---|
106 | . . W ! D ^DIR
|
---|
107 | . . I $D(DIRUT) S XPDSET1="^"
|
---|
108 | . ;"Y is set in the call to DIR in previous .DO
|
---|
109 | . ;"save setname into first Build and the Delay in minutes, Y
|
---|
110 | . K XPD
|
---|
111 | . S XPD(9.7,XPDST_",",7)=(XPDSET1]"")_XPDSET
|
---|
112 | . S XPD(9.7,XPDST_",",8)=Y
|
---|
113 | . D FILE^DIE("","XPD")
|
---|
114 |
|
---|
115 | ;"check if they want to update other CPUs
|
---|
116 | I $G(XPDQUES("XPZ2")) D I $D(DIRUT) D ABRTALL(2) Q
|
---|
117 | . N DA,DIE,DIR,DR,I,XPD,X,Y,Z
|
---|
118 | . ;"if they haven't already added Volume Sets, populate the mulitple
|
---|
119 | . I '$O(^XPD(9.7,XPDA,"VOL",0)) D I $D(XPD) D UPDATE^DIE("","XPD")
|
---|
120 | . . X ^%ZOSF("UCI") S Y=$P(Y,",",2),(I,Z)=0
|
---|
121 | . . F S I=$O(^%ZIS(14.5,I)) Q:'I do
|
---|
122 | . . . S X=$G(^(I,0))
|
---|
123 | . . . if $P(X,U)]""&$P(X,U,11)&($P(X,U)'=Y) do
|
---|
124 | . . . . set Z=Z+1
|
---|
125 | . . . . set XPD(9.703,"+"_Z_","_XPDA_",",.01)=$P(X,U)
|
---|
126 | . W !!,"I will Update the following VOLUME SETS:",!
|
---|
127 | . S I=0 F S I=$O(^XPD(9.7,XPDA,"VOL",I)) Q:'I W ?3,$P(^(I,0),U),!
|
---|
128 | . W !
|
---|
129 | . S DIR(0)="Y",DIR("A")="Want to edit this list",DIR("B")="NO"
|
---|
130 | . D ^DIR
|
---|
131 | . I $D(DIRUT) Q
|
---|
132 | . IF Y DO
|
---|
133 | . . S DA=XPDA,DIE="^XPD(9.7,",DR=30,DR(2,9.703)=".01"
|
---|
134 | . . D ^DIE
|
---|
135 | . I '$O(^XPD(9.7,XPDA,"VOL",0)) W !!,"No VOLUME SETS selected!!" Q
|
---|
136 | . I $$TM^%ZTLOAD Q ;"quit if Taskman is running
|
---|
137 | . W !!,"TASKMAN is not running. If you install now, you must run the routine XPDCPU",!
|
---|
138 | . W "in the production UCI for each of the VOLUME SETS you have listed once",!
|
---|
139 | . W "the installation starts!!",!
|
---|
140 | . W "If you Queue the install, the VOLUME SETS will be updated automatically.",*7,*7,!!
|
---|
141 |
|
---|
142 | DEV S POP=0
|
---|
143 | I '$D(^DD(3.5,0)) S POP=1
|
---|
144 | ;"check if home device is defined
|
---|
145 | I 'POP S IOP="",%ZIS=0 D ^%ZIS
|
---|
146 | ;"Kernel Virgin Install
|
---|
147 | I POP do G EN^XPDIJ
|
---|
148 | . S XPDA=XPDST
|
---|
149 | . I $G(XPDIJ) D XPDIJ^XPDI1
|
---|
150 |
|
---|
151 | ;"set XPDA=starting Build, ask for device for messages
|
---|
152 | ;"XPDNOQUE is defined means don't let them queue output
|
---|
153 | W !!,"Enter the Device you want to print the Install messages."
|
---|
154 | W:'$D(XPDNOQUE) !,"You can queue the install by enter a 'Q' at the device prompt."
|
---|
155 | W !,"Enter a '^' to abort the install.",!
|
---|
156 | S XPDA=XPDST
|
---|
157 | S %ZIS=$P("Q",U,'$D(XPDNOQUE))
|
---|
158 | D ^%ZIS
|
---|
159 | I POP G ASKABRT
|
---|
160 |
|
---|
161 | ;"reset expiration date to T+7 on transport global
|
---|
162 | S XPDD=$$FMADD^XLFDT(DT,7)
|
---|
163 | S ^XTMP("XPDI",0)=XPDD_U_DT
|
---|
164 | I $D(IO("Q")) D G ASKABRT:$D(ZTSK)[0 D XPDIJ^XPDI1:$G(XPDIJ),QUIT^XPDI1(XPDST) Q
|
---|
165 | . N DIR,NOW S NOW=$$HTFM^XLFDT($$HADD^XLFDT($H,,,2)) ;Must be in future
|
---|
166 | . S DIR(0)="DA^"_NOW_":"_XPDD_":AEFRSX"
|
---|
167 | . S DIR("A")="Request Start Time: "
|
---|
168 | . S DIR("B")=$$FMTE^XLFDT(NOW)
|
---|
169 | . S DIR("?",1)="Enter a Date including Time"
|
---|
170 | . S DIR("?",2)="The time must be in the future and not to exceed 7 days in the future."
|
---|
171 | . S DIR("?")="Current date/time: "_DIR("B")
|
---|
172 | . D ^DIR
|
---|
173 | . Q:$D(DIRUT)
|
---|
174 | . S ZTDTH=Y,ZTRTN="EN^XPDIJ",ZTDESC=XPDNM_" KIDS install",ZTSAVE("XPDA")=""
|
---|
175 | . D ^%ZTLOAD,HOME^%ZIS K IO("Q")
|
---|
176 | . Q:$D(ZTSK)[0
|
---|
177 | . W !,"Install Queued!",!!
|
---|
178 | . ;"save task into first Build
|
---|
179 | . K XPD S XPD(9.7,XPDST_",",5)=ZTSK,XPDIT=0
|
---|
180 | . F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D
|
---|
181 | . . S XPD(9.7,+XPDT(XPDIT)_",",.02)=1
|
---|
182 | . . D FILE^DIE("","XPD")
|
---|
183 | . . K XPD
|
---|
184 |
|
---|
185 | ;"run install
|
---|
186 | U IO
|
---|
187 | I $G(XPDIJ) D XPDIJ^XPDI1
|
---|
188 | D QUIT^XPDI1(XPDST)
|
---|
189 | G EN^XPDIJ
|
---|
190 | Q
|
---|
191 |
|
---|
192 |
|
---|
193 | ABORT(XPDA,XPDK,XPDALL,Msg)
|
---|
194 | ;"Purpose: Abort install of Build XPDA
|
---|
195 | ;
|
---|
196 | ;"XPDA=ien to del, XPDK=1 kill global, XPDALL=1 deleting all
|
---|
197 | ;"XPDST=starting package.
|
---|
198 |
|
---|
199 | N %,DA,DIK,XPDJ,XPDNM,Y
|
---|
200 | Q:'$D(^XPD(9.7,XPDA,0)) S XPDNM=$P(^(0),U)
|
---|
201 | D BMES^TMGXPDUT(XPDNM_" Build will not be installed"_$S(XPDK=1:", Transport Global deleted!",1:""))
|
---|
202 | do MES^TMGXPDUT(" "_$$HTE^XLFDT($H))
|
---|
203 | S DIK="^XPD(9.7,",XPDJ=XPDT("NM",XPDNM),DA=XPDA
|
---|
204 | ;kill XPDT array, but don't kill global if XPDK=2
|
---|
205 | K XPDT("NM",XPDNM),XPDT("DA",XPDA),XPDT(XPDJ),XPDT("GP") Q:XPDK=2
|
---|
206 | K ^XTMP("XPDI",XPDA)
|
---|
207 | ;if we are not deleting all packages and we are deleting the starting package
|
---|
208 | ;set the next package to the starting package. It must always be 1.
|
---|
209 | I '$G(XPDALL),XPDA=XPDST S Y=$O(XPDT(0)) D:Y
|
---|
210 | .;unlock starting install
|
---|
211 | .L -^XPD(9.7,XPDST)
|
---|
212 | .S XPDST=+XPDT(Y),XPDT(1)=XPDT(Y),XPDT("DA",XPDST)=1,XPDT("NM",$P(XPDT(Y),U,2))=1,XPDIT=0
|
---|
213 | .K XPDT(Y) N XPD
|
---|
214 | .S %="XPD(9.7,"""_XPDST_","")",@%@(3)=XPDST,@%@(4)=1
|
---|
215 | .;loop thru the rest of the packages and reset the starting package field
|
---|
216 | .F S Y=$O(XPDT(Y)) Q:'Y D
|
---|
217 | ..S XPD(9.7,+XPDT(Y)_",",3)=XPDST
|
---|
218 | .D FILE^DIE("","XPD")
|
---|
219 | D ^DIK
|
---|
220 | Q
|
---|
221 |
|
---|
222 | ASKABRT ;ask if want to unload distribution
|
---|
223 | N DIR,DIRUT,X,Y
|
---|
224 | S XPDQUIT=1,DIR(0)="Y",DIR("A")="Install ABORTED, Want to remove the Transport Globals",DIR("B")="YES"
|
---|
225 | W ! D ^DIR I Y D ABRTALL(1) Q
|
---|
226 | L -^XPD(9.7,XPDST)
|
---|
227 | Q
|
---|
228 |
|
---|
229 | ABRTALL(XPDK,Option,Msg)
|
---|
230 | ;"Purpose: Abort all Builds
|
---|
231 | ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
|
---|
232 | ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
|
---|
233 | ;" Message are store in Msg(x)=Message
|
---|
234 | ;" Msg=count of last message+1
|
---|
235 |
|
---|
236 | N XPDA
|
---|
237 | S XPDT=0
|
---|
238 | F S XPDT=$O(XPDT(XPDT)) Q:'XPDT do
|
---|
239 | . S XPDA=+XPDT(XPDT)
|
---|
240 | . D ABORT(XPDA,XPDK,1,.Msg)
|
---|
241 | ;"Unlock starting install
|
---|
242 | L -^XPD(9.7,XPDST)
|
---|
243 | Q
|
---|
244 |
|
---|
245 | NONE W !!,"**NOTHING INSTALLED**",!
|
---|
246 | Q
|
---|