source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2019.m@ 1535

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

initial load of FOIAVistA 6/30/08 version

File size: 6.6 KB
Line 
1LEX2019 ;ISA/FJF-Environment Check/Pre/Post Install;10-01-01
2 ;;2.0;LEXICON UTILITY;**19**;Sep 23, 1996
3 ;
4ENV ; LEX*2.0*19 Environment Check
5 ;
6 ; General
7 ;
8 N LEXBUILD,LEXIGHF,LEXLAST,LEXLREV,LEXG D IMP S U="^"
9 ; No user
10 I '$$UR D ET("User not defined (DUZ)")
11 ; No IO
12 D:'$$SY ET("Undefined IO variable(s)") I $D(LEXE) D EXIT Q
13 ;
14 ; Load Distribution
15 ;
16 ; Not version 2.0
17 I $$VERSION^XPDUTL("LEX")'="2.0" D D ABRT Q
18 .D ET("Version 2.0 not found. Please install Lexicon Utility v 2.0")
19 I $D(LEXE) D ABRT Q
20 ; Missing last data patch
21 D:'$L($G(LEXLAST)) IMP I $L(LEXLAST) D
22 .N LEXPN S LEXPN=$$PATCH^XPDUTL(LEXLAST)
23 .I 'LEXPN D ET((LEXLAST_" not found, please install "_LEXLAST_" before continuing"))
24 I $D(LEXE) D ABRT Q
25 ;I +($G(XPDENV))'=1
26 S LEXG=$$RGBL
27 I $D(LEXE)&(+LEXG=0) D EXIT Q
28 I $D(LEXE)&(+LEXG<0) D ABRT Q
29 I '$D(LEXFULL)&(+($G(XPDENV))'=1) D QUIT Q
30 ;
31 ; Install Package(s)
32 ;
33 ; Check Data "is installed" or "is translated"
34 N LEXIT S LEXIT=+($$CPD)
35 I '$D(LEXFULL)&(LEXIT) D QUIT Q
36 ; Checking Global "Write" Protection during install
37 D:+($G(XPDENV))=1 GBLS
38 I $D(LEXE) D EXIT Q
39 ; Import Global Checksum during install
40 D:+($G(XPDENV))=1 CS
41 I $D(LEXE) D EXIT Q
42 ;
43 ; Quit, Exit or Abort
44 ;
45QUIT ; Quit Passed Environment Check
46 K LEXFULL W !!," Environment is ok",!
47 Q
48EXIT ; Exit Failed Environment Check
49 D:$D(LEXE) ED S XPDQUIT=2 K LEXE,LEXFULL Q
50ABRT ; Abort Failed Environment Check, KILL the distribution
51 D:$D(LEXE) ED S XPDQUIT=1 K LEXE,LEXFULL Q
52 ;
53 ; Checks
54 ;
55GBLS ; Check Write access on globals
56 N LEXOK S LEXOK=1 W !!,"I will now check the protection on ^LEX, ^LEXT and ^LEXM Globals. If you"
57 W !,"get an ERROR, you will need to change the protection on these globals to"
58 W !,"allow read/write as indicated for the appropriate M system:"
59 W !!," SYSTEM PROTECTION FOR FILE ACCESS ATTRIBUTES"
60 W !," ------ ---------- ----------------------------"
61 W !," DSM RW System World Group UCI"
62 W !," Open M RW Network Owner (default)"
63 W !!,"Checking:" N LEXGL
64 F LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)" D Q:'LEXOK
65 . I '$D(@LEXGL) D RGNF S LEXOK=0 W " <",$P(LEXGL,"(",1)," not found>" Q
66 . W " ",$P(LEXGL,"(",1) S @LEXGL=$G(@LEXGL) H 1
67 W:LEXOK " --> ok",! W:'LEXOK " ??",!
68 Q
69RGBL(X) ; Look for require globals
70 N LEXGL,LEX0,LEXS
71 S LEXS="",X=1
72 F LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)" D
73 .I '$D(@LEXGL) D
74 ..S:LEXS'[$P(LEXGL,"(",1) LEXS=LEXS_", "_$P(LEXGL,"(",1)
75 ..S:LEXGL["X("!((LEXGL["T(")) X=-1 S:LEXGL["M("&(X=1) X=0
76 .S LEX0=$G(@LEXGL)
77 .I $L(LEX0,"^")'=4 D
78 ..S:LEXS'[$P(LEXGL,"(",1) LEXS=LEXS_", "_$P(LEXGL,"(",1)
79 ..S:LEXGL["X("!((LEXGL["T(")) X=-1 S:LEXGL["M("&(X=1) X=0
80 I $L(LEXS),X'>0 D
81 .S:LEXS[", " LEXS=$P(LEXS,", ",1,($L(LEXS,", ")-1))_" and "_$P(LEXS,", ",$L(LEXS,", "))
82 .S:$E(LEXS,1,2)=", " LEXS=$E(LEXS,3,$L(LEXS))
83 .S:$E(LEXS,1,7)[" and " LEXS=$P(LEXS," and ",2)
84 .I X=-1 D
85 ..D IMP
86 ..N LEXLN S LEXLN=+($P($G(LEXLAST),"*",3))
87 ..D ET(("Lexicon v2.0 global"_$S(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
88 ..D:LEXLN>1 ET(""),ET((" Please re-install the Lexicon Utility v 2.0 with patches 1-"_LEXLN_"."))
89 .D:X=0 CM
90 Q X
91RGNF ; Required global not found
92 N LEXBUILD,LEXIGHF D IMP
93 D:$G(LEXGL)["^LEX"&($G(LEXGL)'["^LEXM") ET(""),ET("Required global "_$P($G(LEXGL),"(",1)_" not found.")
94 D:$G(LEXGL)["^LEX"&($G(LEXGL)["^LEXM") CM
95 Q
96CHK D CS I $D(LEXE) D ED Q
97 W !!," OK",!
98 Q
99CS ; Checksum for import global
100 K LEXE
101 W !!,"Running checksum routine on the ^LEXM import global, please wait"
102 N LEXCHK,LEXNDS,LEXVER
103 S LEXCHK=+($G(^LEXM(0,"CHECKSUM")))
104 S LEXNDS=+($G(^LEXM(0,"NODES")))
105 S LEXVER=+($$VC(LEXCHK,LEXNDS))
106 W ! W:LEXVER>0 " ok",!
107 D:LEXVER=0 CM
108 D:LEXVER=-1 CW
109 D:LEXVER=-2 CU
110 D:LEXVER=-3 CF
111 Q
112VC(X,Y) ; Verify Checksum for import global
113 Q:'$D(^LEXM) 0 D IMP I $G(^LEXM(0,"BUILD"))'=$G(LEXBUILD) Q -1
114 N LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
115 S LEXCHK=+($G(X)),LEXNDS=+($G(Y)) Q:LEXCHK'>0!(LEXNDS'>0) -2
116 S LEXL=68,(LEXCNT,LEXLC)=0,LEXS=+(LEXNDS\LEXL)
117 S:LEXS=0 LEXS=1 W:+($O(^LEXM(0)))>0 !
118 S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0
119 F S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC) D
120 .Q:LEXN="^LEXM(0,""CHECKSUM"")"
121 .Q:LEXN="^LEXM(0,""NODES"")"
122 .S LEXCNT=LEXCNT+1
123 .I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
124 .S LEXNC=LEXNC+1,LEXD=@LEXN,LEXT=LEXN_"="_LEXD
125 .F LEXP=1:1:$L(LEXT) S LEXGCS=$A(LEXT,LEXP)*LEXP+LEXGCS
126 Q:LEXNC'=LEXNDS -3
127 Q:LEXGCS'=LEXCHK -3
128 Q 1
129SY(X) ; Check System variables
130 Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
131 Q 1
132UR(X) ; Check User variables
133 Q:'$L($G(DUZ(0))) 0
134 Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
135 Q 1
136CPD(X) ; Check Current Patched Data is installed
137 I $D(^LEX(757.21,"C","VIRAL HEPATITIS B WITHOUT HEPATIC COMA, WITH HEPATITIS DELTA",6556)),'$D(^LEX(757.21,"C","VIRAL HEPATITIS B WITH HEPATIC COMA, WITHOUT MENTION OF HEPATIT",6556)) Q 1
138 Q 0
139 ; Error messages
140 ;
141CM ; Missing ^LEXM
142 N LEXBUILD,LEXIGHF
143 D IMP
144 D ET("")
145 D ET("Missing import global ^LEXM.")
146 D CO
147 Q
148CW ; Wrong ^LEXM
149 N LEXBUILD,LEXIGHF,LEXB
150 D IMP
151 S LEXB=$G(^LEXM(0,"BUILD"))
152 D ET("")
153 I $L(LEXBUILD),$L(LEXB),LEXBUILD'=LEXB D Q
154 .D ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
155 .D CKO
156 D ET("Incorrect import global ^LEXM found.")
157 D CKO
158 Q
159CU ; Unable to verify
160 N LEXBUILD,LEXIGHF
161 D IMP
162 D ET("")
163 D ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).")
164 D CKO
165 Q
166CF ; Failed checksum
167 N LEXBUILD,LEXIGHF
168 D IMP
169 D ET("")
170 D ET("Import global ^LEXM failed checksum.")
171 D CKO
172 Q
173CO ; Obtain new global
174 D ET("")
175 D ET(" Please obtain a copy of the import global ^LEXM contained in the ")
176 D ET((" global host file "_LEXIGHF_" before continuing with the "_LEXBUILD))
177 D ET((" installation."))
178 Q
179CKO ; Kill and Obtain new global
180 D ET("")
181 D ET(" Please KILL the existing import global ^LEXM from your system")
182 D ET((" and obtain a new copy of ^LEXM contained in the global host file"))
183 D ET((" "_LEXIGHF_" before continuing with the "_LEXBUILD_" installation."))
184 Q
185ET(X) ; Error Text
186 N LEXI S LEXI=+($G(LEXE(0))),LEXI=LEXI+1,LEXE(LEXI)=" "_$G(X),LEXE(0)=LEXI
187 Q
188ED ; Error Display
189 N LEXI S LEXI=0 F S LEXI=$O(LEXE(LEXI)) Q:+LEXI=0 W !,LEXE(LEXI)
190 W ! K LEXE Q
191 ;
192 ; Miscellaneous
193 ;
194IMP ; Import names
195 ;
196 S LEXLREV=7,LEXLAST="LEX*2.0*18",LEXBUILD="LEX*2.0*19"
197 S LEXIGHF="LEX_2_P19.GBL"
198 Q
199NOTDEF(IEN) ; check to see if user is defined
200 N DA,DR,DIQ,LEX,DIC
201 S DA=IEN
202 S DR=.01
203 S DIC=200
204 S DIQ="LEX"
205 D EN^DIQ1
206 Q '$D(LEX)
Note: See TracBrowser for help on using the repository browser.