| [796] | 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 | ;"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 |
|
|---|
| 8 | PKG(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")
|
|---|
| 77 | PCKDone
|
|---|
| 78 | if abort=1 do
|
|---|
| 79 | . do AddMsg^TMGPAT2("Aborting",1,.Msg)
|
|---|
| 80 | . do ABORT^TMGXPDI(XPDA,1,,.Msg)
|
|---|
| 81 |
|
|---|
| 82 | Q
|
|---|
| 83 |
|
|---|
| 84 | INST(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
|
|---|
| 148 | INSTDone
|
|---|
| 149 | Q XPDA
|
|---|
| 150 |
|
|---|
| 151 |
|
|---|
| 152 |
|
|---|
| 153 | ENV(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 |
|
|---|
| 215 | ABORT 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 |
|
|---|
| 232 | REQB(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 |
|
|---|
| 269 | INRTN(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
|
|---|
