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