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/XPDIL1.m@ 1005

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1XPDIL1 ;SFISC/RSD - cont. of load Distribution Global ;11/14/2002 07:35
2 ;;8.0;KERNEL;**15,17,39,41,44,66,68,76,85,100,108,229**;Jul 10, 1995
3 ;
4PKG(XPDA) ;check Package file
5 N XPD,XPDCP,XPDNM,XPDNOQUE,XPDPKG,X,Y,%
6 S XPDNM=$P(XPDT(XPDIT),U,2) W !?3,XPDNM
7 ;check KIDS version against sites version, skip if package is Kernel
8 I $$PKG^XPDUTL(XPDNM)'["KERNEL" D I $D(XPDQUIT) D ABORT^XPDI(XPDA,1) Q
9 .;this is part of a Kernel multi package
10 .Q:$O(XPDT("NM","KERNEL"))["KERNEL"
11 .S Y=$G(^XTMP("XPDI",XPDA,"VER"))
12 .I $$VERSION^XPDUTL("XU")<Y W !!,"But I need Version ",+Y," of KERNEL!" S XPDQUIT=1
13 .I $$VERSION^XPDUTL("VA FILEMAN")<$P(Y,U,2) W !,"But I Need Version ",+$P(Y,U,2)," of VA FILEMAN!" S XPDQUIT=1
14 ;get national package name
15 S %=$O(^XTMP("XPDI",XPDA,"PKG",0)),XPDPKG(0)=$G(^(+%,0)),XPDPKG=%
16 ;XPDPKG=new ien^old ien
17 I XPDPKG D S XPDPKG=+Y_U_XPDPKG
18 .N D,DIC
19 .S DIC="^DIC(9.4,",DIC(0)="X",X=$P(XPDPKG(0),U)
20 .D ^DIC Q:Y>0
21 .;if lookup fails try Prefix, C x-ref
22 .S X=$P(XPDPKG(0),U,2),D="C" D IX^DIC
23 ;add package to Install file
24 I XPDPKG>0 S XPD(9.7,XPDA_",",1)=+XPDPKG D FILE^DIE("","XPD")
25 ;XPDSKPE= does site want to run Environ. Check
26 I '$G(XPDSKPE) Q:$$ENV(0)=1
27 ;global package can't have pre or post inits
28 Q:$D(XPDGP)
29 ;create pre-init checkpoint
30 S XPDCP="INI" I '$$NEWCP^XPDUTL("XPD PREINSTALL COMPLETED") D ABORT^XPDI(XPDA,1) Q
31 S %=$$INRTN("INI")
32 ;check for routine, use as call back
33 I $L(%),'$$NEWCP^XPDUTL("XPD PREINSTALL STARTED",%) D ABORT^XPDI(XPDA,1) Q
34 ;create post-init checkpoint
35 S XPDCP="INIT" I '$$NEWCP^XPDUTL("XPD POSTINSTALL COMPLETED") D ABORT^XPDI(XPDA,1) Q
36 S %=$$INRTN("INIT")
37 I $L(%),'$$NEWCP^XPDUTL("XPD POSTINSTALL STARTED",%) D ABORT^XPDI(XPDA,1) Q
38 ;create fileman and components check points and file rest of data
39 D XPCK^XPDIK("FIA"),XPCK^XPDIK("KRN")
40 Q
41INST(XPDNM) ;add to Install file
42 N %X,DIC,DIR,DIRUT,DLAYGO,X,XPD,XPDA,XPDIE,XPDDIQ,Y,SH
43 ;check if Build was already installed
44 ;XPD=0 abort install, else XPD=ien in Install file
45 I $D(^XPD(9.7,"B",XPDNM)) S (SH,Y)=0 D Q:$D(XPD) XPD
46 . W !,"Build ",XPDNM," has been loaded before, here is when: "
47 . F S Y=$O(^XPD(9.7,"B",XPDNM,Y)) Q:'Y D
48 .. Q:'$D(^XPD(9.7,Y,0)) S %=^(0)
49 .. W !?6,$P(%,U)," "
50 .. I $P(%,U,9)<3,$D(^XTMP("XPDI",Y)) W "**Transport Global already exists**",*7 S XPD=0 Q
51 .. S %X=$X W $$EXTERNAL^DILFD(9.7,.02,"",$P(%,U,9)),!?%X,"was loaded on ",$$FMTE^XLFDT($P($G(^XPD(9.7,Y,1)),U))
52 . ;quit if transport global exist
53 . Q:$D(XPD)
54 . S DIR(0)="Y",DIR("A")="OK to continue with Load",DIR("B")="NO"
55 . D ^DIR W ! I $D(DIRUT)!'Y S XPD=0 Q
56 S DIC="^XPD(9.7,",DIC(0)="XL",DLAYGO=9.7,X=""""_XPDNM_""""
57 ;add to Install file, must be new
58 D ^DIC
59 I Y<0 S SH=0 W !,"Can't add Build ",XPDNM," to Install File" Q 0
60 ;set starting package to Y, if it is not already defined
61 S:'XPDST XPDST=+Y
62 ;XPDT array keeps track of all packages in this distribution
63 S XPDA=+Y,XPDT(XPDIT)=XPDA_U_XPDNM,(XPDT("DA",XPDA),XPDT("NM",XPDNM))=XPDIT
64 S %="XPDIE(9.7,"""_XPDA_","")",@%@(.02)=0,@%@(2)=$$NOW^XLFDT,@%@(3)=XPDST,@%@(4)=XPDIT,@%@(5)="",@%@(6)=XPDST("H1")
65 D FILE^DIE("","XPDIE")
66 I '$D(SH) W !?3,XPDNM ;SH is set when some other part of INST shows the name
67 Q XPDA
68 ;
69 ;XPDQUIT quit current package install, 1=kill global, 2=leave global
70 ;XPDQUIT(package) quit package install, 1=kill, 2=leave
71 ;XPDABORT quit the entire distribution, 1=kill, 2=leave
72 ;XPDENV 0=loading distribution, 1=installing
73ENV(XPDENV) ;enviroment check & version check
74 ;returns 0=ok, 1=rejected kill global, 2=rejected leave global
75 N %,DIR,XPDI,XPDQUIT,XPDABORT,XPDDONE,XPDGREF,XPDMBREQ
76 M X=DUZ N DUZ M DUZ=X S DUZ(0)="@" ;See that ENV check has full FM priv.
77 S XPDGREF="^XTMP(""XPDI"","_XPDA_",""TEMP"")"
78 S XPDMBREQ=$G(^XTMP("XPDI",XPDA,"MBREQ"))
79 S $P(^XPD(9.7,XPDA,0),U,7)=XPDMBREQ
80 ;check version number
81 I XPDPKG>0 D I $G(XPDQUIT) D ABORT^XPDI(XPDA,1) Q 1
82 .N DIR,DIRUT,X,Y
83 .S %=+$$VER^XPDUTL(XPDNM),Y=+$G(^DIC(9.4,+XPDPKG,"VERSION")),X=XPDNM["*"
84 .;if patch, version must be the same
85 .I X,%'=Y W !,"This Patch is for Version ",%,", you are running Version ",Y,! S XPDQUIT=1
86 .;if package, version must be greater or equal
87 .I 'X,%<Y W !,"You have a Version greater than mine!",! S XPDQUIT=1
88 .Q:'$G(XPDQUIT)
89 .I $G(XPDMBREQ) D S XPDQUIT=0,XPDDONE=1 Q
90 . . D MES^XPDUTL("**ABORT** Required Build "_XPDNM_", did not pass internal KIDS checks!"),ABRTALL^XPDI(1),NONE^XPDI
91 . . Q
92 .S DIR(0)="Y",DIR("A")="Want to continue installing this build",DIR("B")="NO"
93 .D ^DIR I Y K XPDQUIT
94 .Q
95 Q:$G(XPDDONE) 1
96 S %=$$REQB I % S (XPDABORT,XPDREQAB)=% G ABORT
97 S %=$G(^XTMP("XPDI",XPDA,"PRE")) D:%]""
98 .W !,"Will first run the Environment Check Routine, ",%,!
99 .D SAVE^XPDIJ(%),@("^"_%)
100ABORT I $G(XPDABORT) D Q XPDABORT
101 .;if during load & leave global quit
102 .I 'XPDENV,XPDABORT=2 Q
103 .D ABRTALL^XPDI(XPDABORT)
104 Q:'$D(XPDQUIT) 0
105 I $G(XPDQUIT) D ABORT^XPDI(XPDA,XPDQUIT)
106 S XPDI=""
107 ;don't do if loading & leave global, need to keep XPDT(array)
108 F S XPDI=$O(XPDQUIT(XPDI)) Q:XPDI="" D:'(XPDQUIT(XPDI)=2&'XPDENV)
109 .S %=$G(XPDT("NM",XPDI)) D:% ABORT^XPDI(+XPDT(%),XPDQUIT(XPDI))
110 S XPDQUIT=$S($G(XPDQUIT):XPDQUIT,'$O(XPDT(0))!'$D(^XTMP("XPDI",XPDA)):1,1:0)
111 Q XPDQUIT
112 ;
113REQB() ;check for Required Builds
114 ;returns 0=ok, 1=failed kill global, 2=failed leave global
115 N XPDACT,XPDBLD,XPDI,XPDQ,XPDQUIT,XPDX,XPDX0,X,Y
116 S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDQUIT=0,XPDI=0
117 Q:'$D(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"REQB")) 0
118 F S XPDI=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"REQB",XPDI)) Q:'XPDI S XPDX0=^(XPDI,0) D
119 .S XPDQ=0,XPDX=$P(XPDX0,U),XPDACT=$P(XPDX0,U,2),X=$$PKG^XPDUTL(XPDX),Y=$$VER^XPDUTL(XPDX),Z=$$VERSION^XPDUTL(X)
120 .;quit if current version is greater than what we are checking for
121 .Q:Z>Y
122 .I XPDX'["*" S:Z<Y XPDQ=2
123 .E S:'$$PATCH^XPDUTL(XPDX) XPDQ=1
124 .;quit if patch is already on system
125 .Q:'XPDQ
126 .;quit if patch is sequenced prior within this build
127 .I $D(XPDT("NM",XPDX)),(XPDT("NM",XPDX)<XPDT("NM",XPDNM)) S XPDQ=0 Q
128 .S XPDQUIT=$S(XPDACT>XPDQUIT:XPDACT,1:XPDQUIT)
129 .;XPDACT=0 warning, =1 abort & kill global, =2 abort
130 .W !!,$S(XPDACT:"**INSTALL ABORTED**",1:"**WARNING**")_$S(XPDQ=1:" Patch ",1:" Package ")_XPDX_" is Required "_$S(XPDACT:"to install",1:"for")_" this package!!",!
131 Q:'XPDQUIT 0
132 ;don't do if leave global and loading
133 D:'(XPDQUIT=2&'XPDENV) ABORT^XPDI(XPDA,XPDQUIT)
134 Q XPDQUIT
135 ;
136 ;return a routine that can be run
137INRTN(X) N Y
138 S Y=$G(^XTMP("XPDI",XPDA,X)) Q:Y="" ""
139 S Y=$S(Y["^":Y,1:"^"_Y)
140 Q Y
Note: See TracBrowser for help on using the repository browser.