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

LEX2051.m

Go to the documentation of this file. 
  1. 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
  1.  ;                     
  1.  ; External References
  1.  ;   DBIA 10015  EN^DIQ1
  1.  ;   DBIA 10141  $$PATCH^XPDUTL
  1.  ;   DBIA 10141  $$VERSION^XPDUTL
  1.  ;   DBIA 10141  BMES^XPDUTL
  1.  ;   DBIA 10141  MES^XPDUTL
  1.  ;                            
  1. ENV ; LEX*2.0*51 Environment Check
  1.  ;                    
  1.  ;   General
  1.  W !," Problem List Standardization SNOMED CT subset release",!
  1.  ;
  1.  N LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXG,LEXE
  1.  D IMP
  1.  S U="^"
  1.  ;     No user
  1.  D:+$$UR'>0 ET("User not defined (DUZ)")
  1.  ;     No IO
  1.  D:+$$SY'>0 ET("Undefined IO variable(s)")
  1.  I $D(LEXE) D ABRT Q
  1.  ;                    
  1.  ;   Load Distribution
  1.  ;
  1.  ;     XPDENV = 0 Environment Check during Load
  1.  ;
  1.  ;       Check 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.  ;
  1.  ;       Check Required Patches
  1.  D:'$L($G(LEXREQP)) IMP I $L(LEXREQP) D
  1.  .N LEXPAT,LEXI,LEXPN
  1.  .F LEXI=1:1 Q:'$L($P(LEXREQP,";",LEXI))  S LEXPAT=$P(LEXREQP,";",LEXI) D
  1.  ..S LEXPN=$$PATCH^XPDUTL(LEXPAT)
  1.  ..W !,"   Checking for ",LEXPAT I +LEXPN>0 H 1 W " - installed"
  1.  ..I +LEXPN'>0 D ET((LEXPAT_" not found, please install "_LEXPAT_" before continuing"))
  1.  I $D(LEXE) D ABRT Q
  1.  S LEXG=$$RGBL
  1.  I $D(LEXE)&(+LEXG=0) D ABRT 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.  ;     XPDENV = 1 Environment Check during Install
  1.  ;
  1.  ;       Check Data "is installed" or "is translated"
  1.  N LEXIT S LEXIT=+$$CPD
  1.  I '$D(LEXFULL)&(LEXIT)
  1.  D QUIT
  1.  Q
  1.  ;       Checking Global "Write" Protection 
  1.  D:+($G(XPDENV))=1 GBLS I $D(LEXE) D ABRT Q
  1.  ;       Check Import Global Checksum 
  1.  D:+($G(XPDENV))=1 CS I $D(LEXE) D ABRT Q
  1.  ;                    
  1.  ;   Quit, Exit or Abort
  1.  ;
  1. QUIT ;     Quit   Passed Environment Check
  1.  K LEXFULL D OK
  1.  Q
  1. EXIT ;     Exit   Failed Environment Check
  1.  D:$D(LEXE) ED
  1.  S XPDQUIT=2
  1.  K LEXE,LEXFULL
  1.  Q
  1. ABRT ;     Abort  Failed Environment Check, KILL the distribution
  1.  D:$D(LEXE) ED
  1.  S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*51")=1
  1.  K LEXE,LEXFULL
  1.  Q
  1.  ;               
  1.  ; Checks
  1.  ;
  1. GBLS ;   Check Write access on globals
  1.  N LEXE,LEXGBL,LEXRT,LEXT,LEXF,LEXI,LEXX,LEXOK,LEXCPD,LEXS,X S LEXOK=1
  1.  D BM("   I will now check the protection on ^LEX, ^ICPT, ^ICD and ^DIC Globals.")
  1.  D M("   If you get an ERROR, you will need to change the protection on these")
  1.  D M("   globals to allow read/write as indicated:")
  1.  D BM("                        Owner     Group    World   Network")
  1.  D M("      Cache systems      RWD       RW       RW      RWD")
  1.  D BM("   Checking:"),M(" ")
  1.  S LEXCPD=$$CPD,LEXS="",X=1 F LEXI=1:1 D  Q:'$L(LEXX)
  1.  .S LEXX=""
  1.  .S LEXE="S LEXX=$T(GD+"_LEXI_")"
  1.  .X LEXE
  1.  .S LEXX=$$TRIM(LEXX)
  1.  .Q:'$L(LEXX)
  1.  .Q:'$L($TR(LEXX,";",""))
  1.  .S LEXGBL=$P(LEXX,";",3)
  1.  .Q:+LEXCPD>0&(LEXGBL="^LEXM(0)")
  1.  .S LEXRT=$P(LEXX,";",4),LEXT=$P(LEXX,";",5),LEXF=$P(LEXX,";",6)
  1.  .S (LEXB1,LEXB2)=""
  1.  .S $P(LEXB1," ",(19-$L(LEXRT)))="",$P(LEXB2," ",(28-$L(LEXT)))=""
  1.  .I '$D(@LEXGBL) D RGNF S LEXOK=0 D M(("      <"_LEXRT_" not found>")) Q
  1.  .D M(("      "_LEXRT_LEXB1_LEXT_LEXB2_LEXF))
  1.  .S @LEXGBL=$G(@LEXGBL) H 1
  1.  D:LEXOK M("    --> ok") D:'LEXOK M("    ??") D M(" ")
  1.  Q
  1. RGBL(X) ;   Check Write access on globals
  1.  N LEXCPD,LEXS,LEXI,LEXX,LEXEC,LEXGBL,LEXRT,LEXT,LEXF,LEXB1,LEXB2
  1.  S LEXCPD=$$CPD,LEXS="",X=1
  1.  F LEXI=1:1 D  Q:'$L(LEXX)
  1.  .S LEXX=""
  1.  .S LEXEC="S LEXX=$T(GD+"_LEXI_")"
  1.  .X LEXEC
  1.  .S LEXX=$$TRIM(LEXX)
  1.  .Q:'$L(LEXX)
  1.  .Q:'$L($TR(LEXX,";",""))
  1.  .S LEXGBL=$P(LEXX,";",3)
  1.  .I +LEXCPD>0,LEXGBL="^LEXM(0)" Q
  1.  .S LEXRT=$P(LEXX,";",4),LEXT=$P(LEXX,";",5),LEXF=$P(LEXX,";",6)
  1.  .S (LEXB1,LEXB2)="",$P(LEXB1," ",(15-$L(LEXRT)))="",$P(LEXB2," ",(28-$L(LEXT)))=""
  1.  .I '$D(@LEXGBL) S:LEXS'[LEXRT LEXS=LEXS_", "_LEXRT S X=-1 S:LEXGBL["LEXM("&(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)) S:$E(LEXS,1,7)[" and " LEXS=$P(LEXS," and ",2)
  1.  .D:X=-1 ET(("Global"_$S(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
  1.  .D:X=0 CM
  1.  Q X
  1. RGNF ;   Required global not found
  1.  N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
  1.  D IMP
  1.  I $G(LEXGBL)["^LEX",$G(LEXGBL)'["^LEXM" D
  1.  .D ET("")
  1.  .D ET("Required global "_$P($G(LEXGBL),"(",1)_" not found.")
  1.  I $G(LEXGBL)["^LEX",$G(LEXGBL)["^LEXM" D CM
  1.  Q
  1. CHK ;   Check the Checksum
  1.  D CS I $D(LEXE) D ED Q
  1.  D BM("  OK"),M(" ")
  1.  Q
  1. CS ;   Checksum for import global
  1.  K LEXE
  1.  D BM("   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.  D M(" ") D:LEXVER>0 M("     Checksum is ok"),M(" ")
  1.  S LEXVER=1 ; <======
  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.  N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF Q:'$D(^LEXM) 0
  1.  D IMP
  1.  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)
  1.  Q:LEXCHK'>0!(LEXNDS'>0) -2
  1.  S LEXL=64,(LEXCNT,LEXLC)=0,LEXS=+(LEXNDS\LEXL)
  1.  S:LEXS=0 LEXS=1
  1.  D:+$O(^LEXM(0))>0 M("")
  1.  S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0
  1.  W "   "
  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.  N INS S INS=1
  1.  Q 0
  1.  ;               
  1.  ; Error messages
  1.  ;
  1. CM ;   Missing ^LEXM
  1.  N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF D IMP D ET(""),ET("Missing import global ^LEXM.") D CO
  1.  Q
  1. CW ;   Wrong ^LEXM
  1.  N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXB
  1.  D IMP
  1.  S LEXB=$G(^LEXM(0,"BUILD")) 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.") D CKO
  1.  Q
  1. CU ;   Unable to verify
  1.  N LEXLREV,LEXREQP,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 LEXLREV,LEXREQP,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.  N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
  1.  D IMP
  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.  N LEXLREV,LEXREQP,LEXBUILD,LEXIGHF
  1.  D IMP
  1.  D ET(""),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
  1.  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  D M(LEXE(LEXI))
  1.  D M(" ") K LEXE Q
  1.  ;                   
  1.  ; Miscellaneous
  1.  ;
  1. IMP ;   Import names
  1.  S LEXLREV=51,LEXREQP="LEX*2.0*41",LEXBUILD="LEX*2.0*51"
  1.  S LEXIGHF="LEX_2_51.GBL"
  1.  Q
  1. NOTDEF(IEN) ;   Check to see if user is defined
  1.  N DA,DR,DIQ,LEX,DIC
  1.  S DA=IEN,DR=.01,DIC=200,DIQ="LEX"
  1.  D EN^DIQ1
  1.  Q '$D(LEX)
  1. OK ;   Environment is OK
  1.  N LEXBUILD,LEXIGHF,LEXREQP,LEXLREV,LEXT
  1.  D IMP S LEXT="  Environment "_$S($L(LEXBUILD):("for patch/build "_LEXBUILD_" "),1:"")_"is ok"
  1.  D BM(LEXT),M(" ")
  1.  Q
  1. BM(X) ;   Blank Line with Message
  1.  D BMES^XPDUTL($G(X)) Q
  1. M(X) ;   Message
  1.  D MES^XPDUTL($G(X)) Q
  1. TRIM(X) ;   Trim Spaces
  1.  S X=$G(X) F  Q:$E(X,1)'=" "  S X=$E(X,2,$L(X))
  1.  F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,($L(X)-1))
  1.  Q X
  1. EF ;   Exported Files
  1.  ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
  1.  ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
  1.  ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
  1.  ;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #
  1. GD ;   Global Data
  1.  ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
  1.  ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
  1.  ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
  1.  ;;^LEXM(0);^LEXM(*;Lexicon Export/Import;No File #