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 Apr 09, 2024@21:09:46 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
