source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDI.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.8 KB
Line 
1XPDI ;SFISC/RSD - Install Process ;9/16/02 13:29
2 ;;8.0;KERNEL;**10,21,39,41,44,58,68,108,145,184,229**;Jul 10, 1995
3EN ;install
4 N DIR,DIRUT,POP,XPD,XPDA,XPDD,XPDIJ,XPDDIQ,XPDIT,XPDIABT,XPDNM,XPDNOQUE,XPDPKG,XPDREQAB,XPDST,XPDSET,XPDSET1,XPDT,XPDQUIT,XPDQUES,Y,ZTSK,%
5 S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",XPDST=$$LOOK^XPDI1(%)
6 Q:'XPDST!$D(XPDQUIT)
7 S XPDIT=0,(XPDSET,XPDSET1)=$P(^XPD(9.7,XPDST,0),U) K ^TMP($J)
8 ;Check each part of XPDT array
9 F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D Q:'$D(XPDT)!$D(XPDQUIT)
10 .S XPDA=+XPDT(XPDIT),XPDNM=$P(XPDT(XPDIT),U,2),XPDPKG=+$P($G(^XPD(9.7,+XPDT(XPDIT),0)),U,2),%=$P(^(0),U,5)
11 .W !,"Checking Install for Package ",XPDNM
12 .;check that Install file was created correctly
13 .I '$D(^XPD(9.7,XPDA,"INI"))!'$D(^("INIT")) W !,"**INSTALL FILE IS CORRUPTED**",!,*7 S XPDQUIT=1 Q
14 .;run enviroment check routine
15 .;XPDREQAB req. build missing, =2 global killed
16 .I $$ENV^XPDIL1(1) S:$G(XPDREQAB)=2 XPDQUIT=1 Q
17 .;save variables that are setup in environ. chck. routine
18 .I $D(XPDNOQUE)!$D(XPDDIQ) D
19 ..S:$D(XPDNOQUE) ^XTMP("XPDI",XPDA,"ENVVAR","XPDNOQUE")=XPDNOQUE
20 ..I $D(XPDDIQ) M ^XTMP("XPDI",XPDA,"ENVVAR","XPDDIQ")=XPDDIQ
21 .D QUES^XPDI1(XPDA) Q:'$D(XPDT(+XPDIT))!$D(XPDQUIT)
22 .;XPDIJ=XPDA if XPDIJ routine is part of Build
23 .S:$D(^XTMP("XPDI",XPDA,"RTN","XPDIJ")) XPDIJ=XPDA
24 .D XQSET^XPDI1(XPDA)
25 ;NONE = no Build to install
26 G NONE:'$O(XPDT(""))!$D(XPDQUIT)!($G(XPDREQAB))
27 ;check that we have all Builds to install
28 S XPDA=XPDST,XPDNM=XPDSET,Y=0
29 F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S %=+$O(^(Y,0)) I '$D(XPDT("DA",%)) G NONE
30 W !
31 ;See if a Master Build
32 S %=$O(^XTMP("XPDI",XPDA,"BLD",0)),%=$P(^(%,0),U,3) S:%=1 XPDT("MASTER")=XPDA
33 ;Inhibit Logon Question
34 D DIR^XPDIQ("XPI") I $D(DIRUT) D ABRTALL(2) Q
35 ;disable options question
36 D DIR^XPDIQ("XPZ") I $D(DIRUT) D ABRTALL(2) Q
37 ;XPDSET=set name,(also build name), of options that will be disabled
38 ;XPDSET1=setname or null if they don't want to disable
39 D I XPDSET1="^" D ABRTALL(2) Q
40 .;if they say no, set XPDET1=""
41 .S:'$G(XPDQUES("XPZ1")) XPDSET1="",Y=0
42 .S ^XTMP("XQOO",XPDSET,0)=XPDSET_" is being installed by KIDS^"_DT_U_DUZ
43 .I XPDSET1]"" D Q:XPDSET1="^"!(XPDSET1="")
44 ..;merge the options/protocols that were put in ^TMP($J,"XQOO",build name)
45 ..M ^XTMP("XQOO",XPDSET)=^TMP($J,"XQOO",XPDSET)
46 ..D INIT^XQOO(.XPDSET1) Q:"^"[XPDSET1
47 ..N DIR S DIR(0)="N^0:60:0",DIR("B")=0
48 ..S DIR("A")="Delay Install (Minutes)",DIR("?")="Enter the number of minutes to delay the installing of Routines after the Disable of Options"
49 ..W ! D ^DIR I $D(DIRUT) S XPDSET1="^"
50 .;Y is set in the call to DIR in previous .DO
51 .;save setname into first Build and the Delay in minutes, Y
52 .K XPD S XPD(9.7,XPDST_",",7)=(XPDSET1]"")_XPDSET,XPD(9.7,XPDST_",",8)=Y
53 .D FILE^DIE("","XPD")
54 ;check if they want to update other CPUs
55 I $G(XPDQUES("XPZ2")) D I $D(DIRUT) D ABRTALL(2) Q
56 .N DA,DIE,DIR,DR,I,XPD,X,Y,Z
57 .;if they haven't already added Volume Sets, populate the mulitple
58 .I '$O(^XPD(9.7,XPDA,"VOL",0)) D I $D(XPD) D UPDATE^DIE("","XPD")
59 ..X ^%ZOSF("UCI") S Y=$P(Y,",",2),(I,Z)=0
60 ..F S I=$O(^%ZIS(14.5,I)) Q:'I S X=$G(^(I,0)) S:$P(X,U)]""&$P(X,U,11)&($P(X,U)'=Y) Z=Z+1,XPD(9.703,"+"_Z_","_XPDA_",",.01)=$P(X,U)
61 .W !!,"I will Update the following VOLUME SETS:",!
62 .S I=0 F S I=$O(^XPD(9.7,XPDA,"VOL",I)) Q:'I W ?3,$P(^(I,0),U),!
63 .W ! S DIR(0)="Y",DIR("A")="Want to edit this list",DIR("B")="NO"
64 .D ^DIR Q:$D(DIRUT) D:Y
65 ..S DA=XPDA,DIE="^XPD(9.7,",DR=30,DR(2,9.703)=".01"
66 ..D ^DIE
67 .I '$O(^XPD(9.7,XPDA,"VOL",0)) W !!,"No VOLUME SETS selected!!" Q
68 .Q:$$TM^%ZTLOAD ;quit if Taskman is running
69 .W !!,"TASKMAN is not running. If you install now, you must run the routine XPDCPU",!,"in the production UCI for each of the VOLUME SETS you have listed once"
70 .W !,"the installation starts!!",!,"If you Queue the install, the VOLUME SETS will be updated automatically.",*7,*7,!!
71DEV S POP=0 S:'$D(^DD(3.5,0)) POP=1
72 ;check if home device is defined
73 I 'POP S IOP="",%ZIS=0 D ^%ZIS
74 ;Kernel Virgin Install
75 I POP S XPDA=XPDST D:$G(XPDIJ) XPDIJ^XPDI1 G EN^XPDIJ
76 ;set XPDA=starting Build, ask for device for messages
77 ;XPDNOQUE is defined means don't let them queue output
78 W !!,"Enter the Device you want to print the Install messages."
79 W:'$D(XPDNOQUE) !,"You can queue the install by enter a 'Q' at the device prompt."
80 W !,"Enter a '^' to abort the install.",!
81 S XPDA=XPDST,%ZIS=$P("Q",U,'$D(XPDNOQUE))
82 D ^%ZIS G:POP ASKABRT
83 ;reset expiration date to T+7 on transport global
84 S XPDD=$$FMADD^XLFDT(DT,7),^XTMP("XPDI",0)=XPDD_U_DT
85 I $D(IO("Q")) D G ASKABRT:$D(ZTSK)[0 D XPDIJ^XPDI1:$G(XPDIJ),QUIT^XPDI1(XPDST) Q
86 . N DIR,NOW S NOW=$$HTFM^XLFDT($$HADD^XLFDT($H,,,2)) ;Must be in future
87 . S DIR(0)="DA^"_NOW_":"_XPDD_":AEFRSX"
88 . S DIR("A")="Request Start Time: "
89 . S DIR("B")=$$FMTE^XLFDT(NOW)
90 . S DIR("?",1)="Enter a Date including Time"
91 . S DIR("?",2)="The time must be in the future and not to exceed 7 days in the future."
92 . S DIR("?")="Current date/time: "_DIR("B")
93 . D ^DIR
94 .Q:$D(DIRUT)
95 .S ZTDTH=Y,ZTRTN="EN^XPDIJ",ZTDESC=XPDNM_" KIDS install",ZTSAVE("XPDA")=""
96 .D ^%ZTLOAD,HOME^%ZIS K IO("Q")
97 .Q:$D(ZTSK)[0
98 .W !,"Install Queued!",!!
99 .;save task into first Build
100 .K XPD S XPD(9.7,XPDST_",",5)=ZTSK,XPDIT=0
101 .F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT S XPD(9.7,+XPDT(XPDIT)_",",.02)=1 D FILE^DIE("","XPD") K XPD
102 ;run install
103 U IO D XPDIJ^XPDI1:$G(XPDIJ),QUIT^XPDI1(XPDST) G EN^XPDIJ
104 Q
105 ;
106 ;XPDA=ien to del, XPDK=1 kill global, XPDALL=1 deleting all
107 ;XPDST=starting package.
108ABORT(XPDA,XPDK,XPDALL) ;abort install of Build XPDA
109 N %,DA,DIK,XPDJ,XPDNM,Y
110 Q:'$D(^XPD(9.7,XPDA,0)) S XPDNM=$P(^(0),U)
111 D BMES^XPDUTL(XPDNM_" Build will not be installed"_$S(XPDK=1:", Transport Global deleted!",1:"")),MES^XPDUTL(" "_$$HTE^XLFDT($H))
112 S DIK="^XPD(9.7,",XPDJ=XPDT("NM",XPDNM),DA=XPDA
113 ;kill XPDT array, but don't kill global if XPDK=2
114 K XPDT("NM",XPDNM),XPDT("DA",XPDA),XPDT(XPDJ),XPDT("GP") Q:XPDK=2
115 K ^XTMP("XPDI",XPDA)
116 ;if we are not deleting all packages and we are deleting the starting package
117 ;set the next package to the starting package. It must always be 1.
118 I '$G(XPDALL),XPDA=XPDST S Y=$O(XPDT(0)) D:Y
119 .;unlock starting install
120 .L -^XPD(9.7,XPDST)
121 .S XPDST=+XPDT(Y),XPDT(1)=XPDT(Y),XPDT("DA",XPDST)=1,XPDT("NM",$P(XPDT(Y),U,2))=1,XPDIT=0
122 .K XPDT(Y) N XPD
123 .S %="XPD(9.7,"""_XPDST_","")",@%@(3)=XPDST,@%@(4)=1
124 .;loop thru the rest of the packages and reset the starting package field
125 .F S Y=$O(XPDT(Y)) Q:'Y D
126 ..S XPD(9.7,+XPDT(Y)_",",3)=XPDST
127 .D FILE^DIE("","XPD")
128 D ^DIK
129 Q
130ASKABRT ;ask if want to unload distribution
131 N DIR,DIRUT,X,Y
132 S XPDQUIT=1,DIR(0)="Y",DIR("A")="Install ABORTED, Want to remove the Transport Globals",DIR("B")="YES"
133 W ! D ^DIR I Y D ABRTALL(1) Q
134 L -^XPD(9.7,XPDST)
135 Q
136ABRTALL(XPDK) ;abort all Builds
137 N XPDA
138 S XPDT=0
139 F S XPDT=$O(XPDT(XPDT)) Q:'XPDT S XPDA=+XPDT(XPDT) D ABORT(XPDA,XPDK,1)
140 ;unlock starting install
141 L -^XPD(9.7,XPDST)
142 Q
143NONE W !!,"**NOTHING INSTALLED**",!
144 Q
Note: See TracBrowser for help on using the repository browser.