source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2030.m@ 1674

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

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