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

LEXXGI.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;
  1. ; Global Variables
  1. ; ^LEXM
  1. ;
  1. ; External References
  1. ; HOME^%ZIS ICR 10086
  1. ; ^%ZTLOAD ICR 10063
  1. ; $$GET1^DIQ ICR 2056
  1. ; $$FMTE^XLFDT ICR 10103
  1. ; $$NOW^XLFDT ICR 10103
  1. ; BMES^XPDUTL ICR 10141
  1. ; MES^XPDUTL ICR 10141
  1. ;
  1. ; NEWed or KILLed by Lexicon Environment Check routine LEX20nn
  1. ; LEXBUILD Build
  1. ; LEXFY Fiscal Year
  1. ; LEXIGHF Global Host File
  1. ; LEXLREV Revision
  1. ; LEXPTYPE Patch Type
  1. ; LEXQTR Quarter
  1. ; LEXREQP Required Patches/Builds
  1. ;
  1. ; NEWed or KILLed by KIDS during the Install of a patch/build
  1. ; XPDNM Intall Flag
  1. ;
  1. EN ; Main Entry Point for Installing LEXM in Post-Installs
  1. ;
  1. ; Requires
  1. ;
  1. ; LEXBUILD - the name of the patch/build being installed
  1. ;
  1. ; Uses
  1. ;
  1. ; LEXMSG - If this variable exist, then an install message
  1. ; message will be set to G.LEXICON
  1. ;
  1. ; LEXSHORT - If this variable exist, the install message
  1. ; will be an abbreviated message, without the
  1. ; file totals and checksums
  1. ;
  1. ; Abbreviated Install Message
  1. ;
  1. ; Date and Time Installed
  1. ; Account where the Data was Installed
  1. ; Who Installed the Data
  1. ; The Name of the Build Installed
  1. ; The Name of the Global Host File
  1. ; Protocol Invoked
  1. ; Date and time Protocol was Invoked
  1. ; Install Start Date/Time
  1. ; Install Complete Date/Time
  1. ; Install Elapsed Time
  1. ;
  1. ; Long Install Message
  1. ;
  1. ; All of the elements above plus:
  1. ;
  1. ; File Versions/Revisions
  1. ; File Checksums
  1. ; File Record Counts
  1. ;
  1. ; LEXNOPRO - If this variable exist, the protocol LEXICAL
  1. ; SERVICES UPDATE will not be invoked.
  1. ;
  1. ; LEXPTYPE - Patch Type
  1. ; LEXLREV - Revision
  1. ; LEXREQP - Required Patches/Builds
  1. ; LEXIGHF - The patch Export Global Host Filename
  1. ; LEXFY - Fiscal Year
  1. ; LEXQTR - Quarter
  1. ; LEXCRE - Import Global Creation Date
  1. ;
  1. D IMPORT D KALL^LEXXGI2
  1. Q
  1. TASK ; Queue Lexicon Update with Taskman
  1. N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE,ZTQUEUED,ZTREQ S:$D(LEXBUILD) ZTSAVE("LEXBUILD")="" S:$D(LEXMSG) ZTSAVE("LEXMSG")=""
  1. S:$D(LEXSHORT) ZTSAVE("LEXSHORT")="" S:$D(LEXPTYPE) ZTSAVE("LEXPTYPE")="" S:$D(LEXLREV) ZTSAVE("LEXLREV")="" S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
  1. S:$D(LEXIGHF) ZTSAVE("LEXIGHF")="" S:$D(LEXFY) ZTSAVE("LEXFY")="" S:$D(LEXQTR) ZTSAVE("LEXQTR")="" S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
  1. S ZTRTN="EN^LEXXGI",ZTDESC="Importing Updated Lexicon Data" S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
  1. Q
  1. LEXM ; Force Install of LEXM w/o a Post-Install
  1. N LEXBUILD,LEXBLD,LEXB,LEXBO,LEXCHK,LEXSHORT,LEXTYPE,LEXMSG,LEXPOST,LEXNDS,LEXNOPRO,LEXVER
  1. S LEXNOPRO="",LEXBO=$G(^LEXM(0,"BUILD")),(LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))="LEX*2.0*NN"
  1. S:$L($G(LEXBO)) (LEXBUILD,LEXBLD,LEXB,^LEXM(0,"BUILD"))=LEXBO
  1. S LEXSHORT="",LEXTYPE=LEXB S:$L(LEXB) LEXTYPE=LEXTYPE_" (Forced)" S LEXMSG="",LEXPOST=""
  1. S LEXCHK=+($G(^LEXM(0,"CHECKSUM"))) W !," Running checksum routine on the ^LEXM import global, please wait"
  1. S LEXNDS=+($G(^LEXM(0,"NODES"))),LEXVER=+($$VC^LEXXGI2(LEXCHK,LEXNDS)) W !
  1. W:LEXVER>0 !," Checksum is ok",!
  1. I LEXVER=0 W !!," Import global ^LEXM is missing. Please obtain a copy of ^LEXM before",!," continuing." Q
  1. I LEXVER<0 D Q
  1. . I LEXVER'=-3 W !," Unable to verify checksum for import global ^LEXM (possibly corrupt)"
  1. . I LEXVER=-3 W !," Import global ^LEXM failed checksum"
  1. . W !!," Please KILL the existing import global ^LEXM from your system and"
  1. . W !," obtain a new copy of ^LEXM before continuing with the installation."
  1. D EN
  1. Q
  1. IMPORT ; Import Data during a Patch Installation
  1. 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)
  1. S:$L($G(LEXBUILD)) LEXBUILD=$G(LEXBUILD) S:$L($G(LEXIGHF)) LEXIGHF=$G(LEXIGHF) S:$L($G(LEXFY)) LEXFY=$G(LEXFY)
  1. S:$L($G(LEXQTR)) LEXQTR=$G(LEXQTR) K LEXSCHG,LEXCHG
  1. N LEXB,LEXCD,LEXSTR,LEXLAST,LEXRES,LEXSTART,DG,DIC,DICR,DILOCKTM,DIW,XMDUN,XMZ,ZTSK
  1. S U="^",LEXSTR=$G(LEXPTYPE),LEXB=$G(^LEXM(0,"BUILD")),LEXSTART=$$NOW^XLFDT
  1. S:$L($G(LEXFY))&($L($G(LEXQTR)))&($L(LEXSTR)) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
  1. S:$L(LEXB) LEXBLD=LEXB S:'$L(LEXBLD)&($L(LEXBUILD)) LEXBLD=LEXBUILD
  1. I '$L(LEXB)!(LEXB'=LEXBUILD) D
  1. . N X,LEXBLD I '$L(LEXB) D Q
  1. . . 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(" ")
  1. . I '$L(LEXBUILD) D Q
  1. . . 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(" ")
  1. I $L(LEXB)&(LEXB=LEXBUILD) D
  1. . 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(" ")
  1. . K LEXSCHG S LEXCHG=0,LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
  1. . . 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
  1. . S:$D(LEXSCHG("CPT"))!($D(LEXSCHG("ICD"))) LEXSCHG("PRO")="",LEXCHG=1,LEXSCHG(0)=1
  1. . D LOAD K LEXPROC D UTOT^LEXXGI3 I '$D(LEXNOPRO) D NOTIFY^LEXXGI2
  1. . I +($G(DUZ))>0,$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) D
  1. . . D HOME^%ZIS N DIFROM,LEXPRO,LEXPRON,LEXLAST S LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO"))
  1. . . D:$D(LEXMSG) POST^LEXXFI
  1. Q
  1. LOAD ; Load Data from ^LEXM into IC*/LEX Files
  1. Q:'$L($G(LEXB)) S:$D(ZTQUEUED) ZTREQ="@"
  1. N LEXBEG,LEXELP,LEXEND,LEXMSG,LEXOK,LEXFL,LEXTXT
  1. D:'$D(^LEXM) NF^LEXXGI2 Q:'$D(^LEXM)
  1. S LEXOK=0 S:$O(^LEXM(0))>0 LEXOK=1 D:'LEXOK IG^LEXXGI2 Q:'LEXOK
  1. S LEXBEG=$$HACK^LEXXGI2 D FILES^LEXXGI3 S LEXEND=$$HACK^LEXXGI2,LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
  1. S:LEXELP="" LEXELP="00:00:00"
  1. S LEXRES=$$RESULTS^LEXXII2
  1. S LEXTXT=" Data Update" S:$L(LEXRES) LEXTXT=LEXTXT_": "_$G(LEXRES)
  1. D PB^LEXXGI2(LEXTXT)
  1. D PB^LEXXGI2((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
  1. D TL^LEXXGI2((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
  1. D TL^LEXXGI2((" Elapsed: "_LEXELP))
  1. Q
  1. ;
  1. NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
  1. I '$D(LEXNOPRO) D NOTIFY^LEXXGI2,KALL^LEXXGI2
  1. Q
  1. MSG(X,Y,Z) ; Install Message
  1. ;
  1. ; Input
  1. ;
  1. ; X Build Name, i.e., LEX*2.0*103
  1. ; Y Files - "^" Delimited String of Files Modified
  1. ; Z Effective Date - FileMan
  1. ;
  1. ; Output
  1. ;
  1. ; MailMan Install Message
  1. ;
  1. ; Subj: LEX*2.0*nnn Installation [#nnnnnn] mm/dd/yy@hh:mm n lines
  1. ; From: POSTMASTER In 'IN' basket. Page 1 *New*
  1. ;
  1. ; Lexicon Installation
  1. ; ====================
  1. ;
  1. ; As of: Mmm dd, yyyy hh:mm:ss
  1. ; In Account: [acopunt]
  1. ; Maint By: User, Name (nnn) nnn-nnnn
  1. ; Build: LEX*2.0*nnn
  1. ;
  1. N LEXBUILD,LEXFI,LEXFIS,LEXFY,LEXIGHF,LEXLREV,LEXMSG,LEXND,LEXNOTIM,LEXNOPRO,LEXP,LEXPKG,LEXPTYPE,LEXQTR,LEXQUIET,LEXSHORT,LEXSUBH,LEXTD,LEXVER
  1. 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)
  1. S LEXSUBH="Lexicon Installation",(LEXMSG,LEXSHORT,LEXIGHF,LEXFY,LEXQTR)="",LEXPTYPE="Lexicon Patch Install",LEXQUIET=1,LEXNOTIM=1
  1. S LEXPKG=$P(LEXBUILD,"*",1),LEXVER=$P(LEXBUILD,"*",2) D POST^LEXXFI Q:'$L($G(LEXFIS)) Q:$G(LEXTD)'?7N
  1. F LEXP=1:1 S LEXFI=$P(LEXFIS,"^",LEXP) Q:'$L(LEXFI) D
  1. . N LEXND S LEXND="^DD("_+LEXFI_",0)" Q:'$D(@LEXND)
  1. . S LEXND="^DD("_+LEXFI_",0,""VRRV"")" S:$L($G(LEXLREV)) $P(@LEXND,"^",1)=$G(LEXLREV),$P(@LEXND,"^",2)=LEXTD
  1. . S LEXND="^DD("_+LEXFI_",0,""VRPK"")" S:$L($G(LEXPKG)) @LEXND=$G(LEXPKG)
  1. . S LEXND="^DD("_+LEXFI_",0,""VR"")" S:$L($G(LEXVER))&($P($G(LEXVER),".",1)?1N.N) @LEXND=$G(LEXVER)
  1. Q
  1. AWRD ; Recalculate ASL Cross-Reference in 757.01
  1. D:$L($T(AWRD^LEXXGI4)) AWRD^LEXXGI4
  1. Q
  1. ASL ; Recalculate ASL Cross-Reference in 757.01
  1. D:$L($T(ASL^LEXXGI4)) ASL^LEXXGI4
  1. Q
  1. SUB ; Re-Index Subset file 757.21 (set logic only)
  1. D:$L($T(SUB^LEXXGI4)) SUB^LEXXGI4
  1. Q
  1. SCHG ; Save Change File Changes (for NOTIFY)
  1. N LEXFI,LEXID K LEXSCHG S LEXCHG=0
  1. N LEXFI S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
  1. . 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")
  1. . S LEXSCHG(LEXFI,0)=+($G(^LEXM(LEXFI,0))),LEXSCHG("B",LEXFI)="" S LEXSCHG("C",LEXID,LEXFI)=""
  1. S:$D(LEXSCHG("C","CPT"))!($D(LEXSCHG("C","ICD"))) LEXSCHG("D","PRO")=""
  1. 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
  1. Q
  1. INV(X,Y) ; Protocol Invoked
  1. 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
  1. 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"
  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
  1. Q
  1. CHECKSUM ; Check ^LEXM Checksum
  1. D CS^LEXXGI2
  1. Q
  1. TOT ; CSV totals
  1. D TOT^LEXXGI3
  1. Q