Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEX2019

LEX2019.m

Go to the documentation of this file. 
  1. LEX2019 ;ISA/FJF-Environment Check/Pre/Post Install;10-01-01
  1.  ;;2.0;LEXICON UTILITY;**19**;Sep 23, 1996
  1.  ;
  1. ENV ; LEX*2.0*19 Environment Check
  1.  ;           
  1.  ;   General
  1.  ;
  1.  N LEXBUILD,LEXIGHF,LEXLAST,LEXLREV,LEXG D IMP S U="^"
  1.  ;     No user
  1.  I '$$UR D ET("User not defined (DUZ)")
  1.  ;     No IO
  1.  D:'$$SY ET("Undefined IO variable(s)") I $D(LEXE) D EXIT Q
  1.  ;                
  1.  ;   Load Distribution
  1.  ;
  1.  ;     Not version 2.0
  1.  I $$VERSION^XPDUTL("LEX")'="2.0" D  D ABRT Q
  1.  .D ET("Version 2.0 not found.  Please install Lexicon Utility v 2.0")
  1.  I $D(LEXE) D ABRT Q
  1.  ;     Missing last data patch
  1.  D:'$L($G(LEXLAST)) IMP I $L(LEXLAST) D
  1.  .N LEXPN S LEXPN=$$PATCH^XPDUTL(LEXLAST)
  1.  .I 'LEXPN D ET((LEXLAST_" not found, please install "_LEXLAST_" before continuing"))
  1.  I $D(LEXE) D ABRT Q
  1.  ;I +($G(XPDENV))'=1
  1.  S LEXG=$$RGBL
  1.  I $D(LEXE)&(+LEXG=0) D EXIT Q
  1.  I $D(LEXE)&(+LEXG<0) D ABRT Q
  1.  I '$D(LEXFULL)&(+($G(XPDENV))'=1) D QUIT Q
  1.  ;                
  1.  ;   Install Package(s)
  1.  ;
  1.  ;     Check Data "is installed" or "is translated"
  1.  N LEXIT S LEXIT=+($$CPD)
  1.  I '$D(LEXFULL)&(LEXIT) D QUIT Q
  1.  ;     Checking Global "Write" Protection during install
  1.  D:+($G(XPDENV))=1 GBLS
  1.  I $D(LEXE) D EXIT Q
  1.  ;     Import Global Checksum during install
  1.  D:+($G(XPDENV))=1 CS
  1.  I $D(LEXE) D EXIT Q
  1.  ;                
  1.  ;   Quit, Exit or Abort
  1.  ;
  1. QUIT ;     Quit   Passed Environment Check
  1.  K LEXFULL W !!,"  Environment is ok",!
  1.  Q
  1. EXIT ;     Exit   Failed Environment Check
  1.  D:$D(LEXE) ED S XPDQUIT=2 K LEXE,LEXFULL Q
  1. ABRT ;     Abort  Failed Environment Check, KILL the distribution
  1.  D:$D(LEXE) ED S XPDQUIT=1 K LEXE,LEXFULL Q
  1.  ;               
  1.  ; Checks
  1.  ;
  1. GBLS ;   Check Write access on globals
  1.  N LEXOK S LEXOK=1 W !!,"I will now check the protection on ^LEX, ^LEXT and ^LEXM Globals.  If you"
  1.  W !,"get an ERROR, you will need to change the protection on these globals to"
  1.  W !,"allow read/write as indicated for the appropriate M system:"
  1.  W !!,"    SYSTEM   PROTECTION   FOR FILE ACCESS ATTRIBUTES"
  1.  W !,"    ------   ----------   ----------------------------"
  1.  W !,"    DSM          RW       System   World  Group  UCI"
  1.  W !,"    Open M       RW       Network                Owner    (default)"
  1.  W !!,"Checking:" N LEXGL
  1.  F LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)" D  Q:'LEXOK
  1.  . I '$D(@LEXGL) D RGNF S LEXOK=0 W "      <",$P(LEXGL,"(",1)," not found>" Q
  1.  . W "      ",$P(LEXGL,"(",1) S @LEXGL=$G(@LEXGL) H 1
  1.  W:LEXOK "    --> ok",! W:'LEXOK "    ??",!
  1.  Q
  1. RGBL(X) ; Look for require globals
  1.  N LEXGL,LEX0,LEXS
  1.  S LEXS="",X=1
  1.  F LEXGL="^LEX(757,0)","^LEXT(757.2,0)","^LEXM(0)" D
  1.  .I '$D(@LEXGL) D
  1.  ..S:LEXS'[$P(LEXGL,"(",1) LEXS=LEXS_", "_$P(LEXGL,"(",1)
  1.  ..S:LEXGL["X("!((LEXGL["T(")) X=-1 S:LEXGL["M("&(X=1) X=0
  1.  .S LEX0=$G(@LEXGL)
  1.  .I $L(LEX0,"^")'=4 D
  1.  ..S:LEXS'[$P(LEXGL,"(",1) LEXS=LEXS_", "_$P(LEXGL,"(",1)
  1.  ..S:LEXGL["X("!((LEXGL["T(")) X=-1 S:LEXGL["M("&(X=1) X=0
  1.  I $L(LEXS),X'>0 D
  1.  .S:LEXS[", " LEXS=$P(LEXS,", ",1,($L(LEXS,", ")-1))_" and "_$P(LEXS,", ",$L(LEXS,", "))
  1.  .S:$E(LEXS,1,2)=", " LEXS=$E(LEXS,3,$L(LEXS))
  1.  .S:$E(LEXS,1,7)[" and " LEXS=$P(LEXS," and ",2)
  1.  .I X=-1 D
  1.  ..D IMP
  1.  ..N LEXLN S LEXLN=+($P($G(LEXLAST),"*",3))
  1.  ..D ET(("Lexicon v2.0 global"_$S(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
  1.  ..D:LEXLN>1 ET(""),ET(("    Please re-install the Lexicon Utility v 2.0 with patches 1-"_LEXLN_"."))
  1.  .D:X=0 CM
  1.  Q X
  1. RGNF ; Required global not found
  1.  N LEXBUILD,LEXIGHF D IMP
  1.  D:$G(LEXGL)["^LEX"&($G(LEXGL)'["^LEXM") ET(""),ET("Required global "_$P($G(LEXGL),"(",1)_" not found.")
  1.  D:$G(LEXGL)["^LEX"&($G(LEXGL)["^LEXM") CM
  1.  Q
  1. CHK D CS I $D(LEXE) D ED Q
  1.  W !!,"  OK",!
  1.  Q
  1. CS ;   Checksum for import global
  1.  K LEXE
  1.  W !!,"Running checksum routine on the ^LEXM import global, please wait"
  1.  N LEXCHK,LEXNDS,LEXVER
  1.  S LEXCHK=+($G(^LEXM(0,"CHECKSUM")))
  1.  S LEXNDS=+($G(^LEXM(0,"NODES")))
  1.  S LEXVER=+($$VC(LEXCHK,LEXNDS))
  1.  W ! W:LEXVER>0 "  ok",!
  1.  D:LEXVER=0 CM
  1.  D:LEXVER=-1 CW
  1.  D:LEXVER=-2 CU
  1.  D:LEXVER=-3 CF
  1.  Q
  1. VC(X,Y) ;   Verify Checksum for import global
  1.  Q:'$D(^LEXM) 0 D IMP I $G(^LEXM(0,"BUILD"))'=$G(LEXBUILD) Q -1
  1.  N LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
  1.  S LEXCHK=+($G(X)),LEXNDS=+($G(Y)) Q:LEXCHK'>0!(LEXNDS'>0) -2
  1.  S LEXL=68,(LEXCNT,LEXLC)=0,LEXS=+(LEXNDS\LEXL)
  1.  S:LEXS=0 LEXS=1 W:+($O(^LEXM(0)))>0 !
  1.  S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0
  1.  F  S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC)  D
  1.  .Q:LEXN="^LEXM(0,""CHECKSUM"")"
  1.  .Q:LEXN="^LEXM(0,""NODES"")"
  1.  .S LEXCNT=LEXCNT+1
  1.  .I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
  1.  .S LEXNC=LEXNC+1,LEXD=@LEXN,LEXT=LEXN_"="_LEXD
  1.  .F LEXP=1:1:$L(LEXT) S LEXGCS=$A(LEXT,LEXP)*LEXP+LEXGCS
  1.  Q:LEXNC'=LEXNDS -3
  1.  Q:LEXGCS'=LEXCHK -3
  1.  Q 1
  1. SY(X) ;   Check System variables
  1.  Q:'$D(IO)!('$D(IOF))!('$D(IOM))!('$D(ION))!('$D(IOSL))!('$D(IOST)) 0
  1.  Q 1
  1. UR(X) ;   Check User variables
  1.  Q:'$L($G(DUZ(0))) 0
  1.  Q:+($G(DUZ))=0!($$NOTDEF(+$G(DUZ))) 0
  1.  Q 1
  1. CPD(X) ;   Check Current Patched Data is installed
  1.  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
  1.  Q 0
  1.  ; Error messages
  1.  ;
  1. CM ;   Missing ^LEXM
  1.  N LEXBUILD,LEXIGHF
  1.  D IMP
  1.  D ET("")
  1.  D ET("Missing import global ^LEXM.")
  1.  D CO
  1.  Q
  1. CW ;   Wrong ^LEXM
  1.  N LEXBUILD,LEXIGHF,LEXB
  1.  D IMP
  1.  S LEXB=$G(^LEXM(0,"BUILD"))
  1.  D ET("")
  1.  I $L(LEXBUILD),$L(LEXB),LEXBUILD'=LEXB D  Q
  1.  .D ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
  1.  .D CKO
  1.  D ET("Incorrect import global ^LEXM found.")
  1.  D CKO
  1.  Q
  1. CU ;   Unable to verify
  1.  N LEXBUILD,LEXIGHF
  1.  D IMP
  1.  D ET("")
  1.  D ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).")
  1.  D CKO
  1.  Q
  1. CF ;   Failed checksum
  1.  N LEXBUILD,LEXIGHF
  1.  D IMP
  1.  D ET("")
  1.  D ET("Import global ^LEXM failed checksum.")
  1.  D CKO
  1.  Q
  1. CO ;   Obtain new global
  1.  D ET("")
  1.  D ET("    Please obtain a copy of the import global ^LEXM contained in the ")
  1.  D ET(("    global host file "_LEXIGHF_" before continuing with the "_LEXBUILD))
  1.  D ET(("    installation."))
  1.  Q
  1. CKO ;   Kill and Obtain new global
  1.  D ET("")
  1.  D ET("    Please KILL the existing import global ^LEXM from your system")
  1.  D ET(("    and obtain a new copy of ^LEXM contained in the global host file"))
  1.  D ET(("    "_LEXIGHF_" before continuing with the "_LEXBUILD_" installation."))
  1.  Q
  1. ET(X)    ;   Error Text
  1.  N LEXI S LEXI=+($G(LEXE(0))),LEXI=LEXI+1,LEXE(LEXI)="    "_$G(X),LEXE(0)=LEXI
  1.  Q
  1. ED ;   Error Display
  1.  N LEXI S LEXI=0 F  S LEXI=$O(LEXE(LEXI)) Q:+LEXI=0  W !,LEXE(LEXI)
  1.  W ! K LEXE Q
  1.  ;                   
  1.  ; Miscellaneous
  1.  ;
  1. IMP ;   Import names
  1.  ;
  1.  S LEXLREV=7,LEXLAST="LEX*2.0*18",LEXBUILD="LEX*2.0*19"
  1.  S LEXIGHF="LEX_2_P19.GBL"
  1.  Q
  1. NOTDEF(IEN) ; check to see if user is defined
  1.  N DA,DR,DIQ,LEX,DIC
  1.  S DA=IEN
  1.  S DR=.01
  1.  S DIC=200
  1.  S DIQ="LEX"
  1.  D EN^DIQ1
  1.  Q '$D(LEX)