- LEXXGI ;ISL/KER - Global Import (^LEXM) ;05/23/2017
- ;;2.0;LEXICON UTILITY;**4,25,26,27,28,29,46,49,50,41,59,73,80,103**;Sep 23, 1996;Build 2
- ;
- ;
- ;
- ; Global Variables
- ; ^LEXM
- ;
- ; External References
- ; HOME^%ZIS ICR 10086
- ; ^%ZTLOAD ICR 10063
- ; $$GET1^DIQ ICR 2056
- ; $$FMTE^XLFDT ICR 10103
- ; $$NOW^XLFDT ICR 10103
- ; BMES^XPDUTL ICR 10141
- ; MES^XPDUTL ICR 10141
- ;
- ; NEWed or KILLed by Lexicon Environment Check routine LEX20nn
- ; LEXBUILD Build
- ; LEXFY Fiscal Year
- ; LEXIGHF Global Host File
- ; LEXLREV Revision
- ; LEXPTYPE Patch Type
- ; LEXQTR Quarter
- ; LEXREQP Required Patches/Builds
- ;
- ; NEWed or KILLed by KIDS during the Install of a patch/build
- ; XPDNM Intall Flag
- ;
- EN ; Main Entry Point for Installing LEXM in Post-Installs
- ;
- ; Requires
- ;
- ; LEXBUILD - the name of the patch/build being installed
- ;
- ; Uses
- ;
- ; LEXMSG - If this variable exist, then an install message
- ; message will be set to G.LEXICON
- ;
- ; LEXSHORT - If this variable exist, the install message
- ; will be an abbreviated message, without the
- ; file totals and checksums
- ;
- ; Abbreviated Install Message
- ;
- ; Date and Time Installed
- ; Account where the Data was Installed
- ; Who Installed the Data
- ; The Name of the Build Installed
- ; The Name of the Global Host File
- ; Protocol Invoked
- ; Date and time Protocol was Invoked
- ; Install Start Date/Time
- ; Install Complete Date/Time
- ; Install Elapsed Time
- ;
- ; Long Install Message
- ;
- ; All of the elements above plus:
- ;
- ; File Versions/Revisions
- ; File Checksums
- ; File Record Counts
- ;
- ; LEXNOPRO - If this variable exist, the protocol LEXICAL
- ; SERVICES UPDATE will not be invoked.
- ;
- ; LEXPTYPE - Patch Type
- ; LEXLREV - Revision
- ; LEXREQP - Required Patches/Builds
- ; LEXIGHF - The patch Export Global Host Filename
- ; LEXFY - Fiscal Year
- ; LEXQTR - Quarter
- ; LEXCRE - Import Global Creation Date
- ;
- D IMPORT D KALL^LEXXGI2
- Q
- TASK ; Queue Lexicon Update with Taskman
- N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ S:$D(LEXBUILD) ZTSAVE("LEXBUILD")="" S:$D(LEXMSG) ZTSAVE("LEXMSG")=""
- S:$D(LEXSHORT) ZTSAVE("LEXSHORT")="" S:$D(LEXPTYPE) ZTSAVE("LEXPTYPE")="" S:$D(LEXLREV) ZTSAVE("LEXLREV")="" S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
- S:$D(LEXIGHF) ZTSAVE("LEXIGHF")="" S:$D(LEXFY) ZTSAVE("LEXFY")="" S:$D(LEXQTR) ZTSAVE("LEXQTR")="" S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
- S ZTRTN="EN^LEXXGI",ZTDESC="Importing Updated Lexicon Data" S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
- Q
- LEXM ; Force Install of LEXM w/o a Post-Install
- N LEXBUILD,LEXBLD,LEXB,LEXBO,LEXCHK,LEXSHORT,LEXTYPE,LEXMSG,LEXPOST,LEXNDS,LEXNOPRO,LEXVER
- S LEXNOPRO="",LEXBO=$G(^LEXM(0,"BUILD")),(LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))="LEX*2.0*NN"
- S:$L($G(LEXBO)) (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))=LEXBO
- S LEXSHORT="",LEXTYPE=LEXB S:$L(LEXB) LEXTYPE=LEXTYPE_" (Forced)" S LEXMSG="",LEXPOST=""
- S LEXCHK=+($G(^LEXM(0,"CHECKSUM"))) W !," Running checksum routine on the ^LEXM import global, please wait"
- S LEXNDS=+($G(^LEXM(0,"NODES"))),LEXVER=+($$VC^LEXXGI2(LEXCHK,LEXNDS)) W !
- W:LEXVER>0 !," Checksum is ok",!
- I LEXVER=0 W !!," Import global ^LEXM is missing. Please obtain a copy of ^LEXM before",!," continuing." Q
- I LEXVER<0 D Q
- . I LEXVER'=-3 W !," Unable to verify checksum for import global ^LEXM (possibly corrupt)"
- . I LEXVER=-3 W !," Import global ^LEXM failed checksum"
- . W !!," Please KILL the existing import global ^LEXM from your system and"
- . W !," obtain a new copy of ^LEXM before continuing with the installation."
- D EN
- Q
- IMPORT ; Import Data during a Patch Installation
- S:$D(ZTQUEUED) ZTREQ="@" S:$L($G(LEXPTYPE)) LEXPTYPE=$G(LEXPTYPE) S:$L($G(LEXLREV)) LEXLREV=$G(LEXLREV) S:$L($G(LEXREQP)) LEXREQP=$G(LEXREQP)
- S:$L($G(LEXBUILD)) LEXBUILD=$G(LEXBUILD) S:$L($G(LEXIGHF)) LEXIGHF=$G(LEXIGHF) S:$L($G(LEXFY)) LEXFY=$G(LEXFY)
- S:$L($G(LEXQTR)) LEXQTR=$G(LEXQTR) K LEXSCHG,LEXCHG
- N LEXB,LEXCD,LEXSTR,LEXLAST,LEXRES,LEXSTART,DG,DIC,DICR,DILOCKTM,DIW,XMDUN,XMZ,ZTSK
- S U="^",LEXSTR=$G(LEXPTYPE),LEXB=$G(^LEXM(0,"BUILD")),LEXSTART=$$NOW^XLFDT
- S:$L($G(LEXFY))&($L($G(LEXQTR)))&($L(LEXSTR)) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
- S:$L(LEXB) LEXBLD=LEXB S:'$L(LEXBLD)&($L(LEXBUILD)) LEXBLD=LEXBUILD
- I '$L(LEXB)!(LEXB'=LEXBUILD) D
- . N X,LEXBLD I '$L(LEXB) D Q
- . . S X=" Invalid export global, aborting data install" W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
- . I '$L(LEXBUILD) D Q
- . . S X=" Undefined KIDS Build, aborting data install" W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
- I $L(LEXB)&(LEXB=LEXBUILD) D
- . N LEXFI,LEXID,LEXPROC S X="Installing Data for patch "_LEXB W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
- . K LEXSCHG S LEXCHG=0,LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
- . . S LEXID=$S($P(LEXFI,".",1)=80:"ICD",$P(LEXFI,".",1)=81:"CPT",$P(LEXFI,".",1)=757:"LEX",1:"") S:$L(LEXID) LEXSCHG(LEXID)=0,LEXSCHG("LEX")=0
- . S:$D(LEXSCHG("CPT"))!($D(LEXSCHG("ICD"))) LEXSCHG("PRO")="",LEXCHG=1,LEXSCHG(0)=1
- . D LOAD K LEXPROC D UTOT^LEXXGI3 I '$D(LEXNOPRO) D NOTIFY^LEXXGI2
- . I +($G(DUZ))>0,$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) D
- . . D HOME^%ZIS N DIFROM,LEXPRO,LEXPRON,LEXLAST S LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO"))
- . . D:$D(LEXMSG) POST^LEXXFI
- Q
- LOAD ; Load Data from ^LEXM into IC*/LEX Files
- Q:'$L($G(LEXB)) S:$D(ZTQUEUED) ZTREQ="@"
- N LEXBEG,LEXELP,LEXEND,LEXMSG,LEXOK,LEXFL,LEXTXT
- D:'$D(^LEXM) NF^LEXXGI2 Q:'$D(^LEXM)
- S LEXOK=0 S:$O(^LEXM(0))>0 LEXOK=1 D:'LEXOK IG^LEXXGI2 Q:'LEXOK
- S LEXBEG=$$HACK^LEXXGI2 D FILES^LEXXGI3 S LEXEND=$$HACK^LEXXGI2,LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
- S:LEXELP="" LEXELP="00:00:00"
- S LEXRES=$$RESULTS^LEXXII2
- S LEXTXT=" Data Update" S:$L(LEXRES) LEXTXT=LEXTXT_": "_$G(LEXRES)
- D PB^LEXXGI2(LEXTXT)
- D PB^LEXXGI2((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
- D TL^LEXXGI2((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
- D TL^LEXXGI2((" Elapsed: "_LEXELP))
- Q
- ;
- NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
- I '$D(LEXNOPRO) D NOTIFY^LEXXGI2,KALL^LEXXGI2
- Q
- MSG(X,Y,Z) ; Install Message
- ;
- ; Input
- ;
- ; X Build Name, i.e., LEX*2.0*103
- ; Y Files - "^" Delimited String of Files Modified
- ; Z Effective Date - FileMan
- ;
- ; Output
- ;
- ; MailMan Install Message
- ;
- ; Subj: LEX*2.0*nnn Installation [#nnnnnn] mm/dd/yy@hh:mm n lines
- ; From: POSTMASTER In 'IN' basket. Page 1 *New*
- ;
- ; Lexicon Installation
- ; ====================
- ;
- ; As of: Mmm dd, yyyy hh:mm:ss
- ; In Account: [acopunt]
- ; Maint By: User, Name (nnn) nnn-nnnn
- ; Build: LEX*2.0*nnn
- ;
- N LEXBUILD,LEXFI,LEXFIS,LEXFY,LEXIGHF,LEXLREV,LEXMSG,LEXND,LEXNOTIM,LEXNOPRO,LEXP,LEXPKG,LEXPTYPE,LEXQTR,LEXQUIET,LEXSHORT,LEXSUBH,LEXTD,LEXVER
- S LEXBUILD=$G(X),LEXFIS=$G(Y),LEXTD=$P($G(Z),".",1) Q:'$L(LEXBUILD) S LEXLREV="" S:$P(LEXBUILD,"*",3)?1N.N LEXLREV=$P(LEXBUILD,"*",3)
- S LEXSUBH="Lexicon Installation",(LEXMSG,LEXSHORT,LEXIGHF,LEXFY,LEXQTR)="",LEXPTYPE="Lexicon Patch Install",LEXQUIET=1,LEXNOTIM=1
- S LEXPKG=$P(LEXBUILD,"*",1),LEXVER=$P(LEXBUILD,"*",2) D POST^LEXXFI Q:'$L($G(LEXFIS)) Q:$G(LEXTD)'?7N
- F LEXP=1:1 S LEXFI=$P(LEXFIS,"^",LEXP) Q:'$L(LEXFI) D
- . N LEXND S LEXND="^DD("_+LEXFI_",0)" Q:'$D(@LEXND)
- . S LEXND="^DD("_+LEXFI_",0,""VRRV"")" S:$L($G(LEXLREV)) $P(@LEXND,"^",1)=$G(LEXLREV),$P(@LEXND,"^",2)=LEXTD
- . S LEXND="^DD("_+LEXFI_",0,""VRPK"")" S:$L($G(LEXPKG)) @LEXND=$G(LEXPKG)
- . S LEXND="^DD("_+LEXFI_",0,""VR"")" S:$L($G(LEXVER))&($P($G(LEXVER),".",1)?1N.N) @LEXND=$G(LEXVER)
- Q
- AWRD ; Recalculate ASL Cross-Reference in 757.01
- D:$L($T(AWRD^LEXXGI4)) AWRD^LEXXGI4
- Q
- ASL ; Recalculate ASL Cross-Reference in 757.01
- D:$L($T(ASL^LEXXGI4)) ASL^LEXXGI4
- Q
- SUB ; Re-Index Subset file 757.21 (set logic only)
- D:$L($T(SUB^LEXXGI4)) SUB^LEXXGI4
- Q
- SCHG ; Save Change File Changes (for NOTIFY)
- N LEXFI,LEXID K LEXSCHG S LEXCHG=0
- N LEXFI S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
- . S LEXID=$S(LEXFI=80!(LEXFI=80.1):"ICD",LEXFI=81!(LEXFI=81.1)!(LEXFI=81.2)!(LEXFI=81.3):"CPT",$P(LEXFI,".",1)=757:"LEX",1:"UNK")
- . S LEXSCHG(LEXFI,0)=+($G(^LEXM(LEXFI,0))),LEXSCHG("B",LEXFI)="" S LEXSCHG("C",LEXID,LEXFI)=""
- S:$D(LEXSCHG("C","CPT"))!($D(LEXSCHG("C","ICD"))) LEXSCHG("D","PRO")=""
- S:$D(^LEXM(80))!($D(^LEXM(80.1)))!($D(^LEXM(81)))!($D(^LEXM(81.2)))!($D(^LEXM(81.3)))!($D(LEXSCHG("D","PRO"))) LEXCHG=1,LEXSCHG(0)=1
- Q
- INV(X,Y) ; Protocol Invoked
- N XPDNM,LEXN,LEXP,LEXPD,LEXDT,LEXSAB S LEXSAB=$G(X) Q:"^LEX^ICD^CPT^"'[("^"_LEXSAB_"^") S LEXP=$S(X="LEX":1,X="ICD":2,X="CPT":3,1:"") Q:+LEXP'>0
- S LEXPD=LEXP+(.5),LEXDT=$G(Y) S:$P(LEXDT,",",1)'?7N LEXDT=$$NOW^XLFDT S:'$D(^LEXT(757.2,1,200,0)) ^LEXT(757.2,1,200,0)="^757.201PA^.5^1"
- S ^LEXT(757.2,1,200,.5,0)=.5,^LEXT(757.2,1,200,.5,LEXP)=LEXSAB,^LEXT(757.2,1,200,.5,LEXPD)=LEXN
- Q
- CHECKSUM ; Check ^LEXM Checksum
- D CS^LEXXGI2
- Q
- TOT ; CSV totals
- D TOT^LEXXGI3
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXGI 10003 printed Dec 13, 2024@02:10:11 Page 2
- LEXXGI ;ISL/KER - Global Import (^LEXM) ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**4,25,26,27,28,29,46,49,50,41,59,73,80,103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ;
- +4 ;
- +5 ; Global Variables
- +6 ; ^LEXM
- +7 ;
- +8 ; External References
- +9 ; HOME^%ZIS ICR 10086
- +10 ; ^%ZTLOAD ICR 10063
- +11 ; $$GET1^DIQ ICR 2056
- +12 ; $$FMTE^XLFDT ICR 10103
- +13 ; $$NOW^XLFDT ICR 10103
- +14 ; BMES^XPDUTL ICR 10141
- +15 ; MES^XPDUTL ICR 10141
- +16 ;
- +17 ; NEWed or KILLed by Lexicon Environment Check routine LEX20nn
- +18 ; LEXBUILD Build
- +19 ; LEXFY Fiscal Year
- +20 ; LEXIGHF Global Host File
- +21 ; LEXLREV Revision
- +22 ; LEXPTYPE Patch Type
- +23 ; LEXQTR Quarter
- +24 ; LEXREQP Required Patches/Builds
- +25 ;
- +26 ; NEWed or KILLed by KIDS during the Install of a patch/build
- +27 ; XPDNM Intall Flag
- +28 ;
- EN ; Main Entry Point for Installing LEXM in Post-Installs
- +1 ;
- +2 ; Requires
- +3 ;
- +4 ; LEXBUILD - the name of the patch/build being installed
- +5 ;
- +6 ; Uses
- +7 ;
- +8 ; LEXMSG - If this variable exist, then an install message
- +9 ; message will be set to G.LEXICON
- +10 ;
- +11 ; LEXSHORT - If this variable exist, the install message
- +12 ; will be an abbreviated message, without the
- +13 ; file totals and checksums
- +14 ;
- +15 ; Abbreviated Install Message
- +16 ;
- +17 ; Date and Time Installed
- +18 ; Account where the Data was Installed
- +19 ; Who Installed the Data
- +20 ; The Name of the Build Installed
- +21 ; The Name of the Global Host File
- +22 ; Protocol Invoked
- +23 ; Date and time Protocol was Invoked
- +24 ; Install Start Date/Time
- +25 ; Install Complete Date/Time
- +26 ; Install Elapsed Time
- +27 ;
- +28 ; Long Install Message
- +29 ;
- +30 ; All of the elements above plus:
- +31 ;
- +32 ; File Versions/Revisions
- +33 ; File Checksums
- +34 ; File Record Counts
- +35 ;
- +36 ; LEXNOPRO - If this variable exist, the protocol LEXICAL
- +37 ; SERVICES UPDATE will not be invoked.
- +38 ;
- +39 ; LEXPTYPE - Patch Type
- +40 ; LEXLREV - Revision
- +41 ; LEXREQP - Required Patches/Builds
- +42 ; LEXIGHF - The patch Export Global Host Filename
- +43 ; LEXFY - Fiscal Year
- +44 ; LEXQTR - Quarter
- +45 ; LEXCRE - Import Global Creation Date
- +46 ;
- +47 DO IMPORT
- DO KALL^LEXXGI2
- +48 QUIT
- TASK ; Queue Lexicon Update with Taskman
- +1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ
- if $DATA(LEXBUILD)
- SET ZTSAVE("LEXBUILD")=""
- if $DATA(LEXMSG)
- SET ZTSAVE("LEXMSG")=""
- +2 if $DATA(LEXSHORT)
- SET ZTSAVE("LEXSHORT")=""
- if $DATA(LEXPTYPE)
- SET ZTSAVE("LEXPTYPE")=""
- if $DATA(LEXLREV)
- SET ZTSAVE("LEXLREV")=""
- if $DATA(LEXREQP)
- SET ZTSAVE("LEXREQP")=""
- +3 if $DATA(LEXIGHF)
- SET ZTSAVE("LEXIGHF")=""
- if $DATA(LEXFY)
- SET ZTSAVE("LEXFY")=""
- if $DATA(LEXQTR)
- SET ZTSAVE("LEXQTR")=""
- if $DATA(LEXCRE)
- SET ZTSAVE("LEXCRE")=""
- +4 SET ZTRTN="EN^LEXXGI"
- SET ZTDESC="Importing Updated Lexicon Data"
- SET ZTIO=""
- SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- DO HOME^%ZIS
- +5 QUIT
- LEXM ; Force Install of LEXM w/o a Post-Install
- +1 NEW LEXBUILD,LEXBLD,LEXB,LEXBO,LEXCHK,LEXSHORT,LEXTYPE,LEXMSG,LEXPOST,LEXNDS,LEXNOPRO,LEXVER
- +2 SET LEXNOPRO=""
- SET LEXBO=$GET(^LEXM(0,"BUILD"))
- SET (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))="LEX*2.0*NN"
- +3 if $LENGTH($GET(LEXBO))
- SET (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))=LEXBO
- +4 SET LEXSHORT=""
- SET LEXTYPE=LEXB
- if $LENGTH(LEXB)
- SET LEXTYPE=LEXTYPE_" (Forced)"
- SET LEXMSG=""
- SET LEXPOST=""
- +5 SET LEXCHK=+($GET(^LEXM(0,"CHECKSUM")))
- WRITE !," Running checksum routine on the ^LEXM import global, please wait"
- +6 SET LEXNDS=+($GET(^LEXM(0,"NODES")))
- SET LEXVER=+($$VC^LEXXGI2(LEXCHK,LEXNDS))
- WRITE !
- +7 if LEXVER>0
- WRITE !," Checksum is ok",!
- +8 IF LEXVER=0
- WRITE !!," Import global ^LEXM is missing. Please obtain a copy of ^LEXM before",!," continuing."
- QUIT
- +9 IF LEXVER<0
- Begin DoDot:1
- +10 IF LEXVER'=-3
- WRITE !," Unable to verify checksum for import global ^LEXM (possibly corrupt)"
- +11 IF LEXVER=-3
- WRITE !," Import global ^LEXM failed checksum"
- +12 WRITE !!," Please KILL the existing import global ^LEXM from your system and"
- +13 WRITE !," obtain a new copy of ^LEXM before continuing with the installation."
- End DoDot:1
- QUIT
- +14 DO EN
- +15 QUIT
- IMPORT ; Import Data during a Patch Installation
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- if $LENGTH($GET(LEXPTYPE))
- SET LEXPTYPE=$GET(LEXPTYPE)
- if $LENGTH($GET(LEXLREV))
- SET LEXLREV=$GET(LEXLREV)
- if $LENGTH($GET(LEXREQP))
- SET LEXREQP=$GET(LEXREQP)
- +2 if $LENGTH($GET(LEXBUILD))
- SET LEXBUILD=$GET(LEXBUILD)
- if $LENGTH($GET(LEXIGHF))
- SET LEXIGHF=$GET(LEXIGHF)
- if $LENGTH($GET(LEXFY))
- SET LEXFY=$GET(LEXFY)
- +3 if $LENGTH($GET(LEXQTR))
- SET LEXQTR=$GET(LEXQTR)
- KILL LEXSCHG,LEXCHG
- +4 NEW LEXB,LEXCD,LEXSTR,LEXLAST,LEXRES,LEXSTART,DG,DIC,DICR,DILOCKTM,DIW,XMDUN,XMZ,ZTSK
- +5 SET U="^"
- SET LEXSTR=$GET(LEXPTYPE)
- SET LEXB=$GET(^LEXM(0,"BUILD"))
- SET LEXSTART=$$NOW^XLFDT
- +6 if $LENGTH($GET(LEXFY))&($LENGTH($GET(LEXQTR)))&($LENGTH(LEXSTR))
- SET LEXSTR=LEXSTR_" for "_$GET(LEXFY)_" "_$GET(LEXQTR)_" Quarter"
- +7 if $LENGTH(LEXB)
- SET LEXBLD=LEXB
- if '$LENGTH(LEXBLD)&($LENGTH(LEXBUILD))
- SET LEXBLD=LEXBUILD
- +8 IF '$LENGTH(LEXB)!(LEXB'=LEXBUILD)
- Begin DoDot:1
- +9 NEW X,LEXBLD
- IF '$LENGTH(LEXB)
- Begin DoDot:2
- +10 SET X=" Invalid export global, aborting data install"
- if '$DATA(XPDNM)
- WRITE !!,X
- if $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- if '$DATA(XPDNM)
- WRITE !
- if $DATA(XPDNM)
- DO MES^XPDUTL(" ")
- End DoDot:2
- QUIT
- +11 IF '$LENGTH(LEXBUILD)
- Begin DoDot:2
- +12 SET X=" Undefined KIDS Build, aborting data install"
- if '$DATA(XPDNM)
- WRITE !!,X
- if $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- if '$DATA(XPDNM)
- WRITE !
- if $DATA(XPDNM)
- DO MES^XPDUTL(" ")
- End DoDot:2
- QUIT
- End DoDot:1
- +13 IF $LENGTH(LEXB)&(LEXB=LEXBUILD)
- Begin DoDot:1
- +14 NEW LEXFI,LEXID,LEXPROC
- SET X="Installing Data for patch "_LEXB
- if '$DATA(XPDNM)
- WRITE !!,X
- if $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- if '$DATA(XPDNM)
- WRITE !
- if $DATA(XPDNM)
- DO MES^XPDUTL(" ")
- +15 KILL LEXSCHG
- SET LEXCHG=0
- SET LEXFI=0
- FOR
- SET LEXFI=$ORDER(^LEXM(LEXFI))
- if +LEXFI'>0
- QUIT
- Begin DoDot:2
- +16 SET LEXID=$SELECT($PIECE(LEXFI,".",1)=80:"ICD",$PIECE(LEXFI,".",1)=81:"CPT",$PIECE(LEXFI,".",1)=757:"LEX",1:"")
- if $LENGTH(LEXID)
- SET LEXSCHG(LEXID)=0
- SET LEXSCHG("LEX")=0
- End DoDot:2
- +17 if $DATA(LEXSCHG("CPT"))!($DATA(LEXSCHG("ICD")))
- SET LEXSCHG("PRO")=""
- SET LEXCHG=1
- SET LEXSCHG(0)=1
- +18 DO LOAD
- KILL LEXPROC
- DO UTOT^LEXXGI3
- IF '$DATA(LEXNOPRO)
- DO NOTIFY^LEXXGI2
- +19 IF +($GET(DUZ))>0
- IF $LENGTH($$GET1^DIQ(200,(+($GET(DUZ))_","),.01))
- Begin DoDot:2
- +20 DO HOME^%ZIS
- NEW DIFROM,LEXPRO,LEXPRON,LEXLAST
- SET LEXPRON="LEXICAL SERVICES UPDATE"
- SET LEXPRO=$GET(^LEXM(0,"PRO"))
- +21 if $DATA(LEXMSG)
- DO POST^LEXXFI
- End DoDot:2
- End DoDot:1
- +22 QUIT
- LOAD ; Load Data from ^LEXM into IC*/LEX Files
- +1 if '$LENGTH($GET(LEXB))
- QUIT
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 NEW LEXBEG,LEXELP,LEXEND,LEXMSG,LEXOK,LEXFL,LEXTXT
- +3 if '$DATA(^LEXM)
- DO NF^LEXXGI2
- if '$DATA(^LEXM)
- QUIT
- +4 SET LEXOK=0
- if $ORDER(^LEXM(0))>0
- SET LEXOK=1
- if 'LEXOK
- DO IG^LEXXGI2
- if 'LEXOK
- QUIT
- +5 SET LEXBEG=$$HACK^LEXXGI2
- DO FILES^LEXXGI3
- SET LEXEND=$$HACK^LEXXGI2
- SET LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
- +6 if LEXELP=""
- SET LEXELP="00:00:00"
- +7 SET LEXRES=$$RESULTS^LEXXII2
- +8 SET LEXTXT=" Data Update"
- if $LENGTH(LEXRES)
- SET LEXTXT=LEXTXT_": "_$GET(LEXRES)
- +9 DO PB^LEXXGI2(LEXTXT)
- +10 DO PB^LEXXGI2((" Started: "_$TRANSLATE($$FMTE^XLFDT(LEXBEG),"@"," ")))
- +11 DO TL^LEXXGI2((" Finished: "_$TRANSLATE($$FMTE^XLFDT(LEXEND),"@"," ")))
- +12 DO TL^LEXXGI2((" Elapsed: "_LEXELP))
- +13 QUIT
- +14 ;
- NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
- +1 IF '$DATA(LEXNOPRO)
- DO NOTIFY^LEXXGI2
- DO KALL^LEXXGI2
- +2 QUIT
- MSG(X,Y,Z) ; Install Message
- +1 ;
- +2 ; Input
- +3 ;
- +4 ; X Build Name, i.e., LEX*2.0*103
- +5 ; Y Files - "^" Delimited String of Files Modified
- +6 ; Z Effective Date - FileMan
- +7 ;
- +8 ; Output
- +9 ;
- +10 ; MailMan Install Message
- +11 ;
- +12 ; Subj: LEX*2.0*nnn Installation [#nnnnnn] mm/dd/yy@hh:mm n lines
- +13 ; From: POSTMASTER In 'IN' basket. Page 1 *New*
- +14 ;
- +15 ; Lexicon Installation
- +16 ; ====================
- +17 ;
- +18 ; As of: Mmm dd, yyyy hh:mm:ss
- +19 ; In Account: [acopunt]
- +20 ; Maint By: User, Name (nnn) nnn-nnnn
- +21 ; Build: LEX*2.0*nnn
- +22 ;
- +23 NEW LEXBUILD,LEXFI,LEXFIS,LEXFY,LEXIGHF,LEXLREV,LEXMSG,LEXND,LEXNOTIM,LEXNOPRO,LEXP,LEXPKG,LEXPTYPE,LEXQTR,LEXQUIET,LEXSHORT,LEXSUBH,LEXTD,LEXVER
- +24 SET LEXBUILD=$GET(X)
- SET LEXFIS=$GET(Y)
- SET LEXTD=$PIECE($GET(Z),".",1)
- if '$LENGTH(LEXBUILD)
- QUIT
- SET LEXLREV=""
- if $PIECE(LEXBUILD,"*",3)?1N.N
- SET LEXLREV=$PIECE(LEXBUILD,"*",3)
- +25 SET LEXSUBH="Lexicon Installation"
- SET (LEXMSG,LEXSHORT,LEXIGHF,LEXFY,LEXQTR)=""
- SET LEXPTYPE="Lexicon Patch Install"
- SET LEXQUIET=1
- SET LEXNOTIM=1
- +26 SET LEXPKG=$PIECE(LEXBUILD,"*",1)
- SET LEXVER=$PIECE(LEXBUILD,"*",2)
- DO POST^LEXXFI
- if '$LENGTH($GET(LEXFIS))
- QUIT
- if $GET(LEXTD)'?7N
- QUIT
- +27 FOR LEXP=1:1
- SET LEXFI=$PIECE(LEXFIS,"^",LEXP)
- if '$LENGTH(LEXFI)
- QUIT
- Begin DoDot:1
- +28 NEW LEXND
- SET LEXND="^DD("_+LEXFI_",0)"
- if '$DATA(@LEXND)
- QUIT
- +29 SET LEXND="^DD("_+LEXFI_",0,""VRRV"")"
- if $LENGTH($GET(LEXLREV))
- SET $PIECE(@LEXND,"^",1)=$GET(LEXLREV)
- SET $PIECE(@LEXND,"^",2)=LEXTD
- +30 SET LEXND="^DD("_+LEXFI_",0,""VRPK"")"
- if $LENGTH($GET(LEXPKG))
- SET @LEXND=$GET(LEXPKG)
- +31 SET LEXND="^DD("_+LEXFI_",0,""VR"")"
- if $LENGTH($GET(LEXVER))&($PIECE($GET(LEXVER),".",1)?1N.N)
- SET @LEXND=$GET(LEXVER)
- End DoDot:1
- +32 QUIT
- AWRD ; Recalculate ASL Cross-Reference in 757.01
- +1 if $LENGTH($TEXT(AWRD^LEXXGI4))
- DO AWRD^LEXXGI4
- +2 QUIT
- ASL ; Recalculate ASL Cross-Reference in 757.01
- +1 if $LENGTH($TEXT(ASL^LEXXGI4))
- DO ASL^LEXXGI4
- +2 QUIT
- SUB ; Re-Index Subset file 757.21 (set logic only)
- +1 if $LENGTH($TEXT(SUB^LEXXGI4))
- DO SUB^LEXXGI4
- +2 QUIT
- SCHG ; Save Change File Changes (for NOTIFY)
- +1 NEW LEXFI,LEXID
- KILL LEXSCHG
- SET LEXCHG=0
- +2 NEW LEXFI
- SET LEXFI=0
- FOR
- SET LEXFI=$ORDER(^LEXM(LEXFI))
- if +LEXFI'>0
- QUIT
- Begin DoDot:1
- +3 SET LEXID=$SELECT(LEXFI=80!(LEXFI=80.1):"ICD",LEXFI=81!(LEXFI=81.1)!(LEXFI=81.2)!(LEXFI=81.3):"CPT",$PIECE(LEXFI,".",1)=757:"LEX",1:"UNK")
- +4 SET LEXSCHG(LEXFI,0)=+($GET(^LEXM(LEXFI,0)))
- SET LEXSCHG("B",LEXFI)=""
- SET LEXSCHG("C",LEXID,LEXFI)=""
- End DoDot:1
- +5 if $DATA(LEXSCHG("C","CPT"))!($DATA(LEXSCHG("C","ICD")))
- SET LEXSCHG("D","PRO")=""
- +6 if $DATA(^LEXM(80))!($DATA(^LEXM(80.1)))!($DATA(^LEXM(81)))!($DATA(^LEXM(81.2)))!($DATA(^LEXM(81.3)))!($DATA(LEXSCHG("D","PRO")))
- SET LEXCHG=1
- SET LEXSCHG(0)=1
- +7 QUIT
- INV(X,Y) ; Protocol Invoked
- +1 NEW XPDNM,LEXN,LEXP,LEXPD,LEXDT,LEXSAB
- SET LEXSAB=$GET(X)
- if "^LEX^ICD^CPT^"'[("^"_LEXSAB_"^")
- QUIT
- SET LEXP=$SELECT(X="LEX":1,X="ICD":2,X="CPT":3,1:"")
- if +LEXP'>0
- QUIT
- +2 SET LEXPD=LEXP+(.5)
- SET LEXDT=$GET(Y)
- if $PIECE(LEXDT,",",1)'?7N
- SET LEXDT=$$NOW^XLFDT
- if '$DATA(^LEXT(757.2,1,200,0))
- SET ^LEXT(757.2,1,200,0)="^757.201PA^.5^1"
- +3 SET ^LEXT(757.2,1,200,.5,0)=.5
- SET ^LEXT(757.2,1,200,.5,LEXP)=LEXSAB
- SET ^LEXT(757.2,1,200,.5,LEXPD)=LEXN
- +4 QUIT
CHECKSUM ; Check ^LEXM Checksum
+1 DO CS^LEXXGI2
+2 QUIT
TOT ; CSV totals
+1 DO TOT^LEXXGI3
+2 QUIT