source: cprs/branches/tmg-cprs/m_files/TMGXPDI.m

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

Initial upload

File size: 10.6 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 ;"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
8SCRN()
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
26SDone
27 quit result
28
29
30EN(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
142DEV 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
193ABORT(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
222ASKABRT ;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
229ABRTALL(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
245NONE W !!,"**NOTHING INSTALLED**",!
246 Q
Note: See TracBrowser for help on using the repository browser.