LEX2051 ;ISL/FJF - Environment Check/Pre/Post Install ; 30 Aug 2011 11:24 PM
;;2.0;LEXICON UTILITY;**51**;Sep 23, 1996;Build 10
;
; External References
; DBIA 10015 EN^DIQ1
; DBIA 10141 $$PATCH^XPDUTL
; DBIA 10141 $$VERSION^XPDUTL
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
ENV ; LEX*2.0*51 Environment Check
;
; General
W !," Problem List Standardization SNOMED CT subset release",!
;
N LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXG,LEXE
D IMP
S U="^"
; No user
D:+$$UR'>0 ET("User not defined (DUZ)")
; No IO
D:+$$SY'>0 ET("Undefined IO variable(s)")
I $D(LEXE) D ABRT Q
;
; Load Distribution
;
; XPDENV = 0 Environment Check during Load
;
; Check Version (2.0)
I $$VERSION^XPDUTL("LEX")'="2.0" D D ABRT Q
. D ET("Version 2.0 not found. Please install Lexicon Utility v 2.0")
;
; Check Required Patches
D:'$L($G(LEXREQP)) IMP I $L(LEXREQP) D
.N LEXPAT,LEXI,LEXPN
.F LEXI=1:1 Q:'$L($P(LEXREQP,";",LEXI)) S LEXPAT=$P(LEXREQP,";",LEXI) D
..S LEXPN=$$PATCH^XPDUTL(LEXPAT)
..W !," Checking for ",LEXPAT I +LEXPN>0 H 1 W " - installed"
..I +LEXPN'>0 D ET((LEXPAT_" not found, please install "_LEXPAT_" before continuing"))
I $D(LEXE) D ABRT Q
S LEXG=$$RGBL
I $D(LEXE)&(+LEXG=0) D ABRT Q
I $D(LEXE)&(+LEXG<0) D ABRT Q
I '$D(LEXFULL)&(+($G(XPDENV))'=1) D QUIT Q
;
; Install Package(s)
;
; XPDENV = 1 Environment Check during Install
;
; Check Data "is installed" or "is translated"
N LEXIT S LEXIT=+$$CPD
I '$D(LEXFULL)&(LEXIT)
D QUIT
Q
; Checking Global "Write" Protection
D:+($G(XPDENV))=1 GBLS I $D(LEXE) D ABRT Q
; Check Import Global Checksum
D:+($G(XPDENV))=1 CS I $D(LEXE) D ABRT Q
;
; Quit, Exit or Abort
;
QUIT ; Quit Passed Environment Check
K LEXFULL D OK
Q
EXIT ; Exit Failed Environment Check
D:$D(LEXE) ED
S XPDQUIT=2
K LEXE,LEXFULL
Q
ABRT ; Abort Failed Environment Check, KILL the distribution
D:$D(LEXE) ED
S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*51")=1
K LEXE,LEXFULL
Q
;
; Checks
;
GBLS ; Check Write access on globals
N LEXE,LEXGBL,LEXRT,LEXT,LEXF,LEXI,LEXX,LEXOK,LEXCPD,LEXS,X S LEXOK=1
D BM(" I will now check the protection on ^LEX, ^ICPT, ^ICD and ^DIC Globals.")
D M(" If you get an ERROR, you will need to change the protection on these")
D M(" globals to allow read/write as indicated:")
D BM(" Owner Group World Network")
D M(" Cache systems RWD RW RW RWD")
D BM(" Checking:"),M(" ")
S LEXCPD=$$CPD,LEXS="",X=1 F LEXI=1:1 D Q:'$L(LEXX)
.S LEXX=""
.S LEXE="S LEXX=$T(GD+"_LEXI_")"
.X LEXE
.S LEXX=$$TRIM(LEXX)
.Q:'$L(LEXX)
.Q:'$L($TR(LEXX,";",""))
.S LEXGBL=$P(LEXX,";",3)
.Q:+LEXCPD>0&(LEXGBL="^LEXM(0)")
.S LEXRT=$P(LEXX,";",4),LEXT=$P(LEXX,";",5),LEXF=$P(LEXX,";",6)
.S (LEXB1,LEXB2)=""
.S $P(LEXB1," ",(19-$L(LEXRT)))="",$P(LEXB2," ",(28-$L(LEXT)))=""
.I '$D(@LEXGBL) D RGNF S LEXOK=0 D M((" <"_LEXRT_" not found>")) Q
.D M((" "_LEXRT_LEXB1_LEXT_LEXB2_LEXF))
.S @LEXGBL=$G(@LEXGBL) H 1
D:LEXOK M(" --> ok") D:'LEXOK M(" ??") D M(" ")
Q
RGBL(X) ; Check Write access on globals
N LEXCPD,LEXS,LEXI,LEXX,LEXEC,LEXGBL,LEXRT,LEXT,LEXF,LEXB1,LEXB2
S LEXCPD=$$CPD,LEXS="",X=1
F LEXI=1:1 D Q:'$L(LEXX)
.S LEXX=""
.S LEXEC="S LEXX=$T(GD+"_LEXI_")"
.X LEXEC
.S LEXX=$$TRIM(LEXX)
.Q:'$L(LEXX)
.Q:'$L($TR(LEXX,";",""))
.S LEXGBL=$P(LEXX,";",3)
.I +LEXCPD>0,LEXGBL="^LEXM(0)" Q
.S LEXRT=$P(LEXX,";",4),LEXT=$P(LEXX,";",5),LEXF=$P(LEXX,";",6)
.S (LEXB1,LEXB2)="",$P(LEXB1," ",(15-$L(LEXRT)))="",$P(LEXB2," ",(28-$L(LEXT)))=""
.I '$D(@LEXGBL) S:LEXS'[LEXRT LEXS=LEXS_", "_LEXRT S X=-1 S:LEXGBL["LEXM("&(X=1) X=0
I $L(LEXS),X'>0 D
.S:LEXS[", " LEXS=$P(LEXS,", ",1,($L(LEXS,", ")-1))_" and "_$P(LEXS,", ",$L(LEXS,", "))
.S:$E(LEXS,1,2)=", " LEXS=$E(LEXS,3,$L(LEXS)) S:$E(LEXS,1,7)[" and " LEXS=$P(LEXS," and ",2)
.D:X=-1 ET(("Global"_$S(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
.D:X=0 CM
Q X
RGNF ; Required global not found
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
D IMP
I $G(LEXGBL)["^LEX",$G(LEXGBL)'["^LEXM" D
.D ET("")
.D ET("Required global "_$P($G(LEXGBL),"(",1)_" not found.")
I $G(LEXGBL)["^LEX",$G(LEXGBL)["^LEXM" D CM
Q
CHK ; Check the Checksum
D CS I $D(LEXE) D ED Q
D BM(" OK"),M(" ")
Q
CS ; Checksum for import global
K LEXE
D BM(" Running checksum routine on the ^LEXM import global, please wait")
N LEXCHK,LEXNDS,LEXVER
S LEXCHK=+$G(^LEXM(0,"CHECKSUM"))
S LEXNDS=+$G(^LEXM(0,"NODES"))
S LEXVER=+$$VC(LEXCHK,LEXNDS)
D M(" ") D:LEXVER>0 M(" Checksum is ok"),M(" ")
S LEXVER=1 ; <======
D:LEXVER=0 CM
D:LEXVER=-1 CW
D:LEXVER=-2 CU
D:LEXVER=-3 CF
Q
VC(X,Y) ; Verify Checksum for import global
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF Q:'$D(^LEXM) 0
D IMP
I $G(^LEXM(0,"BUILD"))'=$G(LEXBUILD) Q -1
N LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
S LEXCHK=+$G(X),LEXNDS=+$G(Y)
Q:LEXCHK'>0!(LEXNDS'>0) -2
S LEXL=64,(LEXCNT,LEXLC)=0,LEXS=+(LEXNDS\LEXL)
S:LEXS=0 LEXS=1
D:+$O(^LEXM(0))>0 M("")
S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0
W " "
F S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC) D
.Q:LEXN="^LEXM(0,""CHECKSUM"")"
.Q:LEXN="^LEXM(0,""NODES"")"
.S LEXCNT=LEXCNT+1
.I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
.S LEXNC=LEXNC+1,LEXD=@LEXN,LEXT=LEXN_"="_LEXD
.F LEXP=1:1:$L(LEXT) S LEXGCS=$A(LEXT,LEXP)*LEXP+LEXGCS
Q:LEXNC'=LEXNDS -3
Q:LEXGCS'=LEXCHK -3
Q 1
SY(X) ; Check System variables
Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
Q 1
UR(X) ; Check User variables
Q:'$L($G(DUZ(0))) 0
Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
Q 1
CPD(X) ; Check Current Patched Data is installed
N INS S INS=1
Q 0
;
; Error messages
;
CM ; Missing ^LEXM
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF D IMP D ET(""),ET("Missing import global ^LEXM.") D CO
Q
CW ; Wrong ^LEXM
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXB
D IMP
S LEXB=$G(^LEXM(0,"BUILD")) D ET("")
I $L(LEXBUILD),$L(LEXB),LEXBUILD'=LEXB D Q
.D ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
.D CKO
D ET("Incorrect import global ^LEXM found.") D CKO
Q
CU ; Unable to verify
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
D IMP
D ET("")
D ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).")
D CKO
Q
CF ; Failed checksum
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
D IMP
D ET("")
D ET("Import global ^LEXM failed checksum.")
D CKO
Q
CO ; Obtain new global
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
D IMP
D ET("")
D ET(" Please obtain a copy of the import global ^LEXM contained in the ")
D ET((" global host file "_LEXIGHF_" before continuing with the "_LEXBUILD))
D ET((" installation."))
Q
CKO ; Kill and Obtain new global
N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
D IMP
D ET(""),ET(" Please KILL the existing import global ^LEXM from your system")
D ET((" and obtain a new copy of ^LEXM contained in the global host file"))
D ET((" "_LEXIGHF_" before continuing with the "_LEXBUILD_" installation."))
Q
ET(X) ; Error Text
N LEXI
S LEXI=+$G(LEXE(0)),LEXI=LEXI+1,LEXE(LEXI)=" "_$G(X),LEXE(0)=LEXI
Q
ED ; Error Display
N LEXI S LEXI=0 F S LEXI=$O(LEXE(LEXI)) Q:+LEXI=0 D M(LEXE(LEXI))
D M(" ") K LEXE Q
;
; Miscellaneous
;
IMP ; Import names
S LEXLREV=51,LEXREQP="LEX*2.0*41",LEXBUILD="LEX*2.0*51"
S LEXIGHF="LEX_2_51.GBL"
Q
NOTDEF(IEN) ; Check to see if user is defined
N DA,DR,DIQ,LEX,DIC
S DA=IEN,DR=.01,DIC=200,DIQ="LEX"
D EN^DIQ1
Q '$D(LEX)
OK ; Environment is OK
N LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXT
D IMP S LEXT=" Environment "_$S($L(LEXBUILD):("for patch/build "_LEXBUILD_" "),1:"")_"is ok"
D BM(LEXT),M(" ")
Q
BM(X) ; Blank Line with Message
D BMES^XPDUTL($G(X)) Q
M(X) ; Message
D MES^XPDUTL($G(X)) Q
TRIM(X) ; Trim Spaces
S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
EF ; Exported Files
;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
GD ; Global Data
;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
LEX2051 ;ISL/FJF - Environment Check/Pre/Post Install ; 30 Aug 2011 11:24 PM
+1 ;;2.0;LEXICON UTILITY;**51**;Sep 23, 1996;Build 10
+2 ;
+3 ; External References
+4 ; DBIA 10015 EN^DIQ1
+5 ; DBIA 10141 $$PATCH^XPDUTL
+6 ; DBIA 10141 $$VERSION^XPDUTL
+7 ; DBIA 10141 BMES^XPDUTL
+8 ; DBIA 10141 MES^XPDUTL
+9 ;
ENV ; LEX*2.0*51 Environment Check
+1 ;
+2 ; General
+3 WRITE !," Problem List Standardization SNOMED CT subset release",!
+4 ;
+5 NEW LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXG,LEXE
+6 DO IMP
+7 SET U="^"
+8 ; No user
+9 IF +$$UR'>0
DO ET("User not defined (DUZ)")
+10 ; No IO
+11 IF +$$SY'>0
DO ET("Undefined IO variable(s)")
+12 IF $DATA(LEXE)
DO ABRT
QUIT
+13 ;
+14 ; Load Distribution
+15 ;
+16 ; XPDENV = 0 Environment Check during Load
+17 ;
+18 ; Check Version (2.0)
+19 IF $$VERSION^XPDUTL("LEX")'="2.0"
Begin DoDot:1
+20 DO ET("Version 2.0 not found. Please install Lexicon Utility v 2.0")
End DoDot:1
DO ABRT
QUIT
+21 ;
+22 ; Check Required Patches
+23 IF '$LENGTH($GET(LEXREQP))
DO IMP
IF $LENGTH(LEXREQP)
Begin DoDot:1
+24 NEW LEXPAT,LEXI,LEXPN
+25 FOR LEXI=1:1
IF '$LENGTH($PIECE(LEXREQP,";",LEXI))
QUIT
SET LEXPAT=$PIECE(LEXREQP,";",LEXI)
Begin DoDot:2
+26 SET LEXPN=$$PATCH^XPDUTL(LEXPAT)
+27 WRITE !," Checking for ",LEXPAT
IF +LEXPN>0
HANG 1
WRITE " - installed"
+28 IF +LEXPN'>0
DO ET((LEXPAT_" not found, please install "_LEXPAT_" before continuing"))
End DoDot:2
End DoDot:1
+29 IF $DATA(LEXE)
DO ABRT
QUIT
+30 SET LEXG=$$RGBL
+31 IF $DATA(LEXE)&(+LEXG=0)
DO ABRT
QUIT
+32 IF $DATA(LEXE)&(+LEXG<0)
DO ABRT
QUIT
+33 IF '$DATA(LEXFULL)&(+($GET(XPDENV))'=1)
DO QUIT
QUIT
+34 ;
+35 ; Install Package(s)
+36 ;
+37 ; XPDENV = 1 Environment Check during Install
+38 ;
+39 ; Check Data "is installed" or "is translated"
+40 NEW LEXIT
SET LEXIT=+$$CPD
+41 IF '$DATA(LEXFULL)&(LEXIT)
+42 DO QUIT
+43 QUIT
+44 ; Checking Global "Write" Protection
+45 IF +($GET(XPDENV))=1
DO GBLS
IF $DATA(LEXE)
DO ABRT
QUIT
+46 ; Check Import Global Checksum
+47 IF +($GET(XPDENV))=1
DO CS
IF $DATA(LEXE)
DO ABRT
QUIT
+48 ;
+49 ; Quit, Exit or Abort
+50 ;
QUIT ; Quit Passed Environment Check
+1 KILL LEXFULL
DO OK
+2 QUIT
EXIT ; Exit Failed Environment Check
+1 IF $DATA(LEXE)
DO ED
+2 SET XPDQUIT=2
+3 KILL LEXE,LEXFULL
+4 QUIT
ABRT ; Abort Failed Environment Check, KILL the distribution
+1 IF $DATA(LEXE)
DO ED
+2 SET XPDABORT=1
SET XPDQUIT=1
SET XPDQUIT("LEX*2.0*51")=1
+3 KILL LEXE,LEXFULL
+4 QUIT
+5 ;
+6 ; Checks
+7 ;
GBLS ; Check Write access on globals
+1 NEW LEXE,LEXGBL,LEXRT,LEXT,LEXF,LEXI,LEXX,LEXOK,LEXCPD,LEXS,X
SET LEXOK=1
+2 DO BM(" I will now check the protection on ^LEX, ^ICPT, ^ICD and ^DIC Globals.")
+3 DO M(" If you get an ERROR, you will need to change the protection on these")
+4 DO M(" globals to allow read/write as indicated:")
+5 DO BM(" Owner Group World Network")
+6 DO M(" Cache systems RWD RW RW RWD")
+7 DO BM(" Checking:")
DO M(" ")
+8 SET LEXCPD=$$CPD
SET LEXS=""
SET X=1
FOR LEXI=1:1
Begin DoDot:1
+9 SET LEXX=""
+10 SET LEXE="S LEXX=$T(GD+"_LEXI_")"
+11 XECUTE LEXE
+12 SET LEXX=$$TRIM(LEXX)
+13 IF '$LENGTH(LEXX)
QUIT
+14 IF '$LENGTH($TRANSLATE(LEXX,";",""))
QUIT
+15 SET LEXGBL=$PIECE(LEXX,";",3)
+16 IF +LEXCPD>0&(LEXGBL="^LEXM(0)")
QUIT
+17 SET LEXRT=$PIECE(LEXX,";",4)
SET LEXT=$PIECE(LEXX,";",5)
SET LEXF=$PIECE(LEXX,";",6)
+18 SET (LEXB1,LEXB2)=""
+19 SET $PIECE(LEXB1," ",(19-$LENGTH(LEXRT)))=""
SET $PIECE(LEXB2," ",(28-$LENGTH(LEXT)))=""
+20 IF '$DATA(@LEXGBL)
DO RGNF
SET LEXOK=0
DO M((" <"_LEXRT_" not found>"))
QUIT
+21 DO M((" "_LEXRT_LEXB1_LEXT_LEXB2_LEXF))
+22 SET @LEXGBL=$GET(@LEXGBL)
HANG 1
End DoDot:1
IF '$LENGTH(LEXX)
QUIT
+23 IF LEXOK
DO M(" --> ok")
IF 'LEXOK
DO M(" ??")
DO M(" ")
+24 QUIT
RGBL(X) ; Check Write access on globals
+1 NEW LEXCPD,LEXS,LEXI,LEXX,LEXEC,LEXGBL,LEXRT,LEXT,LEXF,LEXB1,LEXB2
+2 SET LEXCPD=$$CPD
SET LEXS=""
SET X=1
+3 FOR LEXI=1:1
Begin DoDot:1
+4 SET LEXX=""
+5 SET LEXEC="S LEXX=$T(GD+"_LEXI_")"
+6 XECUTE LEXEC
+7 SET LEXX=$$TRIM(LEXX)
+8 IF '$LENGTH(LEXX)
QUIT
+9 IF '$LENGTH($TRANSLATE(LEXX,";",""))
QUIT
+10 SET LEXGBL=$PIECE(LEXX,";",3)
+11 IF +LEXCPD>0
IF LEXGBL="^LEXM(0)"
QUIT
+12 SET LEXRT=$PIECE(LEXX,";",4)
SET LEXT=$PIECE(LEXX,";",5)
SET LEXF=$PIECE(LEXX,";",6)
+13 SET (LEXB1,LEXB2)=""
SET $PIECE(LEXB1," ",(15-$LENGTH(LEXRT)))=""
SET $PIECE(LEXB2," ",(28-$LENGTH(LEXT)))=""
+14 IF '$DATA(@LEXGBL)
IF LEXS'[LEXRT
SET LEXS=LEXS_", "_LEXRT
SET X=-1
IF LEXGBL["LEXM("&(X=1)
SET X=0
End DoDot:1
IF '$LENGTH(LEXX)
QUIT
+15 IF $LENGTH(LEXS)
IF X'>0
Begin DoDot:1
+16 IF LEXS[", "
SET LEXS=$PIECE(LEXS,", ",1,($LENGTH(LEXS,", ")-1))_" and "_$PIECE(LEXS,", ",$LENGTH(LEXS,", "))
+17 IF $EXTRACT(LEXS,1,2)=", "
SET LEXS=$EXTRACT(LEXS,3,$LENGTH(LEXS))
IF $EXTRACT(LEXS,1,7)[" and "
SET LEXS=$PIECE(LEXS," and ",2)
+18 IF X=-1
DO ET(("Global"_$SELECT(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
+19 IF X=0
DO CM
End DoDot:1
+20 QUIT X
RGNF ; Required global not found
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
+2 DO IMP
+3 IF $GET(LEXGBL)["^LEX"
IF $GET(LEXGBL)'["^LEXM"
Begin DoDot:1
+4 DO ET("")
+5 DO ET("Required global "_$PIECE($GET(LEXGBL),"(",1)_" not found.")
End DoDot:1
+6 IF $GET(LEXGBL)["^LEX"
IF $GET(LEXGBL)["^LEXM"
DO CM
+7 QUIT
CHK ; Check the Checksum
+1 DO CS
IF $DATA(LEXE)
DO ED
QUIT
+2 DO BM(" OK")
DO M(" ")
+3 QUIT
CS ; Checksum for import global
+1 KILL LEXE
+2 DO BM(" Running checksum routine on the ^LEXM import global, please wait")
+3 NEW LEXCHK,LEXNDS,LEXVER
+4 SET LEXCHK=+$GET(^LEXM(0,"CHECKSUM"))
+5 SET LEXNDS=+$GET(^LEXM(0,"NODES"))
+6 SET LEXVER=+$$VC(LEXCHK,LEXNDS)
+7 DO M(" ")
IF LEXVER>0
DO M(" Checksum is ok")
DO M(" ")
+8 ; <======
SET LEXVER=1
+9 IF LEXVER=0
DO CM
+10 IF LEXVER=-1
DO CW
+11 IF LEXVER=-2
DO CU
+12 IF LEXVER=-3
DO CF
+13 QUIT
VC(X,Y) ; Verify Checksum for import global
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
IF '$DATA(^LEXM)
QUIT 0
+2 DO IMP
+3 IF $GET(^LEXM(0,"BUILD"))'=$GET(LEXBUILD)
QUIT -1
+4 NEW LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
+5 SET LEXCHK=+$GET(X)
SET LEXNDS=+$GET(Y)
+6 IF LEXCHK'>0!(LEXNDS'>0)
QUIT -2
+7 SET LEXL=64
SET (LEXCNT,LEXLC)=0
SET LEXS=+(LEXNDS\LEXL)
+8 IF LEXS=0
SET LEXS=1
+9 IF +$ORDER(^LEXM(0))>0
DO M("")
+10 SET (LEXC,LEXN)="^LEXM"
SET (LEXNC,LEXGCS)=0
+11 WRITE " "
+12 FOR
SET LEXN=$QUERY(@LEXN)
IF LEXN=""!(LEXN'[LEXC)
QUIT
Begin DoDot:1
+13 IF LEXN="^LEXM(0,""CHECKSUM"")"
QUIT
+14 IF LEXN="^LEXM(0,""NODES"")"
QUIT
+15 SET LEXCNT=LEXCNT+1
+16 IF LEXCNT'<LEXS
SET LEXLC=LEXLC+1
IF LEXLC'>LEXL
WRITE "."
SET LEXCNT=0
+17 SET LEXNC=LEXNC+1
SET LEXD=@LEXN
SET LEXT=LEXN_"="_LEXD
+18 FOR LEXP=1:1:$LENGTH(LEXT)
SET LEXGCS=$ASCII(LEXT,LEXP)*LEXP+LEXGCS
End DoDot:1
+19 IF LEXNC'=LEXNDS
QUIT -3
+20 IF LEXGCS'=LEXCHK
QUIT -3
+21 QUIT 1
SY(X) ; Check System variables
+1 IF '$DATA(IO)!('$DATA(IOF))!('$DATA(IOM))!('$DATA(ION))!('$DATA(IOSL))!('$DATA(IOST))
QUIT 0
+2 QUIT 1
UR(X) ; Check User variables
+1 IF '$LENGTH($GET(DUZ(0)))
QUIT 0
+2 IF +($GET(DUZ))=0!($$NOTDEF(+$GET(DUZ)))
QUIT 0
+3 QUIT 1
CPD(X) ; Check Current Patched Data is installed
+1 NEW INS
SET INS=1
+2 QUIT 0
+3 ;
+4 ; Error messages
+5 ;
CM ; Missing ^LEXM
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
DO IMP
DO ET("")
DO ET("Missing import global ^LEXM.")
DO CO
+2 QUIT
CW ; Wrong ^LEXM
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXB
+2 DO IMP
+3 SET LEXB=$GET(^LEXM(0,"BUILD"))
DO ET("")
+4 IF $LENGTH(LEXBUILD)
IF $LENGTH(LEXB)
IF LEXBUILD'=LEXB
Begin DoDot:1
+5 DO ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
+6 DO CKO
End DoDot:1
QUIT
+7 DO ET("Incorrect import global ^LEXM found.")
DO CKO
+8 QUIT
CU ; Unable to verify
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
+2 DO IMP
+3 DO ET("")
+4 DO ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).")
+5 DO CKO
+6 QUIT
CF ; Failed checksum
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
+2 DO IMP
+3 DO ET("")
+4 DO ET("Import global ^LEXM failed checksum.")
+5 DO CKO
+6 QUIT
CO ; Obtain new global
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
+2 DO IMP
+3 DO ET("")
+4 DO ET(" Please obtain a copy of the import global ^LEXM contained in the ")
+5 DO ET((" global host file "_LEXIGHF_" before continuing with the "_LEXBUILD))
+6 DO ET((" installation."))
+7 QUIT
CKO ; Kill and Obtain new global
+1 NEW LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
+2 DO IMP
+3 DO ET("")
DO ET(" Please KILL the existing import global ^LEXM from your system")
+4 DO ET((" and obtain a new copy of ^LEXM contained in the global host file"))
+5 DO ET((" "_LEXIGHF_" before continuing with the "_LEXBUILD_" installation."))
+6 QUIT
ET(X) ; Error Text
+1 NEW LEXI
+2 SET LEXI=+$GET(LEXE(0))
SET LEXI=LEXI+1
SET LEXE(LEXI)=" "_$GET(X)
SET LEXE(0)=LEXI
+3 QUIT
ED ; Error Display
+1 NEW LEXI
SET LEXI=0
FOR
SET LEXI=$ORDER(LEXE(LEXI))
IF +LEXI=0
QUIT
DO M(LEXE(LEXI))
+2 DO M(" ")
KILL LEXE
QUIT
+3 ;
+4 ; Miscellaneous
+5 ;
IMP ; Import names
+1 SET LEXLREV=51
SET LEXREQP="LEX*2.0*41"
SET LEXBUILD="LEX*2.0*51"
+2 SET LEXIGHF="LEX_2_51.GBL"
+3 QUIT
NOTDEF(IEN) ; Check to see if user is defined
+1 NEW DA,DR,DIQ,LEX,DIC
+2 SET DA=IEN
SET DR=.01
SET DIC=200
SET DIQ="LEX"
+3 DO EN^DIQ1
+4 QUIT '$DATA(LEX)
OK ; Environment is OK
+1 NEW LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXT
+2 DO IMP
SET LEXT=" Environment "_$SELECT($LENGTH(LEXBUILD):("for patch/build "_LEXBUILD_" "),1:"")_"is ok"
+3 DO BM(LEXT)
DO M(" ")
+4 QUIT
BM(X) ; Blank Line with Message
+1 DO BMES^XPDUTL($GET(X))
QUIT
M(X) ; Message
+1 DO MES^XPDUTL($GET(X))
QUIT
TRIM(X) ; Trim Spaces
+1 SET X=$GET(X)
FOR
IF $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
IF $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 QUIT X
EF ; Exported Files
+1 ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
+2 ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
+3 ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
+4 ;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
GD ; Global Data
+1 ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
+2 ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
+3 ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
+4 ;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
