| [796] | 1 | TMGXPDIL ;TMG/kst/Custom version of XPDIL ;09/17/08
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;09/17/08
|
|---|
| 3 |
|
|---|
| 4 | ;"Original header....
|
|---|
| 5 | ;"XPDIL ;SFISC/RSD - load Distribution Global ;05/28/99 09:41
|
|---|
| 6 | ;" ;;8.0;KERNEL;**15,44,58,68,108**;Jul 10, 1995
|
|---|
| 7 |
|
|---|
| 8 | ;
|
|---|
| 9 | ;"Kevin Toppenberg MD
|
|---|
| 10 | ;"GNU General Public License (GPL) applies
|
|---|
| 11 | ;"9/17/08
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 | EN1(Option,Msg)
|
|---|
| 15 | ;"Purpose: Provide an API for KIDS load a distribution
|
|---|
| 16 | ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
|
|---|
| 17 | ;" Option("HFSNAME")=FilePathNameOnHFS
|
|---|
| 18 | ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
|
|---|
| 19 | ;" Option("DO ENV CHECK")=# 1=do check, 0=don't do check
|
|---|
| 20 | ;" Option("VERBOSE")=1 for output
|
|---|
| 21 | ;" Msg -- PASS BY REFERANCE, an OUT PARAMETER
|
|---|
| 22 | ;" Errors are stored in Msg("ERROR",x)=Message
|
|---|
| 23 | ;" Msg("ERROR")=count of last error
|
|---|
| 24 | ;" Message are store in Msg(x)=Message
|
|---|
| 25 | ;" Msg=count of last message+1
|
|---|
| 26 | ;"Output: Option -- Option("INSTALL NAME")=Name to use to install package
|
|---|
| 27 |
|
|---|
| 28 | N POP,XPDA,XPDST,XPDIT,XPDT,XPDGP,XPDQUIT,XPDREQAB,XPDSKPE
|
|---|
| 29 | S:'$D(DT) DT=$$DT^XLFDT S:'$D(U) U="^"
|
|---|
| 30 | S XPDST=0
|
|---|
| 31 | set Msg=+$get(Msg,1)
|
|---|
| 32 |
|
|---|
| 33 | new temp set temp=$$ST(.Option,.Msg) ;"Load in patch
|
|---|
| 34 | if (temp=0)!($G(XPDQUIT)) do goto EnDone
|
|---|
| 35 | . D ABRTALL^TMGXPDI(1,,.Msg) ;"(not interactive)
|
|---|
| 36 | . do AddMsg^TMGPAT2("**NOTHING LOADED**",1,.Msg)
|
|---|
| 37 |
|
|---|
| 38 | ;"XPDST= starting Build
|
|---|
| 39 | ;"XPDT("DA",ien)=seq # to install
|
|---|
| 40 | ;"XPDT("NM",build name)=seq #
|
|---|
| 41 | ;"XPDT(seq #)=ien^Build name
|
|---|
| 42 | ;"XPDT("GP",global)= 1-replace, 0-overwrite^ien
|
|---|
| 43 | ;"XPDGP=globals from a Global Package
|
|---|
| 44 | ;"XPDSKPE=1 don't run Environment Check^has question been asked
|
|---|
| 45 | S XPDIT=0,XPDSKPE="0^0"
|
|---|
| 46 | F S XPDIT=$O(XPDT(XPDIT)) Q:'XPDIT D Q:'$D(XPDT)
|
|---|
| 47 | . S XPDA=+XPDT(XPDIT)
|
|---|
| 48 | . if $$CheckLocal^TMGPAT4($name(^XTMP("XPDI",XPDA)),.Option)=1 do
|
|---|
| 49 | . . ;"if $get(Option("VERBOSE"))'=1 quit
|
|---|
| 50 | . . write "WARNING. This code overwrites local mods!",!
|
|---|
| 51 | . . do PressToCont^TMGUSRIF
|
|---|
| 52 | . ;"Check if this Build has an Envir. Check
|
|---|
| 53 | . I $G(^XTMP("XPDI",XPDA,"PRE"))]"" D
|
|---|
| 54 | . . ;"Quit if we already asked this question
|
|---|
| 55 | . . Q:$P(XPDSKPE,U,2)
|
|---|
| 56 | . . S $P(XPDSKPE,U,2)=1
|
|---|
| 57 | . . set Y=$get(Option("DO ENV CHECK"))
|
|---|
| 58 | . . if Y'=1 set XPDSKPE="1^1"
|
|---|
| 59 | . I $G(XPDQUIT) D ABRTALL^TMGXPDI(1,,.Msg) Q
|
|---|
| 60 | . D PKG^TMGXPDL1(XPDA,.Option,.Msg)
|
|---|
| 61 |
|
|---|
| 62 | ;"Global Package
|
|---|
| 63 | G:$D(XPDGP) ^XPDIGP
|
|---|
| 64 | I $D(XPDT),$D(^XPD(9.7,+XPDST,0)) do
|
|---|
| 65 | . do AddMsg^TMGPAT2("Use INSTALL NAME: "_$P(^(0),U)_" to install this Distribution.",0,.Msg)
|
|---|
| 66 | . set Option("INSTALL NAME")=$P(^(0),U)
|
|---|
| 67 | EnDone
|
|---|
| 68 | Q
|
|---|
| 69 |
|
|---|
| 70 |
|
|---|
| 71 | ST(Option,Msg)
|
|---|
| 72 | ;"Purpose: 'global input'
|
|---|
| 73 | ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
|
|---|
| 74 | ;" Option("HFSNAME")=FilePathNameOnHFS
|
|---|
| 75 | ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
|
|---|
| 76 | ;" Option("INTERACTIVE")=1 if 1 then direct user input asked if needed
|
|---|
| 77 | ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
|
|---|
| 78 | ;" Errors are stored in Msg("ERROR",x)=Message
|
|---|
| 79 | ;" Msg("ERROR")=count of last error
|
|---|
| 80 | ;" Message are store in Msg(x)=Message
|
|---|
| 81 | ;" Msg=count of last message+1
|
|---|
| 82 | ;"Results: 1=success, 0=error
|
|---|
| 83 | new result set result=1
|
|---|
| 84 | N DIR,DIRUT,GR,IOP,X,Y,Z,%ZIS
|
|---|
| 85 | I '$D(^%ZIS(1,"B","HFS")) do goto STDone
|
|---|
| 86 | . do AddMsg^TMGPAT2("You must have a device called 'HFS' in order to load a distribution!",1,.Msg)
|
|---|
| 87 | . S XPDQUIT=1
|
|---|
| 88 | D HOME^%ZIS
|
|---|
| 89 | set Y=$get(Option("HFSNAME"))
|
|---|
| 90 | if (Y="")&($get(Option("INTERACTIVE"))=1) do
|
|---|
| 91 | . set DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to input Distribution."
|
|---|
| 92 | . set Y=$$GetFName^TMGIOUTL(DIR("?"),"/tmp/","","","","",DIR("A")_": ")
|
|---|
| 93 | if Y="" do goto STDone
|
|---|
| 94 | . do AddMsg^TMGPAT2("No host file system filename provided!",1,.Msg)
|
|---|
| 95 | . S XPDQUIT=1
|
|---|
| 96 | S %ZIS="",%ZIS("HFSNAME")=Y,%ZIS("HFSMODE")="R",IOP="HFS"
|
|---|
| 97 | D ^%ZIS
|
|---|
| 98 | I POP do
|
|---|
| 99 | . do AddMsg^TMGPAT2("Couldn't open file or HFS device!!",1,.Msg)
|
|---|
| 100 | . set result=0
|
|---|
| 101 | ;"don't close device if we have a global package, we need to bring in the globals now
|
|---|
| 102 | D GI(.Option,.Msg) ;"Get file loaded in
|
|---|
| 103 | do ^%ZISC:'$D(XPDGP)!$G(XPDQUIT)
|
|---|
| 104 | STDone
|
|---|
| 105 | if $get(XPDQUIT)=1 set result=0
|
|---|
| 106 | Q result
|
|---|
| 107 |
|
|---|
| 108 |
|
|---|
| 109 | GI(Option,Msg) ;"Get In
|
|---|
| 110 | ;"Purpose: Open file and load in.
|
|---|
| 111 | ;"Input: Option -- PASS BY REFERENCE. Entries are required unless marked optional
|
|---|
| 112 | ;" Option("HFSNAME")=FilePathNameOnHFS
|
|---|
| 113 | ;" Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
|
|---|
| 114 | ;" Msg -- PASS BY REFERENCE, an OUT PARAMETER.
|
|---|
| 115 | ;" Errors are stored in Msg("ERROR",x)=Message
|
|---|
| 116 | ;" Msg("ERROR")=count of last error
|
|---|
| 117 | ;" Message are store in Msg(x)=Message
|
|---|
| 118 | ;" Msg=count of last message+1
|
|---|
| 119 |
|
|---|
| 120 | N X,XPDSEQ,Y,Z
|
|---|
| 121 | U IO ;"open KIDS text file for input
|
|---|
| 122 | do DoRead(.X,1)
|
|---|
| 123 | do DoRead(.Y,1)
|
|---|
| 124 |
|
|---|
| 125 | do AddMsg^TMGPAT2(X,0,.Msg)
|
|---|
| 126 | do AddMsg^TMGPAT2("Comment: "_Y,0,.Msg)
|
|---|
| 127 | S XPDST("H")=Y
|
|---|
| 128 | if Y="Extracted from mail message" do
|
|---|
| 129 | . S XPDST("H1")=X
|
|---|
| 130 | else do
|
|---|
| 131 | . S XPDST("H1")=Y_" ;Created on "_$P(X,"KIDS Distribution saved on ",2)
|
|---|
| 132 | ;"Z is the string of Builds in this file
|
|---|
| 133 | F X=1:1 do Q:Z=""
|
|---|
| 134 | . do DoRead(.Z,1)
|
|---|
| 135 | . S Z=$P(Z,"**KIDS**",2,99)
|
|---|
| 136 | . Q:Z=""
|
|---|
| 137 | . S X(X)=Z
|
|---|
| 138 | U IO(0)
|
|---|
| 139 | I $G(X(1))="" do goto GIDone
|
|---|
| 140 | . do AddMsg^TMGPAT2("This is not a Distribution HFS File!",1,.Msg)
|
|---|
| 141 | . S XPDQUIT=1
|
|---|
| 142 |
|
|---|
| 143 | ;"global package, set XPDGP=flag;global^flag;global^... flag=1 replace
|
|---|
| 144 | I $P(X(1),":")="GLOBALS" S XPDGP=$P(X(1),U,2,99),X(1)=$P(X(1),U)
|
|---|
| 145 | S XPDIT=0,X(1)=$P(X(1),":",2,99)
|
|---|
| 146 |
|
|---|
| 147 | do AddMsg^TMGPAT2("This Distribution contains Transport Globals for the following Package(s):",0,.Msg)
|
|---|
| 148 | kill XPDQUIT
|
|---|
| 149 | F X=1:1:X-1 do Q:$get(XPDQUIT)=1
|
|---|
| 150 | . F Z=1:1 do Q:(Y="")!($get(XPDQUIT)=1)
|
|---|
| 151 | . . S Y=$P(X(X),U,Z)
|
|---|
| 152 | . . Q:Y=""
|
|---|
| 153 | . . ;"can't install if global exist, that means Build never finish install
|
|---|
| 154 | . . ;"INST will show name
|
|---|
| 155 | . . S XPDIT=XPDIT+1
|
|---|
| 156 | . . new temp set temp=$$INST^TMGXPDL1(Y,.Option,.Msg)
|
|---|
| 157 | . . ;" //kt removed I temp=0 S XPDQUIT=1 Q
|
|---|
| 158 | if $G(XPDQUIT) goto GIDone
|
|---|
| 159 |
|
|---|
| 160 | do AddMsg^TMGPAT2("Distribution OK",0,.Msg)
|
|---|
| 161 |
|
|---|
| 162 | if $D(XPDGP) do DISP^TMGXPDIG(Msg)
|
|---|
| 163 | if $get(Option("FORCE CONT LOAD"))'=1 do goto GIDone
|
|---|
| 164 | . do AddMsg^TMGPAT2("Option(""FORCE CONT LOAD"")=1 not found in passed options.",1,.Msg)
|
|---|
| 165 | . S XPDQUIT=1
|
|---|
| 166 | do AddMsg^TMGPAT2("Loading Distribution...",0,.Msg)
|
|---|
| 167 |
|
|---|
| 168 | ;"reset expiration date to T+7 on transport global
|
|---|
| 169 | S ^XTMP("XPDI",0)=$$FMADD^XLFDT(DT,7)_U_DT
|
|---|
| 170 | ;"start reading the HFS again
|
|---|
| 171 | U IO
|
|---|
| 172 | do DoRead(.X,0)
|
|---|
| 173 | do DoRead(.Y,0)
|
|---|
| 174 | ;"R X:0,Y:0
|
|---|
| 175 | ;"the next read must be the INSTALL NAME
|
|---|
| 176 | I X'="**INSTALL NAME**"!'$D(XPDT("NM",Y)) do goto GIDone
|
|---|
| 177 | . do AddMsg^TMGPAT2("ERROR in HFS file format!",1,.Msg)
|
|---|
| 178 | . S XPDQUIT=1
|
|---|
| 179 |
|
|---|
| 180 | ;"XPDSEQ is the disk sequence number
|
|---|
| 181 | S %=XPDT("NM",Y)
|
|---|
| 182 | set GR="^XTMP(""XPDI"","_+XPDT(%)_","
|
|---|
| 183 | set XPDSEQ=1
|
|---|
| 184 | ;"X=global ref, Y=global value.
|
|---|
| 185 | F do DoRead(.X,0) Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
|
|---|
| 186 | . do DoRead(.Y,0)
|
|---|
| 187 | . I X="**INSTALL NAME**" D Q
|
|---|
| 188 | . . S %=+$G(XPDT("NM",Y))
|
|---|
| 189 | . . set GR="" ;"//kt added Allows ignoring parts of multipatch not needed
|
|---|
| 190 | . . ;"I '% S DIRUT=1 Q ;"//kt
|
|---|
| 191 | . . I '% Q ;"//kt
|
|---|
| 192 | . . S GR="^XTMP(""XPDI"","_+XPDT(%)_","
|
|---|
| 193 | . if GR'="" S @(GR_X)=Y
|
|---|
| 194 | U IO(0)
|
|---|
| 195 | GIDone
|
|---|
| 196 | Q
|
|---|
| 197 |
|
|---|
| 198 | DoRead(S,timeOut)
|
|---|
| 199 | ;"Purpose: Do Read, but strip trailling #13 if needed.
|
|---|
| 200 | ;"Input: S -- pass by reference, and OUT PARAMETER
|
|---|
| 201 | ;" timeOut -- time out var to pass to READ command
|
|---|
| 202 | ;"Results: none
|
|---|
| 203 | read S:timeOut
|
|---|
| 204 | new l set l=$length(S)
|
|---|
| 205 | new ch set ch=$ascii($extract(S,l))
|
|---|
| 206 | if ch=13 set S=$extract(S,1,l-1)
|
|---|
| 207 | quit
|
|---|
| 208 |
|
|---|
| 209 |
|
|---|
| 210 | NEXTD I ^%ZOSF("OS")'["MSM" U IO(0) W !!,"Error in disk, ABORTING load!!" S XPDQUIT=1 Q
|
|---|
| 211 | N DIR
|
|---|
| 212 | ;"close current device
|
|---|
| 213 | C IO U IO(0)
|
|---|
| 214 | S XPDSEQ=XPDSEQ+1,DIR(0)="E"
|
|---|
| 215 | S DIR("A")="Insert the next diskette, #"_XPDSEQ_", and Press the return key"
|
|---|
| 216 | S DIR("?")="This distribution is continued on another diskette"
|
|---|
| 217 | D ^DIR Q:$D(DIRUT)
|
|---|
| 218 | W " OK",!
|
|---|
| 219 | ;MSM specific code to open HFS
|
|---|
| 220 | O @(""""_IO_""":"_IOPAR) U IO
|
|---|
| 221 | ;"R X:0,Y:0
|
|---|
| 222 | do DoRead(.X,1)
|
|---|
| 223 | do DoRead(.Y,1)
|
|---|
| 224 |
|
|---|
| 225 | ;"quit if comments are not the same on each diskette
|
|---|
| 226 | G:Y'=XPDST("H") NEXTQ
|
|---|
| 227 | ;"quit if not the expected sequence, Z is for the blank line
|
|---|
| 228 | ;"R Y:0,Z:0
|
|---|
| 229 | do DoRead(.Y,1)
|
|---|
| 230 | do DoRead(.Z,1)
|
|---|
| 231 | G:Y'=("**SEQ**:"_XPDSEQ) NEXTQ
|
|---|
| 232 | Q
|
|---|
| 233 | ;
|
|---|
| 234 | NEXTQ U IO(0) W !!,"This is NOT the correct diskette!! The comment on this diskette is:",!,X,!!
|
|---|
| 235 | S XPDSEQ=XPDSEQ-1
|
|---|
| 236 | G NEXTD
|
|---|
| 237 | ;
|
|---|
| 238 | NONE W !!,"**NOTHING LOADED**",!
|
|---|
| 239 | Q
|
|---|
| 240 |
|
|---|
| 241 |
|
|---|
| 242 | USER
|
|---|
| 243 | ;"Purpose: Ask user questions questions before running silent EN1^TMGXPDIL
|
|---|
| 244 |
|
|---|
| 245 | new Options
|
|---|
| 246 | new Option,Msg
|
|---|
| 247 | new DIR
|
|---|
| 248 | set DIR("A")="Enter a Host File"
|
|---|
| 249 | set DIR("?")="Enter a filename and/or path to input Distribution."
|
|---|
| 250 | if $get(TMGPATNM)'="" set Y=TMGPATNM ;"allow preset file name
|
|---|
| 251 | set Option("HFSNAME")=$$GetFName^TMGIOUTL(DIR("?"),"/tmp/","","","","",DIR("A")_": ")
|
|---|
| 252 |
|
|---|
| 253 | new %
|
|---|
| 254 | set %=2
|
|---|
| 255 | write "Do Environmental check" do YN^DICN write !
|
|---|
| 256 | if %=-1 goto UDone
|
|---|
| 257 | set Option("DO ENV CHECK")=(%=1)
|
|---|
| 258 |
|
|---|
| 259 | set %=1
|
|---|
| 260 | write "Force continue load" do YN^DICN write !
|
|---|
| 261 | if %=-1 goto UDone
|
|---|
| 262 | set Option("FORCE CONT LOAD")=(%=1)
|
|---|
| 263 |
|
|---|
| 264 | do EN1(.Option,.Msg)
|
|---|
| 265 | if $data(Msg) zwr Msg
|
|---|
| 266 |
|
|---|
| 267 | UDone
|
|---|
