- LEX2104 ;ISL/KER - LEX*2.0*104 Env Check ;11/24/2015
- ;;2.0;LEXICON UTILITY;**104**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; ^LEXM N/A
- ;
- ; External References
- ; FIND^DIC ICR 2051
- ; $$IENS^DILF ICR 2054
- ; EN^DIQ1 ICR 10015
- ; $$FMTE^XLFDT ICR 10103
- ; $$PATCH^XPDUTL ICR 10141
- ; $$PKG^XPDUTL ICR 10141
- ; $$VER^XPDUTL ICR 10141
- ; $$VERSION^XPDUTL ICR 10141
- ; BMES^XPDUTL ICR 10141
- ; MES^XPDUTL ICR 10141
- ;
- ; Local Variables NEWed or KILLed by Kernel Installation
- ; and Distribution System (KIDS):
- ;
- ; XPDABORT,XPDDIQ,XPDQUIT
- ;
- ; see Kernel Developer Guide, Chapter 14,
- ; KIDS Developer Tools, Advanced Build Techniques
- ;
- ; The following sections must be updated with each quarterly
- ; patch
- ;
- ; IMP^LEX20nn Import names
- ;
- ; This section sets the following variables:
- ;
- ; LEXBUILD Build Name LEX*2.0*nn
- ; LEXPTYPE Patch Type Remedy or Quarterly
- ; LEXIGHF Name of Host File LEX_2_nn.GBL
- ; LEXLREV Revision Number nn
- ; LEXFY Fiscal Year FYnn
- ; LEXQTR Quarter 1st, 2nd, 3rd, or 4th
- ; LEXREQP(n) Required Patch Array
- ;
- ; GD^LEX20nn Global Data
- ;
- ; This is a listing of globals that this patch writes
- ; to, it contains a closed global root, a global ID,
- ; a global name and file numbers.
- ;
- ; IPL^LEX20nnP Informational Patch List
- ;
- ; This is a listing of informational patches that
- ; accompany this patch. It consist of a patch nane
- ; and a sequence number when available. It is used
- ; to update the package file at the site with the
- ; informational patches.
- ;
- ENV ; Environment Check
- ;
- ; General
- ;
- N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXG,LEXB,LEXE,LEXR,LEXSTR,LEXOK D IMP
- K XPDDIQ("XPZ1","B"),XPDDIQ("XPI1","B") S XPDDIQ("XPZ1","B")="NO",XPDDIQ("XPI1","B")="NO"
- S LEXSTR=$G(LEXPTYPE) S:$L($G(LEXFY))&($L($G(LEXQTR))) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
- D BM(LEXSTR),M("")
- 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")
- N LEXOK,LEXG,LEXR,LEXB
- ; Check Required Patches
- D:$O(LEXREQP(0))'>0 IMP I $O(LEXREQP(0))>0 D
- . W ! N LEXPAT,LEXI,LEXPN,LEXP,LEXR,LEXC,LEXO,LEXC1,LEXC2,LEXC3,LEXC4,LEX
- . S (LEXR,LEXC)=0 S LEXC1=3,LEXC2=24,LEXC3=37,LEXC4=50
- . S LEXI=0 F S LEXI=$O(LEXREQP(LEXI)) Q:+LEXI'>0 D
- . . S LEXC=LEXC+1,LEXPAT=$G(LEXREQP(LEXI))
- . S LEXI=0 F S LEXI=$O(LEXREQP(LEXI)) Q:+LEXI'>0 D
- . . N LEXPAT,LEXREL,LEXINS,LEXCOM,LEXINE,LEXREQ,LEXTX S LEXREQ=$G(LEXREQP(LEXI))
- . . S LEXPAT=$P(LEXREQ,"^",1),LEXREL=$P(LEXREQ,"^",2),LEXCOM=$P(LEXREQ,"^",3)
- . . S LEXPN=$$INS(LEXPAT) S LEXINS=$$INSD(LEXPAT),LEXINE=$P(LEXINS,"^",2)
- . . I LEXI=1 D
- . . . W !,?LEXC1,"Checking for ",!
- . . . W !,?LEXC1,"Patch",?LEXC2,"Released",?LEXC3,"Installed",?LEXC4,"Content"
- . . S LEXTX=$J(" ",LEXC1)_LEXPAT
- . . S LEXTX=LEXTX_$J(" ",(LEXC2-$L(LEXTX)))
- . . S:LEXREL?7N LEXTX=LEXTX_$P($$FMTE^XLFDT(LEXREL,"5DZ"),"@",1)
- . . S LEXTX=LEXTX_$J(" ",(LEXC3-$L(LEXTX)))
- . . I +LEXPN>0 D
- . . . S LEXO=+($G(LEXO))+1 S:$L($G(LEXINE)) LEXTX=LEXTX_LEXINE
- . . . S LEXTX=LEXTX_$J(" ",(LEXC4-$L(LEXTX)))
- . . . S:$L(LEXCOM) LEXTX=LEXTX_LEXCOM
- . . D M(LEXTX)
- . . I +LEXPN'>0 D
- . . . N LEXP S LEXP=$G(LEXPAT) S:LEXP[" SEQ"&($L($P(LEXP," SEQ",1))) LEXP=$P(LEXP," SEQ",1)
- . . . D ET((LEXP_" not found, please install "_LEXP_" before continuing"))
- . W:+($G(LEXO))'=LEXC !
- I $D(LEXE) D M(),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 S:$L($G(LEXBUILD)) XPDQUIT(LEXBUILD)=1
- K LEXE,LEXFULL
- Q
- T1 ; Environment Check #1 (for testing only)
- K XPDENV D ENV
- Q
- T2 ; Environment Check #2 (for testing only)
- N XPDENV S XPDENV=1 D ENV
- Q
- ;
- ; Checks
- ;
- GBLS ; Check Write access on globals
- N LEXB1,LEXB2,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)="",$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)
- 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) Q:+LEXCPD>0&(LEXGBL="^LEXM(0)") 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 LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP
- D:$G(LEXGBL)["^LEX"&($G(LEXGBL)'["^LEXM") ET(""),ET("Required global "_$P($G(LEXGBL),"(",1)_" not found.")
- D:$G(LEXGBL)["^LEX"&($G(LEXGBL)["^LEXM") CM
- Q
- INS(X) ; Installed
- N LEX,LEXP,LEXV,LEXI,LEXS S LEX=$P($G(X)," ",1) I $L(LEX,"*")=3 S X=$$PATCH^XPDUTL(LEX) Q X
- S LEXP=$$PKG^XPDUTL(LEX),LEXV=$$VER^XPDUTL(LEX),LEXI=$$VERSION^XPDUTL(LEXP)
- Q:+LEXV>0&(LEXV=LEXI) 1
- Q 0
- INSD(X) ; Installed on
- N DA,LEX,LEXDA,LEXE,LEXI,LEXMSG,LEXNS,LEXOUT,LEXPI,LEXPN,LEXSCR,LEXVI,LEXVD,LEXVI,LEXVR S LEX=$G(X)
- S LEXNS=$$PKG^XPDUTL(LEX),LEXVR=$$VER^XPDUTL(LEX),LEXPN=$P(X,"*",3)
- Q:'$L(LEXNS) "" S LEXVR=+LEXVR Q:LEXVR'>0 "" S LEXPN=+LEXPN S:LEXVR'["." LEXVR=LEXVR_".0"
- S LEXSCR="I $G(^DIC(9.4,+($G(Y)),""VERSION""))="""_LEXVR_""""
- D FIND^DIC(9.4,,.01,"O",LEXNS,10,"C",LEXSCR,,"LEXOUT","LEXMSG")
- S LEXPI=$G(LEXOUT("DILIST",2,1)) K LEXOUT,LEXMSG Q:+LEXPI'>0 "" Q:'$D(@("^DIC(9.4,"_LEXPI_",22)")) ""
- K DA S DA(1)=LEXPI S LEXDA=$$IENS^DILF(.DA)
- D FIND^DIC(9.49,LEXDA,".01;1I;2I","O",LEXVR,10,"B",,,"LEXOUT","LEXMSG")
- S LEXVD=$G(LEXOUT("DILIST","ID",1,2)) I $E(LEXVD,1,7)?7N&(+LEXPN'>0) D Q X
- . S X=$E(LEXVD,1,7)_"^"_$TR($$FMTE^XLFDT($E(LEXVD,1,7),"5DZ"),"@"," ")
- S:$E(LEXVD,1,7)'?7N LEXVD=$G(LEXOUT("DILIST","ID",1,1)) I $E(LEXVD,1,7)?7N&(+LEXPN'>0) D Q X
- . S X=$E(LEXVD,1,7)_"^"_$TR($$FMTE^XLFDT($E(LEXVD,1,7),"5DZ"),"@"," ")
- Q:+LEXPN'>0 "" S LEXVI=$G(LEXOUT("DILIST",2,1)) K LEXOUT,LEXMSG
- Q:+LEXVI'>0 "" Q:'$D(@("^DIC(9.4,"_LEXPI_",22,"_LEXVI_",""PAH"")")) ""
- K DA S DA(2)=LEXPI,DA(1)=LEXVI S LEXDA=$$IENS^DILF(.DA)
- S LEXSCR="I $G(^DIC(9.4,"_LEXPI_",22,"_LEXVI_",""PAH"",+($G(Y)),0))[""SEQ #"""
- D FIND^DIC(9.4901,LEXDA,".01;.02I",,LEXPN,10,"B",LEXSCR,,"LEXOUT","LEXMSG")
- S LEXI=$G(LEXOUT("DILIST","ID",1,.02)) I '$L(LEXI) D
- . S LEXSCR="" D FIND^DIC(9.4901,LEXDA,".01;.02I",,LEXPN,10,"B",LEXSCR,,"LEXOUT","LEXMSG")
- . S LEXI=$G(LEXOUT("DILIST","ID",1,.02))
- Q:'$L(LEXI) "" Q:$P(LEXI,".",1)'?7N "" S LEXE=$TR($$FMTE^XLFDT(LEXI,"5DZ"),"@"," ")
- Q:'$L(LEXE) "" S X=LEXI_"^"_LEXE
- Q X
- 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 LEXCK,LEXND,LEXV S LEXCK=+($G(^LEXM(0,"CHECKSUM")))
- S LEXND=+($G(^LEXM(0,"NODES"))),LEXV=+($$VC(LEXCK,LEXND))
- D M(" ") D:LEXV>0 M(" Checksum is ok"),M(" ")
- D:LEXV=0 CM D:LEXV=-1 CW D:LEXV=-2 CU D:LEXV=-3 CF
- Q
- VC(X,Y) ; Verify Checksum for import global
- N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR Q:'$D(^LEXM) 0
- D IMP I $G(^LEXM(0,"BUILD"))'=$G(LEXBUILD) Q -1
- N LEXCK,LEXND,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
- S LEXCK=+($G(X)),LEXND=+($G(Y))
- Q:LEXCK'>0!(LEXND'>0) -2
- S LEXL=64,(LEXCNT,LEXLC)=0,LEXS=(+(LEXND\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'=LEXND -3
- Q:LEXGCS'=LEXCK -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 LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP D ET(""),ET("Missing import global ^LEXM.") D CO
- Q
- CW ; Wrong ^LEXM
- N LEXB,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR 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 LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP D ET(""),ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).") D CKO
- Q
- CF ; Failed checksum
- N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP D ET("") D ET("Import global ^LEXM failed checksum.") D CKO
- Q
- CO ; Obtain new global
- N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP
- D ET(""),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
- TEST ;
- D CW,ED
- Q
- CKO ; Kill and Obtain new global
- N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR D IMP D ET("")
- D ET((" Use the entry point KALL^LEXXGI2 to safely KILL the existing "))
- D ET((" import global ^LEXM from your system. Then obtain a new copy"))
- D ET((" of ^LEXM contained in the global host file "_LEXIGHF_" before"))
- D ET((" 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
- ;
- 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 LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,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
- S X=$G(X) S:$E(X,1)'=" " X=" "_X D BMES^XPDUTL(X) Q
- M(X) ; Message
- S X=$G(X) S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(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
- IMP ; Import names
- S LEXPTYPE="Code Set Remedy Ticket Fixes"
- S LEXPTYPE="Code Set Update"
- ; Revision
- S LEXLREV=104
- ; Required Builds Array
- ; LEX(1)=build SEQ #^released date^subject
- ; LEX(n)=build SEQ #^released date^subject
- S LEXREQP(1)="LEX*2.0*101 SEQ #93^3150930^Code Set FY16 1st Qtr"
- ; This Build Name
- S LEXBUILD="LEX*2.0*104"
- ; This Build's Export Global Host Filename
- S LEXIGHF="LEX_2_104.GBL"
- ; Fiscal Year
- S LEXFY="FY16"
- ; Quarter
- S LEXQTR="2nd"
- Q
- EF ; Exported Files
- ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
- ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
- ;;
- ;;^ICPT(0);^ICPT(;CPT/HCPCS;81
- ;;^DIC(81.1,0);^DIC(81.1);CPT Category;81.1
- ;;^DIC(81.2,0);^DIC(81.2);CPT Copyright;81.2
- ;;^DIC(81.3,0);^DIC(81.3);CPT Modifier;81.3
- ;;
- ;;^ICD9(0);^ICD9(;ICD Diagnosis;80
- ;;^ICD0(0);^ICD0(;ICD Operation/Procedure;80.1
- ;;^ICD(0);^ICD(;DRG Grouper;80.2
- ;;^ICM(0);^ICM(;MAJOR DIAGNOSTIC CATEGORY;80.3
- Q
- GD ; Global Data
- ;;^ICPT(0);^ICPT(;CPT/HCPC;81
- ;;^DIC(81.1,0);^DIC(81.1);CPT Category;81.1
- ;;^DIC(81.3,0);^DIC(81.3);CPT Modifier;81.3
- ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2104 14635 printed Jan 18, 2025@03:06:16 Page 2
- LEX2104 ;ISL/KER - LEX*2.0*104 Env Check ;11/24/2015
- +1 ;;2.0;LEXICON UTILITY;**104**;Sep 23, 1996;Build 1
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEXM N/A
- +5 ;
- +6 ; External References
- +7 ; FIND^DIC ICR 2051
- +8 ; $$IENS^DILF ICR 2054
- +9 ; EN^DIQ1 ICR 10015
- +10 ; $$FMTE^XLFDT ICR 10103
- +11 ; $$PATCH^XPDUTL ICR 10141
- +12 ; $$PKG^XPDUTL ICR 10141
- +13 ; $$VER^XPDUTL ICR 10141
- +14 ; $$VERSION^XPDUTL ICR 10141
- +15 ; BMES^XPDUTL ICR 10141
- +16 ; MES^XPDUTL ICR 10141
- +17 ;
- +18 ; Local Variables NEWed or KILLed by Kernel Installation
- +19 ; and Distribution System (KIDS):
- +20 ;
- +21 ; XPDABORT,XPDDIQ,XPDQUIT
- +22 ;
- +23 ; see Kernel Developer Guide, Chapter 14,
- +24 ; KIDS Developer Tools, Advanced Build Techniques
- +25 ;
- +26 ; The following sections must be updated with each quarterly
- +27 ; patch
- +28 ;
- +29 ; IMP^LEX20nn Import names
- +30 ;
- +31 ; This section sets the following variables:
- +32 ;
- +33 ; LEXBUILD Build Name LEX*2.0*nn
- +34 ; LEXPTYPE Patch Type Remedy or Quarterly
- +35 ; LEXIGHF Name of Host File LEX_2_nn.GBL
- +36 ; LEXLREV Revision Number nn
- +37 ; LEXFY Fiscal Year FYnn
- +38 ; LEXQTR Quarter 1st, 2nd, 3rd, or 4th
- +39 ; LEXREQP(n) Required Patch Array
- +40 ;
- +41 ; GD^LEX20nn Global Data
- +42 ;
- +43 ; This is a listing of globals that this patch writes
- +44 ; to, it contains a closed global root, a global ID,
- +45 ; a global name and file numbers.
- +46 ;
- +47 ; IPL^LEX20nnP Informational Patch List
- +48 ;
- +49 ; This is a listing of informational patches that
- +50 ; accompany this patch. It consist of a patch nane
- +51 ; and a sequence number when available. It is used
- +52 ; to update the package file at the site with the
- +53 ; informational patches.
- +54 ;
- ENV ; Environment Check
- +1 ;
- +2 ; General
- +3 ;
- +4 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXG,LEXB,LEXE,LEXR,LEXSTR,LEXOK
- DO IMP
- +5 KILL XPDDIQ("XPZ1","B"),XPDDIQ("XPI1","B")
- SET XPDDIQ("XPZ1","B")="NO"
- SET XPDDIQ("XPI1","B")="NO"
- +6 SET LEXSTR=$GET(LEXPTYPE)
- if $LENGTH($GET(LEXFY))&($LENGTH($GET(LEXQTR)))
- SET LEXSTR=LEXSTR_" for "_$GET(LEXFY)_" "_$GET(LEXQTR)_" Quarter"
- +7 DO BM(LEXSTR)
- DO M("")
- +8 SET U="^"
- +9 ; No user
- +10 if +($$UR)'>0
- DO ET("User not defined (DUZ)")
- +11 ; No IO
- +12 if +($$SY)'>0
- DO ET("Undefined IO variable(s)")
- +13 IF $DATA(LEXE)
- DO ABRT
- QUIT
- +14 ;
- +15 ; Load Distribution
- +16 ;
- +17 ; XPDENV = 0 Environment Check during Load
- +18 ;
- +19 ; Check Version (2.0)
- +20 IF $$VERSION^XPDUTL("LEX")'="2.0"
- Begin DoDot:1
- +21 DO ET("Version 2.0 not found. Please install Lexicon Utility v 2.0")
- End DoDot:1
- DO ABRT
- QUIT
- +22 NEW LEXOK,LEXG,LEXR,LEXB
- +23 ; Check Required Patches
- +24 if $ORDER(LEXREQP(0))'>0
- DO IMP
- IF $ORDER(LEXREQP(0))>0
- Begin DoDot:1
- +25 WRITE !
- NEW LEXPAT,LEXI,LEXPN,LEXP,LEXR,LEXC,LEXO,LEXC1,LEXC2,LEXC3,LEXC4,LEX
- +26 SET (LEXR,LEXC)=0
- SET LEXC1=3
- SET LEXC2=24
- SET LEXC3=37
- SET LEXC4=50
- +27 SET LEXI=0
- FOR
- SET LEXI=$ORDER(LEXREQP(LEXI))
- if +LEXI'>0
- QUIT
- Begin DoDot:2
- +28 SET LEXC=LEXC+1
- SET LEXPAT=$GET(LEXREQP(LEXI))
- End DoDot:2
- +29 SET LEXI=0
- FOR
- SET LEXI=$ORDER(LEXREQP(LEXI))
- if +LEXI'>0
- QUIT
- Begin DoDot:2
- +30 NEW LEXPAT,LEXREL,LEXINS,LEXCOM,LEXINE,LEXREQ,LEXTX
- SET LEXREQ=$GET(LEXREQP(LEXI))
- +31 SET LEXPAT=$PIECE(LEXREQ,"^",1)
- SET LEXREL=$PIECE(LEXREQ,"^",2)
- SET LEXCOM=$PIECE(LEXREQ,"^",3)
- +32 SET LEXPN=$$INS(LEXPAT)
- SET LEXINS=$$INSD(LEXPAT)
- SET LEXINE=$PIECE(LEXINS,"^",2)
- +33 IF LEXI=1
- Begin DoDot:3
- +34 WRITE !,?LEXC1,"Checking for ",!
- +35 WRITE !,?LEXC1,"Patch",?LEXC2,"Released",?LEXC3,"Installed",?LEXC4,"Content"
- End DoDot:3
- +36 SET LEXTX=$JUSTIFY(" ",LEXC1)_LEXPAT
- +37 SET LEXTX=LEXTX_$JUSTIFY(" ",(LEXC2-$LENGTH(LEXTX)))
- +38 if LEXREL?7N
- SET LEXTX=LEXTX_$PIECE($$FMTE^XLFDT(LEXREL,"5DZ"),"@",1)
- +39 SET LEXTX=LEXTX_$JUSTIFY(" ",(LEXC3-$LENGTH(LEXTX)))
- +40 IF +LEXPN>0
- Begin DoDot:3
- +41 SET LEXO=+($GET(LEXO))+1
- if $LENGTH($GET(LEXINE))
- SET LEXTX=LEXTX_LEXINE
- +42 SET LEXTX=LEXTX_$JUSTIFY(" ",(LEXC4-$LENGTH(LEXTX)))
- +43 if $LENGTH(LEXCOM)
- SET LEXTX=LEXTX_LEXCOM
- End DoDot:3
- +44 DO M(LEXTX)
- +45 IF +LEXPN'>0
- Begin DoDot:3
- +46 NEW LEXP
- SET LEXP=$GET(LEXPAT)
- if LEXP[" SEQ"&($LENGTH($PIECE(LEXP," SEQ",1)))
- SET LEXP=$PIECE(LEXP," SEQ",1)
- +47 DO ET((LEXP_" not found, please install "_LEXP_" before continuing"))
- End DoDot:3
- End DoDot:2
- +48 if +($GET(LEXO))'=LEXC
- WRITE !
- End DoDot:1
- +49 IF $DATA(LEXE)
- DO M()
- DO ABRT
- QUIT
- +50 SET LEXG=$$RGBL
- +51 IF $DATA(LEXE)&(+LEXG=0)
- DO ABRT
- QUIT
- +52 IF $DATA(LEXE)&(+LEXG<0)
- DO ABRT
- QUIT
- +53 IF '$DATA(LEXFULL)&(+($GET(XPDENV))'=1)
- DO QUIT
- QUIT
- +54 ;
- +55 ; Install Package(s)
- +56 ;
- +57 ; XPDENV = 1 Environment Check during Install
- +58 ;
- +59 ; Check Data "is installed" or "is translated"
- +60 NEW LEXIT
- SET LEXIT=+($$CPD)
- IF '$DATA(LEXFULL)&(LEXIT)
- DO QUIT
- QUIT
- +61 ; Checking Global "Write" Protection
- +62 if +($GET(XPDENV))=1
- DO GBLS
- IF $DATA(LEXE)
- DO ABRT
- QUIT
- +63 ; Check Import Global Checksum
- +64 if +($GET(XPDENV))=1
- DO CS
- IF $DATA(LEXE)
- DO ABRT
- QUIT
- +65 ;
- +66 ; Quit, Exit or Abort
- +67 ;
- QUIT ; Quit Passed Environment Check
- +1 KILL LEXFULL
- DO 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 XPDABORT=1
- SET XPDQUIT=1
- if $LENGTH($GET(LEXBUILD))
- SET XPDQUIT(LEXBUILD)=1
- +2 KILL LEXE,LEXFULL
- +3 QUIT
- T1 ; Environment Check #1 (for testing only)
- +1 KILL XPDENV
- DO ENV
- +2 QUIT
- T2 ; Environment Check #2 (for testing only)
- +1 NEW XPDENV
- SET XPDENV=1
- DO ENV
- +2 QUIT
- +3 ;
- +4 ; Checks
- +5 ;
- GBLS ; Check Write access on globals
- +1 NEW LEXB1,LEXB2,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=""
- SET LEXE="S LEXX=$T(GD+"_LEXI_")"
- XECUTE LEXE
- SET LEXX=$$TRIM(LEXX)
- if '$LENGTH(LEXX)
- QUIT
- if '$LENGTH($TRANSLATE(LEXX,";",""))
- QUIT
- +10 SET LEXGBL=$PIECE(LEXX,";",3)
- if +LEXCPD>0&(LEXGBL="^LEXM(0)")
- QUIT
- SET LEXRT=$PIECE(LEXX,";",4)
- SET LEXT=$PIECE(LEXX,";",5)
- SET LEXF=$PIECE(LEXX,";",6)
- +11 SET (LEXB1,LEXB2)=""
- SET $PIECE(LEXB1," ",(19-$LENGTH(LEXRT)))=""
- SET $PIECE(LEXB2," ",(28-$LENGTH(LEXT)))=""
- +12 IF '$DATA(@LEXGBL)
- DO RGNF
- SET LEXOK=0
- DO M((" <"_LEXRT_" not found>"))
- QUIT
- +13 DO M((" "_LEXRT_LEXB1_LEXT_LEXB2_LEXF))
- SET @LEXGBL=$GET(@LEXGBL)
- End DoDot:1
- if '$LENGTH(LEXX)
- QUIT
- +14 if LEXOK
- DO M(" --> ok")
- if 'LEXOK
- DO M(" ??")
- DO M(" ")
- +15 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
- FOR LEXI=1:1
- Begin DoDot:1
- +3 SET LEXX=""
- SET LEXEC="S LEXX=$T(GD+"_LEXI_")"
- XECUTE LEXEC
- SET LEXX=$$TRIM(LEXX)
- if '$LENGTH(LEXX)
- QUIT
- if '$LENGTH($TRANSLATE(LEXX,";",""))
- QUIT
- +4 SET LEXGBL=$PIECE(LEXX,";",3)
- if +LEXCPD>0&(LEXGBL="^LEXM(0)")
- QUIT
- SET LEXRT=$PIECE(LEXX,";",4)
- SET LEXT=$PIECE(LEXX,";",5)
- SET LEXF=$PIECE(LEXX,";",6)
- +5 SET (LEXB1,LEXB2)=""
- SET $PIECE(LEXB1," ",(15-$LENGTH(LEXRT)))=""
- SET $PIECE(LEXB2," ",(28-$LENGTH(LEXT)))=""
- +6 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
- +7 IF $LENGTH(LEXS)
- IF X'>0
- Begin DoDot:1
- +8 if LEXS[", "
- SET LEXS=$PIECE(LEXS,", ",1,($LENGTH(LEXS,", ")-1))_" and "_$PIECE(LEXS,", ",$LENGTH(LEXS,", "))
- +9 if $EXTRACT(LEXS,1,2)=", "
- SET LEXS=$EXTRACT(LEXS,3,$LENGTH(LEXS))
- if $EXTRACT(LEXS,1,7)[" and "
- SET LEXS=$PIECE(LEXS," and ",2)
- +10 if X=-1
- DO ET(("Global"_$SELECT(LEXS[", "!(LEXS[" and "):"s",1:"")_" "_LEXS_" either not found or incomplete."))
- +11 if X=0
- DO CM
- End DoDot:1
- +12 QUIT X
- RGNF ; Required global not found
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- +2 if $GET(LEXGBL)["^LEX"&($GET(LEXGBL)'["^LEXM")
- DO ET("")
- DO ET("Required global "_$PIECE($GET(LEXGBL),"(",1)_" not found.")
- +3 if $GET(LEXGBL)["^LEX"&($GET(LEXGBL)["^LEXM")
- DO CM
- +4 QUIT
- INS(X) ; Installed
- +1 NEW LEX,LEXP,LEXV,LEXI,LEXS
- SET LEX=$PIECE($GET(X)," ",1)
- IF $LENGTH(LEX,"*")=3
- SET X=$$PATCH^XPDUTL(LEX)
- QUIT X
- +2 SET LEXP=$$PKG^XPDUTL(LEX)
- SET LEXV=$$VER^XPDUTL(LEX)
- SET LEXI=$$VERSION^XPDUTL(LEXP)
- +3 if +LEXV>0&(LEXV=LEXI)
- QUIT 1
- +4 QUIT 0
- INSD(X) ; Installed on
- +1 NEW DA,LEX,LEXDA,LEXE,LEXI,LEXMSG,LEXNS,LEXOUT,LEXPI,LEXPN,LEXSCR,LEXVI,LEXVD,LEXVI,LEXVR
- SET LEX=$GET(X)
- +2 SET LEXNS=$$PKG^XPDUTL(LEX)
- SET LEXVR=$$VER^XPDUTL(LEX)
- SET LEXPN=$PIECE(X,"*",3)
- +3 if '$LENGTH(LEXNS)
- QUIT ""
- SET LEXVR=+LEXVR
- if LEXVR'>0
- QUIT ""
- SET LEXPN=+LEXPN
- if LEXVR'["."
- SET LEXVR=LEXVR_".0"
- +4 SET LEXSCR="I $G(^DIC(9.4,+($G(Y)),""VERSION""))="""_LEXVR_""""
- +5 DO FIND^DIC(9.4,,.01,"O",LEXNS,10,"C",LEXSCR,,"LEXOUT","LEXMSG")
- +6 SET LEXPI=$GET(LEXOUT("DILIST",2,1))
- KILL LEXOUT,LEXMSG
- if +LEXPI'>0
- QUIT ""
- if '$DATA(@("^DIC(9.4,"_LEXPI_",22)"))
- QUIT ""
- +7 KILL DA
- SET DA(1)=LEXPI
- SET LEXDA=$$IENS^DILF(.DA)
- +8 DO FIND^DIC(9.49,LEXDA,".01;1I;2I","O",LEXVR,10,"B",,,"LEXOUT","LEXMSG")
- +9 SET LEXVD=$GET(LEXOUT("DILIST","ID",1,2))
- IF $EXTRACT(LEXVD,1,7)?7N&(+LEXPN'>0)
- Begin DoDot:1
- +10 SET X=$EXTRACT(LEXVD,1,7)_"^"_$TRANSLATE($$FMTE^XLFDT($EXTRACT(LEXVD,1,7),"5DZ"),"@"," ")
- End DoDot:1
- QUIT X
- +11 if $EXTRACT(LEXVD,1,7)'?7N
- SET LEXVD=$GET(LEXOUT("DILIST","ID",1,1))
- IF $EXTRACT(LEXVD,1,7)?7N&(+LEXPN'>0)
- Begin DoDot:1
- +12 SET X=$EXTRACT(LEXVD,1,7)_"^"_$TRANSLATE($$FMTE^XLFDT($EXTRACT(LEXVD,1,7),"5DZ"),"@"," ")
- End DoDot:1
- QUIT X
- +13 if +LEXPN'>0
- QUIT ""
- SET LEXVI=$GET(LEXOUT("DILIST",2,1))
- KILL LEXOUT,LEXMSG
- +14 if +LEXVI'>0
- QUIT ""
- if '$DATA(@("^DIC(9.4,"_LEXPI_",22,"_LEXVI_",""PAH"")"))
- QUIT ""
- +15 KILL DA
- SET DA(2)=LEXPI
- SET DA(1)=LEXVI
- SET LEXDA=$$IENS^DILF(.DA)
- +16 SET LEXSCR="I $G(^DIC(9.4,"_LEXPI_",22,"_LEXVI_",""PAH"",+($G(Y)),0))[""SEQ #"""
- +17 DO FIND^DIC(9.4901,LEXDA,".01;.02I",,LEXPN,10,"B",LEXSCR,,"LEXOUT","LEXMSG")
- +18 SET LEXI=$GET(LEXOUT("DILIST","ID",1,.02))
- IF '$LENGTH(LEXI)
- Begin DoDot:1
- +19 SET LEXSCR=""
- DO FIND^DIC(9.4901,LEXDA,".01;.02I",,LEXPN,10,"B",LEXSCR,,"LEXOUT","LEXMSG")
- +20 SET LEXI=$GET(LEXOUT("DILIST","ID",1,.02))
- End DoDot:1
- +21 if '$LENGTH(LEXI)
- QUIT ""
- if $PIECE(LEXI,".",1)'?7N
- QUIT ""
- SET LEXE=$TRANSLATE($$FMTE^XLFDT(LEXI,"5DZ"),"@"," ")
- +22 if '$LENGTH(LEXE)
- QUIT ""
- SET X=LEXI_"^"_LEXE
- +23 QUIT X
- 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
- DO BM(" Running checksum routine on the ^LEXM import global, please wait")
- +2 NEW LEXCK,LEXND,LEXV
- SET LEXCK=+($GET(^LEXM(0,"CHECKSUM")))
- +3 SET LEXND=+($GET(^LEXM(0,"NODES")))
- SET LEXV=+($$VC(LEXCK,LEXND))
- +4 DO M(" ")
- if LEXV>0
- DO M(" Checksum is ok")
- DO M(" ")
- +5 if LEXV=0
- DO CM
- if LEXV=-1
- DO CW
- if LEXV=-2
- DO CU
- if LEXV=-3
- DO CF
- +6 QUIT
- VC(X,Y) ; Verify Checksum for import global
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- if '$DATA(^LEXM)
- QUIT 0
- +2 DO IMP
- IF $GET(^LEXM(0,"BUILD"))'=$GET(LEXBUILD)
- QUIT -1
- +3 NEW LEXCK,LEXND,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
- +4 SET LEXCK=+($GET(X))
- SET LEXND=+($GET(Y))
- +5 if LEXCK'>0!(LEXND'>0)
- QUIT -2
- +6 SET LEXL=64
- SET (LEXCNT,LEXLC)=0
- SET LEXS=(+(LEXND\LEXL))
- +7 if LEXS=0
- SET LEXS=1
- if +($ORDER(^LEXM(0)))>0
- DO M("")
- +8 SET (LEXC,LEXN)="^LEXM"
- SET (LEXNC,LEXGCS)=0
- WRITE " "
- +9 FOR
- SET LEXN=$QUERY(@LEXN)
- if LEXN=""!(LEXN'[LEXC)
- QUIT
- Begin DoDot:1
- +10 if LEXN="^LEXM(0,""CHECKSUM"")"
- QUIT
- +11 if LEXN="^LEXM(0,""NODES"")"
- QUIT
- +12 SET LEXCNT=LEXCNT+1
- +13 IF LEXCNT'<LEXS
- SET LEXLC=LEXLC+1
- if LEXLC'>LEXL
- WRITE "."
- SET LEXCNT=0
- +14 SET LEXNC=LEXNC+1
- SET LEXD=@LEXN
- SET LEXT=LEXN_"="_LEXD
- +15 FOR LEXP=1:1:$LENGTH(LEXT)
- SET LEXGCS=$ASCII(LEXT,LEXP)*LEXP+LEXGCS
- End DoDot:1
- +16 if LEXNC'=LEXND
- QUIT -3
- +17 if LEXGCS'=LEXCK
- QUIT -3
- +18 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 LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- DO ET("")
- DO ET("Missing import global ^LEXM.")
- DO CO
- +2 QUIT
- CW ; Wrong ^LEXM
- +1 NEW LEXB,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- SET LEXB=$GET(^LEXM(0,"BUILD"))
- DO ET("")
- +2 IF $LENGTH(LEXBUILD)
- IF $LENGTH(LEXB)
- IF LEXBUILD'=LEXB
- Begin DoDot:1
- +3 DO ET(("Incorrect import global ^LEXM found ("_LEXB_" global)."))
- DO CKO
- End DoDot:1
- QUIT
- +4 DO ET("Incorrect import global ^LEXM found.")
- DO CKO
- +5 QUIT
- CU ; Unable to verify
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- DO ET("")
- DO ET("Unable to verify checksum for import global ^LEXM (possibly corrupt).")
- DO CKO
- +2 QUIT
- CF ; Failed checksum
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- DO ET("")
- DO ET("Import global ^LEXM failed checksum.")
- DO CKO
- +2 QUIT
- CO ; Obtain new global
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- +2 DO ET("")
- 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
- TEST ;
- +1 DO CW
- DO ED
- +2 QUIT
- CKO ; Kill and Obtain new global
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
- DO IMP
- DO ET("")
- +2 DO ET((" Use the entry point KALL^LEXXGI2 to safely KILL the existing "))
- +3 DO ET((" import global ^LEXM from your system. Then obtain a new copy"))
- +4 DO ET((" of ^LEXM contained in the global host file "_LEXIGHF_" before"))
- +5 DO ET((" continuing with the "_LEXBUILD_" installation."))
- +6 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
- DO M(LEXE(LEXI))
- +2 DO M(" ")
- KILL LEXE
- QUIT
- +3 ;
- +4 ; Miscellaneous
- +5 ;
- NOTDEF(IEN) ; Check to see if user is defined
- +1 NEW DA,DR,DIQ,LEX,DIC
- SET DA=IEN
- SET DR=.01
- SET DIC=200
- SET DIQ="LEX"
- DO EN^DIQ1
- QUIT '$DATA(LEX)
- OK ; Environment is OK
- +1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,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 SET X=$GET(X)
- if $EXTRACT(X,1)'=" "
- SET X=" "_X
- DO BMES^XPDUTL(X)
- QUIT
- M(X) ; Message
- +1 SET X=$GET(X)
- if $EXTRACT(X,1)'=" "
- SET X=" "_X
- DO MES^XPDUTL(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
- IMP ; Import names
- +1 SET LEXPTYPE="Code Set Remedy Ticket Fixes"
- +2 SET LEXPTYPE="Code Set Update"
- +3 ; Revision
- +4 SET LEXLREV=104
- +5 ; Required Builds Array
- +6 ; LEX(1)=build SEQ #^released date^subject
- +7 ; LEX(n)=build SEQ #^released date^subject
- +8 SET LEXREQP(1)="LEX*2.0*101 SEQ #93^3150930^Code Set FY16 1st Qtr"
- +9 ; This Build Name
- +10 SET LEXBUILD="LEX*2.0*104"
- +11 ; This Build's Export Global Host Filename
- +12 SET LEXIGHF="LEX_2_104.GBL"
- +13 ; Fiscal Year
- +14 SET LEXFY="FY16"
- +15 ; Quarter
- +16 SET LEXQTR="2nd"
- +17 QUIT
- EF ; Exported Files
- +1 ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41
- +2 ;;^LEXT(757.2);^LEXT(757.2);Lexicon Subsets/Defaults;757.2
- +3 ;;
- +4 ;;^ICPT(0);^ICPT(;CPT/HCPCS;81
- +5 ;;^DIC(81.1,0);^DIC(81.1);CPT Category;81.1
- +6 ;;^DIC(81.2,0);^DIC(81.2);CPT Copyright;81.2
- +7 ;;^DIC(81.3,0);^DIC(81.3);CPT Modifier;81.3
- +8 ;;
- +9 ;;^ICD9(0);^ICD9(;ICD Diagnosis;80
- +10 ;;^ICD0(0);^ICD0(;ICD Operation/Procedure;80.1
- +11 ;;^ICD(0);^ICD(;DRG Grouper;80.2
- +12 ;;^ICM(0);^ICM(;MAJOR DIAGNOSTIC CATEGORY;80.3
- +13 QUIT
- GD ; Global Data
- +1 ;;^ICPT(0);^ICPT(;CPT/HCPC;81
- +2 ;;^DIC(81.1,0);^DIC(81.1);CPT Category;81.1
- +3 ;;^DIC(81.3,0);^DIC(81.3);CPT Modifier;81.3
- +4 ;;^LEX(757.01);^LEX(*;Lexicon;757-757.41