LEX2019 ;ISA/FJF-Environment Check/Pre/Post Install;10-01-01
;;2.0;LEXICON UTILITY;**19**;Sep 23, 1996
;
ENV ; LEX*2.0*19 Environment Check
;
; General
;
N LEXBUILD,LEXIGHF,LEXLAST,LEXLREV,LEXG D IMP S U="^"
; No user
I '$$UR D ET("User not defined (DUZ)")
; No IO
D:'$$SY ET("Undefined IO variable(s)") I $D(LEXE) D EXIT Q
;
; Load Distribution
;
; Not 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")
I $D(LEXE) D ABRT Q
; Missing last data patch
D:'$L($G(LEXLAST)) IMP I $L(LEXLAST) D
.N LEXPN S LEXPN=$$PATCH^XPDUTL(LEXLAST)
.I 'LEXPN D ET((LEXLAST_" not found, please install "_LEXLAST_" before continuing"))
I $D(LEXE) D ABRT Q
;I +($G(XPDENV))'=1
S LEXG=$$RGBL
I $D(LEXE)&(+LEXG=0) D EXIT Q
I $D(LEXE)&(+LEXG<0) D ABRT Q
I '$D(LEXFULL)&(+($G(XPDENV))'=1) D QUIT Q
;
; Install Package(s)
;
; Check Data "is installed" or "is translated"
N LEXIT S LEXIT=+($$CPD)
I '$D(LEXFULL)&(LEXIT) D QUIT Q
; Checking Global "Write" Protection during install
D:+($G(XPDENV))=1 GBLS
I $D(LEXE) D EXIT Q
; Import Global Checksum during install
D:+($G(XPDENV))=1 CS
I $D(LEXE) D EXIT Q
;
; Quit, Exit or Abort
;
QUIT ; Quit Passed Environment Check
K LEXFULL W !!," Environment is 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 XPDQUIT=1 K LEXE,LEXFULL Q
;
; Checks
;
GBLS ; Check Write access on globals
N LEXOK S LEXOK=1 W !!,"I will now check the protection on ^LEX, ^LEXT and ^LEXM Globals. If you"
W !,"get an ERROR, you will need to change the protection on these globals to"
W !,"allow read/write as indicated for the appropriate M system:"
W !!," SYSTEM PROTECTION FOR FILE ACCESS ATTRIBUTES"
W !," ------ ---------- ----------------------------"
W !," DSM RW System World Group UCI"
W !," Open M RW Network Owner (default)"
W !!,"Checking:" N LEXGL
F LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)" D Q:'LEXOK
. I '$D(@LEXGL) D RGNF S LEXOK=0 W " <",$P(LEXGL,"(",1)," not found>" Q
. W " ",$P(LEXGL,"(",1) S @LEXGL=$G(@LEXGL) H 1
W:LEXOK " --> ok",! W:'LEXOK " ??",!
Q
RGBL(X) ; Look for require globals
N LEXGL,LEX0,LEXS
S LEXS="",X=1
F LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)" D
.I '$D(@LEXGL) D
..S:LEXS'[$P(LEXGL,"(",1) LEXS=LEXS_", "_$P(LEXGL,"(",1)
..S:LEXGL["X("!((LEXGL["T(")) X=-1 S:LEXGL["M("&(X=1) X=0
.S LEX0=$G(@LEXGL)
.I $L(LEX0,"^")'=4 D
..S:LEXS'[$P(LEXGL,"(",1) LEXS=LEXS_", "_$P(LEXGL,"(",1)
..S:LEXGL["X("!((LEXGL["T(")) X=-1 S:LEXGL["M("&(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)
.I X=-1 D
..D IMP
..N LEXLN S LEXLN=+($P($G(LEXLAST),"*",3))
..D ET(("Lexicon v2.0 global"_$S(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
..D:LEXLN>1 ET(""),ET((" Please re-install the Lexicon Utility v 2.0 with patches 1-"_LEXLN_"."))
.D:X=0 CM
Q X
RGNF ; Required global not found
N LEXBUILD,LEXIGHF D IMP
D:$G(LEXGL)["^LEX"&($G(LEXGL)'["^LEXM") ET(""),ET("Required global "_$P($G(LEXGL),"(",1)_" not found.")
D:$G(LEXGL)["^LEX"&($G(LEXGL)["^LEXM") CM
Q
CHK D CS I $D(LEXE) D ED Q
W !!," OK",!
Q
CS ; Checksum for import global
K LEXE
W !!,"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))
W ! W:LEXVER>0 " ok",!
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
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=68,(LEXCNT,LEXLC)=0,LEXS=+(LEXNDS\LEXL)
S:LEXS=0 LEXS=1 W:+($O(^LEXM(0)))>0 !
S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0
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
I $D(^LEX(757.21,"C","VIRAL HEPATITIS B WITHOUT HEPATIC COMA, WITH HEPATITIS DELTA",6556)),'$D(^LEX(757.21,"C","VIRAL HEPATITIS B WITH HEPATIC COMA, WITHOUT MENTION OF HEPATIT",6556)) Q 1
Q 0
; Error messages
;
CM ; Missing ^LEXM
N LEXBUILD,LEXIGHF
D IMP
D ET("")
D ET("Missing import global ^LEXM.")
D CO
Q
CW ; Wrong ^LEXM
N 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 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 LEXBUILD,LEXIGHF
D IMP
D ET("")
D ET("Import global ^LEXM failed checksum.")
D CKO
Q
CO ; Obtain new global
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
D ET("")
D 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 W !,LEXE(LEXI)
W ! K LEXE Q
;
; Miscellaneous
;
IMP ; Import names
;
S LEXLREV=7,LEXLAST="LEX*2.0*18",LEXBUILD="LEX*2.0*19"
S LEXIGHF="LEX_2_P19.GBL"
Q
NOTDEF(IEN) ; check to see if user is defined
N DA,DR,DIQ,LEX,DIC
S DA=IEN
S DR=.01
S DIC=200
S DIQ="LEX"
D EN^DIQ1
Q '$D(LEX)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2019 6988 printed Sep 23, 2025@19:39:32 Page 2
LEX2019 ;ISA/FJF-Environment Check/Pre/Post Install;10-01-01
+1 ;;2.0;LEXICON UTILITY;**19**;Sep 23, 1996
+2 ;
ENV ; LEX*2.0*19 Environment Check
+1 ;
+2 ; General
+3 ;
+4 NEW LEXBUILD,LEXIGHF,LEXLAST,LEXLREV,LEXG
DO IMP
SET U="^"
+5 ; No user
+6 IF '$$UR
DO ET("User not defined (DUZ)")
+7 ; No IO
+8 if '$$SY
DO ET("Undefined IO variable(s)")
IF $DATA(LEXE)
DO EXIT
QUIT
+9 ;
+10 ; Load Distribution
+11 ;
+12 ; Not version 2.0
+13 IF $$VERSION^XPDUTL("LEX")'="2.0"
Begin DoDot:1
+14 DO ET("Version 2.0 not found. Please install Lexicon Utility v 2.0")
End DoDot:1
DO ABRT
QUIT
+15 IF $DATA(LEXE)
DO ABRT
QUIT
+16 ; Missing last data patch
+17 if '$LENGTH($GET(LEXLAST))
DO IMP
IF $LENGTH(LEXLAST)
Begin DoDot:1
+18 NEW LEXPN
SET LEXPN=$$PATCH^XPDUTL(LEXLAST)
+19 IF 'LEXPN
DO ET((LEXLAST_" not found, please install "_LEXLAST_" before continuing"))
End DoDot:1
+20 IF $DATA(LEXE)
DO ABRT
QUIT
+21 ;I +($G(XPDENV))'=1
+22 SET LEXG=$$RGBL
+23 IF $DATA(LEXE)&(+LEXG=0)
DO EXIT
QUIT
+24 IF $DATA(LEXE)&(+LEXG<0)
DO ABRT
QUIT
+25 IF '$DATA(LEXFULL)&(+($GET(XPDENV))'=1)
DO QUIT
QUIT
+26 ;
+27 ; Install Package(s)
+28 ;
+29 ; Check Data "is installed" or "is translated"
+30 NEW LEXIT
SET LEXIT=+($$CPD)
+31 IF '$DATA(LEXFULL)&(LEXIT)
DO QUIT
QUIT
+32 ; Checking Global "Write" Protection during install
+33 if +($GET(XPDENV))=1
DO GBLS
+34 IF $DATA(LEXE)
DO EXIT
QUIT
+35 ; Import Global Checksum during install
+36 if +($GET(XPDENV))=1
DO CS
+37 IF $DATA(LEXE)
DO EXIT
QUIT
+38 ;
+39 ; Quit, Exit or Abort
+40 ;
QUIT ; Quit Passed Environment Check
+1 KILL LEXFULL
WRITE !!," Environment is ok",!
+2 QUIT
EXIT ; Exit Failed Environment Check
+1 if $DATA(LEXE)
DO ED
SET XPDQUIT=2
KILL LEXE,LEXFULL
QUIT
ABRT ; Abort Failed Environment Check, KILL the distribution
+1 if $DATA(LEXE)
DO ED
SET XPDQUIT=1
KILL LEXE,LEXFULL
QUIT
+2 ;
+3 ; Checks
+4 ;
GBLS ; Check Write access on globals
+1 NEW LEXOK
SET LEXOK=1
WRITE !!,"I will now check the protection on ^LEX, ^LEXT and ^LEXM Globals. If you"
+2 WRITE !,"get an ERROR, you will need to change the protection on these globals to"
+3 WRITE !,"allow read/write as indicated for the appropriate M system:"
+4 WRITE !!," SYSTEM PROTECTION FOR FILE ACCESS ATTRIBUTES"
+5 WRITE !," ------ ---------- ----------------------------"
+6 WRITE !," DSM RW System World Group UCI"
+7 WRITE !," Open M RW Network Owner (default)"
+8 WRITE !!,"Checking:"
NEW LEXGL
+9 FOR LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)"
Begin DoDot:1
+10 IF '$DATA(@LEXGL)
DO RGNF
SET LEXOK=0
WRITE " <",$PIECE(LEXGL,"(",1)," not found>"
QUIT
+11 WRITE " ",$PIECE(LEXGL,"(",1)
SET @LEXGL=$GET(@LEXGL)
HANG 1
End DoDot:1
if 'LEXOK
QUIT
+12 if LEXOK
WRITE " --> ok",!
if 'LEXOK
WRITE " ??",!
+13 QUIT
RGBL(X) ; Look for require globals
+1 NEW LEXGL,LEX0,LEXS
+2 SET LEXS=""
SET X=1
+3 FOR LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)"
Begin DoDot:1
+4 IF '$DATA(@LEXGL)
Begin DoDot:2
+5 if LEXS'[$PIECE(LEXGL,"(",1)
SET LEXS=LEXS_", "_$PIECE(LEXGL,"(",1)
+6 if LEXGL["X("!((LEXGL["T("))
SET X=-1
if LEXGL["M("&(X=1)
SET X=0
End DoDot:2
+7 SET LEX0=$GET(@LEXGL)
+8 IF $LENGTH(LEX0,"^")'=4
Begin DoDot:2
+9 if LEXS'[$PIECE(LEXGL,"(",1)
SET LEXS=LEXS_", "_$PIECE(LEXGL,"(",1)
+10 if LEXGL["X("!((LEXGL["T("))
SET X=-1
if LEXGL["M("&(X=1)
SET X=0
End DoDot:2
End DoDot:1
+11 IF $LENGTH(LEXS)
IF X'>0
Begin DoDot:1
+12 if LEXS[", "
SET LEXS=$PIECE(LEXS,", ",1,($LENGTH(LEXS,", ")-1))_" and "_$PIECE(LEXS,", ",$LENGTH(LEXS,", "))
+13 if $EXTRACT(LEXS,1,2)=", "
SET LEXS=$EXTRACT(LEXS,3,$LENGTH(LEXS))
+14 if $EXTRACT(LEXS,1,7)[" and "
SET LEXS=$PIECE(LEXS," and ",2)
+15 IF X=-1
Begin DoDot:2
+16 DO IMP
+17 NEW LEXLN
SET LEXLN=+($PIECE($GET(LEXLAST),"*",3))
+18 DO ET(("Lexicon v2.0 global"_$SELECT(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
+19 if LEXLN>1
DO ET("")
DO ET((" Please re-install the Lexicon Utility v 2.0 with patches 1-"_LEXLN_"."))
End DoDot:2
+20 if X=0
DO CM
End DoDot:1
+21 QUIT X
RGNF ; Required global not found
+1 NEW LEXBUILD,LEXIGHF
DO IMP
+2 if $GET(LEXGL)["^LEX"&($GET(LEXGL)'["^LEXM")
DO ET("")
DO ET("Required global "_$PIECE($GET(LEXGL),"(",1)_" not found.")
+3 if $GET(LEXGL)["^LEX"&($GET(LEXGL)["^LEXM")
DO CM
+4 QUIT
CHK DO CS
IF $DATA(LEXE)
DO ED
QUIT
+1 WRITE !!," OK",!
+2 QUIT
CS ; Checksum for import global
+1 KILL LEXE
+2 WRITE !!,"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 WRITE !
if LEXVER>0
WRITE " ok",!
+8 if LEXVER=0
DO CM
+9 if LEXVER=-1
DO CW
+10 if LEXVER=-2
DO CU
+11 if LEXVER=-3
DO CF
+12 QUIT
VC(X,Y) ; Verify Checksum for import global
+1 if '$DATA(^LEXM)
QUIT 0
DO IMP
IF $GET(^LEXM(0,"BUILD"))'=$GET(LEXBUILD)
QUIT -1
+2 NEW LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
+3 SET LEXCHK=+($GET(X))
SET LEXNDS=+($GET(Y))
if LEXCHK'>0!(LEXNDS'>0)
QUIT -2
+4 SET LEXL=68
SET (LEXCNT,LEXLC)=0
SET LEXS=+(LEXNDS\LEXL)
+5 if LEXS=0
SET LEXS=1
if +($ORDER(^LEXM(0)))>0
WRITE !
+6 SET (LEXC,LEXN)="^LEXM"
SET (LEXNC,LEXGCS)=0
+7 FOR
SET LEXN=$QUERY(@LEXN)
if LEXN=""!(LEXN'[LEXC)
QUIT
Begin DoDot:1
+8 if LEXN="^LEXM(0,""CHECKSUM"")"
QUIT
+9 if LEXN="^LEXM(0,""NODES"")"
QUIT
+10 SET LEXCNT=LEXCNT+1
+11 IF LEXCNT'<LEXS
SET LEXLC=LEXLC+1
if LEXLC'>LEXL
WRITE "."
SET LEXCNT=0
+12 SET LEXNC=LEXNC+1
SET LEXD=@LEXN
SET LEXT=LEXN_"="_LEXD
+13 FOR LEXP=1:1:$LENGTH(LEXT)
SET LEXGCS=$ASCII(LEXT,LEXP)*LEXP+LEXGCS
End DoDot:1
+14 if LEXNC'=LEXNDS
QUIT -3
+15 if LEXGCS'=LEXCHK
QUIT -3
+16 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 IF $DATA(^LEX(757.21,"C","VIRAL HEPATITIS B WITHOUT HEPATIC COMA, WITH HEPATITIS DELTA",6556))
IF '$DATA(^LEX(757.21,"C","VIRAL HEPATITIS B WITH HEPATIC COMA, WITHOUT MENTION OF HEPATIT",6556))
QUIT 1
+2 QUIT 0
+3 ; Error messages
+4 ;
CM ; Missing ^LEXM
+1 NEW LEXBUILD,LEXIGHF
+2 DO IMP
+3 DO ET("")
+4 DO ET("Missing import global ^LEXM.")
+5 DO CO
+6 QUIT
CW ; Wrong ^LEXM
+1 NEW LEXBUILD,LEXIGHF,LEXB
+2 DO IMP
+3 SET LEXB=$GET(^LEXM(0,"BUILD"))
+4 DO ET("")
+5 IF $LENGTH(LEXBUILD)
IF $LENGTH(LEXB)
IF LEXBUILD'=LEXB
Begin DoDot:1
+6 DO ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
+7 DO CKO
End DoDot:1
QUIT
+8 DO ET("Incorrect import global ^LEXM found.")
+9 DO CKO
+10 QUIT
CU ; Unable to verify
+1 NEW 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 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 DO ET("")
+2 DO ET(" Please obtain a copy of the import global ^LEXM contained in the ")
+3 DO ET((" global host file "_LEXIGHF_" before continuing with the "_LEXBUILD))
+4 DO ET((" installation."))
+5 QUIT
CKO ; Kill and Obtain new global
+1 DO ET("")
+2 DO ET(" Please KILL the existing import global ^LEXM from your system")
+3 DO ET((" and obtain a new copy of ^LEXM contained in the global host file"))
+4 DO ET((" "_LEXIGHF_" before continuing with the "_LEXBUILD_" installation."))
+5 QUIT
ET(X) ; Error Text
+1 NEW LEXI
SET LEXI=+($GET(LEXE(0)))
SET LEXI=LEXI+1
SET LEXE(LEXI)=" "_$GET(X)
SET LEXE(0)=LEXI
+2 QUIT
ED ; Error Display
+1 NEW LEXI
SET LEXI=0
FOR
SET LEXI=$ORDER(LEXE(LEXI))
if +LEXI=0
QUIT
WRITE !,LEXE(LEXI)
+2 WRITE !
KILL LEXE
QUIT
+3 ;
+4 ; Miscellaneous
+5 ;
IMP ; Import names
+1 ;
+2 SET LEXLREV=7
SET LEXLAST="LEX*2.0*18"
SET LEXBUILD="LEX*2.0*19"
+3 SET LEXIGHF="LEX_2_P19.GBL"
+4 QUIT
NOTDEF(IEN) ; check to see if user is defined
+1 NEW DA,DR,DIQ,LEX,DIC
+2 SET DA=IEN
+3 SET DR=.01
+4 SET DIC=200
+5 SET DIQ="LEX"
+6 DO EN^DIQ1
+7 QUIT '$DATA(LEX)
