source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2048.m@ 1683

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

initial load of FOIAVistA 6/30/08 version

File size: 9.2 KB
Line 
1LEX2048 ; 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 ;
11ENV ; 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 ;
58QUIT ; Quit Passed Environment Check
59 K LEXFULL D OK
60 Q
61EXIT ; Exit Failed Environment Check
62 D:$D(LEXE) ED S XPDQUIT=2 K LEXE,LEXFULL Q
63ABRT ; 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 ;
70GBLS ; 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
86RGBL(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
99RGNF ; 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
104CHK ; Check the Checksum
105 D CS I $D(LEXE) D ED Q
106 D BM(" OK"),M(" ")
107 Q
108CS ; 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
116VC(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
135SY(X) ; Check System variables
136 Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
137 Q 1
138UR(X) ; Check User variables
139 Q:'$L($G(DUZ(0))) 0
140 Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
141 Q 1
142CPD(X) ; Check Current Patched Data is installed
143 N INS S INS=1
144 Q 0
145 ;
146 ; Error messages
147 ;
148CM ; Missing ^LEXM
149 N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP D ET(""),ET("Missing import global ^LEXM.") D CO
150 Q
151CW ; 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
157CU ; 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
160CF ; 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
163CO ; 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
169CKO ; 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
175ET(X) ; Error Text
176 N LEXI S LEXI=+($G(LEXE(0))),LEXI=LEXI+1,LEXE(LEXI)=" "_$G(X),LEXE(0)=LEXI
177 Q
178ED ; 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 ;
184NOTDEF(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)
186OK ; 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
191BM(X) ; Blank Line with Message
192 D BMES^XPDUTL($G(X)) Q
193M(X) ; Message
194 D MES^XPDUTL($G(X)) Q
195TRIM(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
199IMP ; 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
216EF ; 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
232GD ; 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
Note: See TracBrowser for help on using the repository browser.