source: FOIAVistA/tag/r/LEXICON_UTILITY-LEX-GMPT/LEX2028.m@ 636

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

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