source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2041.m@ 686

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1LEX2041 ; 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 ;
11ENV ; 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 ;
62QUIT ; Quit Passed Environment Check
63 K LEXFULL D OK
64 Q
65EXIT ; Exit Failed Environment Check
66 D:$D(LEXE) ED S XPDQUIT=2 K LEXE,LEXFULL Q
67ABRT ; 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 ;
75GBLS ; 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
100RGBL(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
121RGNF ; 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
128CHK ; Check the Checksum
129 D CS I $D(LEXE) D ED Q
130 D BM(" OK"),M(" ")
131 Q
132CS ; 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
146VC(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
168SY(X) ; Check System variables
169 Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
170 Q 1
171UR(X) ; Check User variables
172 Q:'$L($G(DUZ(0))) 0
173 Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
174 Q 1
175CPD(X) ; Check Current Patched Data is installed
176 N INS S INS=1
177 Q 0
178 ;
179 ; Error messages
180 ;
181CM ; Missing ^LEXM
182 N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF D IMP D ET(""),ET("Missing import global ^LEXM.") D CO
183 Q
184CW ; 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
191CU ; 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
198CF ; 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
205CO ; 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
213CKO ; 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
220ET(X) ; Error Text
221 N LEXI S LEXI=+($G(LEXE(0))),LEXI=LEXI+1,LEXE(LEXI)=" "_$G(X),LEXE(0)=LEXI
222 Q
223ED ; 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 ;
229IMP ; 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
233NOTDEF(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)
238OK ; 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
243BM(X) ; Blank Line with Message
244 D BMES^XPDUTL($G(X)) Q
245M(X) ; Message
246 D MES^XPDUTL($G(X)) Q
247TRIM(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
251EF ; 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 #
256GD ; 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 #
Note: See TracBrowser for help on using the repository browser.