[628] | 1 | LEX2041 ; ISL/FJF - Environment Check/Pre/Post Install ; 22 Apr 2008 6:37 PM
|
---|
| 2 | ;;2.0;LEXICON UTILITY;**41**;Sep 23, 1996;Build 34
|
---|
| 3 | ;
|
---|
| 4 | ; External References
|
---|
| 5 | ; DBIA 10015 EN^DIQ1
|
---|
| 6 | ; DBIA 10141 $$PATCH^XPDUTL
|
---|
| 7 | ; DBIA 10141 $$VERSION^XPDUTL
|
---|
| 8 | ; DBIA 10141 BMES^XPDUTL
|
---|
| 9 | ; DBIA 10141 MES^XPDUTL
|
---|
| 10 | ;
|
---|
| 11 | ENV ; LEX*2.0*41 Environment Check
|
---|
| 12 | ;
|
---|
| 13 | ; General
|
---|
| 14 | W !," SNOMED CT release in support of LDSI",!
|
---|
| 15 | ;
|
---|
| 16 | N LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXG,LEXE
|
---|
| 17 | D IMP
|
---|
| 18 | S U="^"
|
---|
| 19 | ; No user
|
---|
| 20 | D:+$$UR'>0 ET("User not defined (DUZ)")
|
---|
| 21 | ; No IO
|
---|
| 22 | D:+$$SY'>0 ET("Undefined IO variable(s)")
|
---|
| 23 | I $D(LEXE) D ABRT Q
|
---|
| 24 | ;
|
---|
| 25 | ; Load Distribution
|
---|
| 26 | ;
|
---|
| 27 | ; XPDENV = 0 Environment Check during Load
|
---|
| 28 | ;
|
---|
| 29 | ; Check Version (2.0)
|
---|
| 30 | I $$VERSION^XPDUTL("LEX")'="2.0" D D ABRT Q
|
---|
| 31 | . D ET("Version 2.0 not found. Please install Lexicon Utility v 2.0")
|
---|
| 32 | ;
|
---|
| 33 | ; Check Required Patches
|
---|
| 34 | D:'$L($G(LEXREQP)) IMP I $L(LEXREQP) D
|
---|
| 35 | .N LEXPAT,LEXI,LEXPN
|
---|
| 36 | .F LEXI=1:1 Q:'$L($P(LEXREQP,";",LEXI)) S LEXPAT=$P(LEXREQP,";",LEXI) D
|
---|
| 37 | ..S LEXPN=$$PATCH^XPDUTL(LEXPAT)
|
---|
| 38 | ..W !," Checking for ",LEXPAT I +LEXPN>0 H 1 W " - installed"
|
---|
| 39 | ..I +LEXPN'>0 D ET((LEXPAT_" not found, please install "_LEXPAT_" before continuing"))
|
---|
| 40 | I $D(LEXE) D ABRT Q
|
---|
| 41 | S LEXG=$$RGBL
|
---|
| 42 | I $D(LEXE)&(+LEXG=0) D ABRT Q
|
---|
| 43 | I $D(LEXE)&(+LEXG<0) D ABRT Q
|
---|
| 44 | I '$D(LEXFULL)&(+($G(XPDENV))'=1) D QUIT Q
|
---|
| 45 | ;
|
---|
| 46 | ; Install Package(s)
|
---|
| 47 | ;
|
---|
| 48 | ; XPDENV = 1 Environment Check during Install
|
---|
| 49 | ;
|
---|
| 50 | ; Check Data "is installed" or "is translated"
|
---|
| 51 | N LEXIT S LEXIT=+$$CPD
|
---|
| 52 | I '$D(LEXFULL)&(LEXIT)
|
---|
| 53 | D QUIT
|
---|
| 54 | Q
|
---|
| 55 | ; Checking Global "Write" Protection
|
---|
| 56 | D:+($G(XPDENV))=1 GBLS I $D(LEXE) D ABRT Q
|
---|
| 57 | ; Check Import Global Checksum
|
---|
| 58 | D:+($G(XPDENV))=1 CS I $D(LEXE) D ABRT Q
|
---|
| 59 | ;
|
---|
| 60 | ; Quit, Exit or Abort
|
---|
| 61 | ;
|
---|
| 62 | QUIT ; Quit Passed Environment Check
|
---|
| 63 | K LEXFULL D OK
|
---|
| 64 | Q
|
---|
| 65 | EXIT ; Exit Failed Environment Check
|
---|
| 66 | D:$D(LEXE) ED S XPDQUIT=2 K LEXE,LEXFULL Q
|
---|
| 67 | ABRT ; Abort Failed Environment Check, KILL the distribution
|
---|
| 68 | D:$D(LEXE) ED
|
---|
| 69 | S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*41")=1
|
---|
| 70 | K LEXE,LEXFULL
|
---|
| 71 | Q
|
---|
| 72 | ;
|
---|
| 73 | ; Checks
|
---|
| 74 | ;
|
---|
| 75 | GBLS ; Check Write access on globals
|
---|
| 76 | N LEXE,LEXGBL,LEXRT,LEXT,LEXF,LEXI,LEXX,LEXOK,LEXCPD,LEXS,X S LEXOK=1
|
---|
| 77 | D BM(" I will now check the protection on ^LEX, ^ICPT, ^ICD and ^DIC Globals.")
|
---|
| 78 | D M(" If you get an ERROR, you will need to change the protection on these")
|
---|
| 79 | D M(" globals to allow read/write as indicated:")
|
---|
| 80 | D BM(" Owner Group World Network")
|
---|
| 81 | D M(" Cache systems RWD RW RW RWD")
|
---|
| 82 | D BM(" Checking:"),M(" ")
|
---|
| 83 | S LEXCPD=$$CPD,LEXS="",X=1 F LEXI=1:1 D Q:'$L(LEXX)
|
---|
| 84 | .S LEXX=""
|
---|
| 85 | .S LEXE="S LEXX=$T(GD+"_LEXI_")"
|
---|
| 86 | .X LEXE
|
---|
| 87 | .S LEXX=$$TRIM(LEXX)
|
---|
| 88 | .Q:'$L(LEXX)
|
---|
| 89 | .Q:'$L($TR(LEXX,";",""))
|
---|
| 90 | .S LEXGBL=$P(LEXX,";",3)
|
---|
| 91 | .Q:+LEXCPD>0&(LEXGBL="^LEXM(0)")
|
---|
| 92 | .S LEXRT=$P(LEXX,";",4),LEXT=$P(LEXX,";",5),LEXF=$P(LEXX,";",6)
|
---|
| 93 | .S (LEXB1,LEXB2)=""
|
---|
| 94 | .S $P(LEXB1," ",(19-$L(LEXRT)))="",$P(LEXB2," ",(28-$L(LEXT)))=""
|
---|
| 95 | .I '$D(@LEXGBL) D RGNF S LEXOK=0 D M((" <"_LEXRT_" not found>")) Q
|
---|
| 96 | .D M((" "_LEXRT_LEXB1_LEXT_LEXB2_LEXF))
|
---|
| 97 | .S @LEXGBL=$G(@LEXGBL) H 1
|
---|
| 98 | D:LEXOK M(" --> ok") D:'LEXOK M(" ??") D M(" ")
|
---|
| 99 | Q
|
---|
| 100 | RGBL(X) ; Check Write access on globals
|
---|
| 101 | N LEXCPD,LEXS,LEXI,LEXX,LEXEC,LEXGBL,LEXRT,LEXT,LEXF,LEXB1,LEXB2
|
---|
| 102 | S LEXCPD=$$CPD,LEXS="",X=1
|
---|
| 103 | F LEXI=1:1 D Q:'$L(LEXX)
|
---|
| 104 | .S LEXX=""
|
---|
| 105 | .S LEXEC="S LEXX=$T(GD+"_LEXI_")"
|
---|
| 106 | .X LEXEC
|
---|
| 107 | .S LEXX=$$TRIM(LEXX)
|
---|
| 108 | .Q:'$L(LEXX)
|
---|
| 109 | .Q:'$L($TR(LEXX,";",""))
|
---|
| 110 | .S LEXGBL=$P(LEXX,";",3)
|
---|
| 111 | .I +LEXCPD>0,LEXGBL="^LEXM(0)" Q
|
---|
| 112 | .S LEXRT=$P(LEXX,";",4),LEXT=$P(LEXX,";",5),LEXF=$P(LEXX,";",6)
|
---|
| 113 | .S (LEXB1,LEXB2)="",$P(LEXB1," ",(15-$L(LEXRT)))="",$P(LEXB2," ",(28-$L(LEXT)))=""
|
---|
| 114 | .I '$D(@LEXGBL) S:LEXS'[LEXRT LEXS=LEXS_", "_LEXRT S X=-1 S:LEXGBL["LEXM("&(X=1) X=0
|
---|
| 115 | I $L(LEXS),X'>0 D
|
---|
| 116 | .S:LEXS[", " LEXS=$P(LEXS,", ",1,($L(LEXS,", ")-1))_" and "_$P(LEXS,", ",$L(LEXS,", "))
|
---|
| 117 | .S:$E(LEXS,1,2)=", " LEXS=$E(LEXS,3,$L(LEXS)) S:$E(LEXS,1,7)[" and " LEXS=$P(LEXS," and ",2)
|
---|
| 118 | .D:X=-1 ET(("Global"_$S(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
|
---|
| 119 | .D:X=0 CM
|
---|
| 120 | Q X
|
---|
| 121 | RGNF ; Required global not found
|
---|
| 122 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF D IMP
|
---|
| 123 | I $G(LEXGL)["^LEX",$G(LEXGL)'["^LEXM" D
|
---|
| 124 | .D ET("")
|
---|
| 125 | .D ET("Required global "_$P($G(LEXGL),"(",1)_" not found.")
|
---|
| 126 | I $G(LEXGL)["^LEX",$G(LEXGL)["^LEXM" D CM
|
---|
| 127 | Q
|
---|
| 128 | CHK ; Check the Checksum
|
---|
| 129 | D CS I $D(LEXE) D ED Q
|
---|
| 130 | D BM(" OK"),M(" ")
|
---|
| 131 | Q
|
---|
| 132 | CS ; Checksum for import global
|
---|
| 133 | K LEXE
|
---|
| 134 | D BM(" Running checksum routine on the ^LEXM import global, please wait")
|
---|
| 135 | N LEXCHK,LEXNDS,LEXVER
|
---|
| 136 | S LEXCHK=+$G(^LEXM(0,"CHECKSUM"))
|
---|
| 137 | S LEXNDS=+$G(^LEXM(0,"NODES"))
|
---|
| 138 | S LEXVER=+$$VC(LEXCHK,LEXNDS)
|
---|
| 139 | D M(" ") D:LEXVER>0 M(" Checksum is ok"),M(" ")
|
---|
| 140 | S LEXVER=1 ; <======
|
---|
| 141 | D:LEXVER=0 CM
|
---|
| 142 | D:LEXVER=-1 CW
|
---|
| 143 | D:LEXVER=-2 CU
|
---|
| 144 | D:LEXVER=-3 CF
|
---|
| 145 | Q
|
---|
| 146 | VC(X,Y) ; Verify Checksum for import global
|
---|
| 147 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF Q:'$D(^LEXM) 0
|
---|
| 148 | D IMP
|
---|
| 149 | I $G(^LEXM(0,"BUILD"))'=$G(LEXBUILD) Q -1
|
---|
| 150 | N LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
|
---|
| 151 | S LEXCHK=+$G(X),LEXNDS=+$G(Y)
|
---|
| 152 | Q:LEXCHK'>0!(LEXNDS'>0) -2
|
---|
| 153 | S LEXL=64,(LEXCNT,LEXLC)=0,LEXS=+(LEXNDS\LEXL)
|
---|
| 154 | S:LEXS=0 LEXS=1
|
---|
| 155 | D:+$O(^LEXM(0))>0 M("")
|
---|
| 156 | S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0
|
---|
| 157 | W " "
|
---|
| 158 | F S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC) D
|
---|
| 159 | .Q:LEXN="^LEXM(0,""CHECKSUM"")"
|
---|
| 160 | .Q:LEXN="^LEXM(0,""NODES"")"
|
---|
| 161 | .S LEXCNT=LEXCNT+1
|
---|
| 162 | .I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
|
---|
| 163 | .S LEXNC=LEXNC+1,LEXD=@LEXN,LEXT=LEXN_"="_LEXD
|
---|
| 164 | .F LEXP=1:1:$L(LEXT) S LEXGCS=$A(LEXT,LEXP)*LEXP+LEXGCS
|
---|
| 165 | Q:LEXNC'=LEXNDS -3
|
---|
| 166 | Q:LEXGCS'=LEXCHK -3
|
---|
| 167 | Q 1
|
---|
| 168 | SY(X) ; Check System variables
|
---|
| 169 | Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
|
---|
| 170 | Q 1
|
---|
| 171 | UR(X) ; Check User variables
|
---|
| 172 | Q:'$L($G(DUZ(0))) 0
|
---|
| 173 | Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
|
---|
| 174 | Q 1
|
---|
| 175 | CPD(X) ; Check Current Patched Data is installed
|
---|
| 176 | N INS S INS=1
|
---|
| 177 | Q 0
|
---|
| 178 | ;
|
---|
| 179 | ; Error messages
|
---|
| 180 | ;
|
---|
| 181 | CM ; Missing ^LEXM
|
---|
| 182 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF D IMP D ET(""),ET("Missing import global ^LEXM.") D CO
|
---|
| 183 | Q
|
---|
| 184 | CW ; Wrong ^LEXM
|
---|
| 185 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXB D IMP S LEXB=$G(^LEXM(0,"BUILD")) D ET("")
|
---|
| 186 | I $L(LEXBUILD),$L(LEXB),LEXBUILD'=LEXB D Q
|
---|
| 187 | .D ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
|
---|
| 188 | .D CKO
|
---|
| 189 | D ET("Incorrect import global ^LEXM found.") D CKO
|
---|
| 190 | Q
|
---|
| 191 | CU ; Unable to verify
|
---|
| 192 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
|
---|
| 193 | D IMP
|
---|
| 194 | D ET("")
|
---|
| 195 | D ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).")
|
---|
| 196 | D CKO
|
---|
| 197 | Q
|
---|
| 198 | CF ; Failed checksum
|
---|
| 199 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
|
---|
| 200 | D IMP
|
---|
| 201 | D ET("")
|
---|
| 202 | D ET("Import global ^LEXM failed checksum.")
|
---|
| 203 | D CKO
|
---|
| 204 | Q
|
---|
| 205 | CO ; Obtain new global
|
---|
| 206 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
|
---|
| 207 | D IMP
|
---|
| 208 | D ET("")
|
---|
| 209 | D ET(" Please obtain a copy of the import global ^LEXM contained in the ")
|
---|
| 210 | D ET((" global host file "_LEXIGHF_" before continuing with the "_LEXBUILD))
|
---|
| 211 | D ET((" installation."))
|
---|
| 212 | Q
|
---|
| 213 | CKO ; Kill and Obtain new global
|
---|
| 214 | N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
|
---|
| 215 | D IMP
|
---|
| 216 | D ET(""),ET(" Please KILL the existing import global ^LEXM from your system")
|
---|
| 217 | D ET((" and obtain a new copy of ^LEXM contained in the global host file"))
|
---|
| 218 | D ET((" "_LEXIGHF_" before continuing with the "_LEXBUILD_" installation."))
|
---|
| 219 | Q
|
---|
| 220 | ET(X) ; Error Text
|
---|
| 221 | N LEXI S LEXI=+($G(LEXE(0))),LEXI=LEXI+1,LEXE(LEXI)=" "_$G(X),LEXE(0)=LEXI
|
---|
| 222 | Q
|
---|
| 223 | ED ; Error Display
|
---|
| 224 | N LEXI S LEXI=0 F S LEXI=$O(LEXE(LEXI)) Q:+LEXI=0 D M(LEXE(LEXI))
|
---|
| 225 | D M(" ") K LEXE Q
|
---|
| 226 | ;
|
---|
| 227 | ; Miscellaneous
|
---|
| 228 | ;
|
---|
| 229 | IMP ; Import names
|
---|
| 230 | S LEXLREV=41,LEXREQP="LEX*2.0*50",LEXBUILD="LEX*2.0*41"
|
---|
| 231 | S LEXIGHF="LEX_2_41.GBL"
|
---|
| 232 | Q
|
---|
| 233 | NOTDEF(IEN) ; Check to see if user is defined
|
---|
| 234 | N DA,DR,DIQ,LEX,DIC
|
---|
| 235 | S DA=IEN,DR=.01,DIC=200,DIQ="LEX"
|
---|
| 236 | D EN^DIQ1
|
---|
| 237 | Q '$D(LEX)
|
---|
| 238 | OK ; Environment is OK
|
---|
| 239 | N LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXT
|
---|
| 240 | D IMP S LEXT=" Environment "_$S($L(LEXBUILD):("for patch/build "_LEXBUILD_" "),1:"")_"is ok"
|
---|
| 241 | D BM(LEXT),M(" ")
|
---|
| 242 | Q
|
---|
| 243 | BM(X) ; Blank Line with Message
|
---|
| 244 | D BMES^XPDUTL($G(X)) Q
|
---|
| 245 | M(X) ; Message
|
---|
| 246 | D MES^XPDUTL($G(X)) Q
|
---|
| 247 | TRIM(X) ; Trim Spaces
|
---|
| 248 | S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
---|
| 249 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
---|
| 250 | Q X
|
---|
| 251 | EF ; Exported Files
|
---|
| 252 | ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
|
---|
| 253 | ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
|
---|
| 254 | ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
|
---|
| 255 | ;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
|
---|
| 256 | GD ; Global Data
|
---|
| 257 | ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
|
---|
| 258 | ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
|
---|
| 259 | ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
|
---|
| 260 | ;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
|
---|