LEXRXR ;ISL/KER - Re-Index Lexicon - Reports ;05/23/2017
;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^LEX(757) SACC 1.3
; ^LEX(757.001) SACC 1.3
; ^LEX(757.01) SACC 1.3
; ^LEX(757.02) SACC 1.3
; ^LEX(757.1) SACC 1.3
; ^LEX(757.21) SACC 1.3
; ^LEXT(757.2) SACC 1.3
; ^TMP("LEXRXR",$J) SACC 2.3.2.5.1
; ^TMP("LEXRXRM",$J) SACC 2.3.2.5.1
;
; External References
; HOME^%ZIS ICR 10086
; ^%ZTLOAD ICR 10063
; $$S^%ZTLOAD ICR 10063
; ^DIC ICR 10006
; $$GET1^DIQ ICR 2056
; $$DT^XLFDT ICR 10103
; ^XMD ICR 10070
;
; Local Variables NEWed or KILLed Elsewhere
;
; LEXBYTES If set, the size in will be displayed in
; bytes (vs. MB, KB, GB)
; LEXCAP If set, the output will be displayed in a '^'
; delimited string for import to a spreadsheet
; LEXDOT Include Dot leaders in display (this can be
; set to any character)
; LEXINS Forces a copy of the report to be forwarded
; the developer at G.LEXINS MailGroup
; LEXTEST Run in Test Mode
;
ALL ; Reports (All)
N ENV S ENV=$$ENV Q:+ENV'>0
N X,Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTPRI,LEXMAIL,LEXTYPE,LEXTSK S LEXMAIL="",LEXTYPE="ALL"
S ZTDESC="Lexicon - Data/Index report for All Files",ZTRTN="ALLT^LEXRXR",ZTPRI=4,ZTIO="",ZTDTH=$H
S ZTSAVE("LEXMAIL")="",ZTSAVE("LEXTYPE")="",ZTSAVE("DUZ")="" S:$D(LEXINS) ZTSAVE("LEXINS")=""
D:'$D(LEXTEST)&('$D(LEXCAP)) ^%ZTLOAD D:$D(LEXTEST)!($D(LEXCAP)) @ZTRTN
K LEXTSK I +($G(ZTSK))>0 D
. S LEXTSK(1)="Task #"_+($G(ZTSK))_" was created to report the number and sizes"
. S LEXTSK(2)="of the data and indexes for the primary Lexicon files."
. S LEXTSK(3)="When the task completes a message will be sent to you reporting the results."
. D PR^LEXU(.LEXTSK,70) S LEXI=0 F S LEXI=$O(LEXTSK(LEXI)) Q:+LEXI'>0 D
. . S LEXC=$$TM($G(LEXTSK(LEXI))) W !," ",LEXC
D HOME^%ZIS K ZTDESC,ZTDTH,ZTIO,ZTRTN W:+($G(ZTSK))>0&('$D(LEXINS)) ! H:+($G(ZTSK))>0&('$D(LEXINS)) 1
Q
ALLT ; Reports (All) Tasked
K ^TMP("LEXRXR",$J),^TMP("LEXRXRM",$J) D CON,FRE,EXP,COD,SEM,SUB
D:$D(LEXMAIL)&('$D(LEXCAP)) MAIL D:'$D(LEXMAIL)!($D(LEXCAP)) MAILQ
Q
;
; Reports
CON ; Major Concept Map file #757 Report
K ^TMP("LEXRXR",$J) K:'$D(LEXMAIL) ^TMP("LEXRXRM",$J)
K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT S LEXFI=757 N LEXTC S LEXTC=$$UPD(LEXFI)
S ^TMP("LEXRXR",$J,"IN","B")=$$NAM("B","Expression")
D FILE(LEXFI)
Q
FRE ; Concept Usage file #757.001 Report
K ^TMP("LEXRXR",$J) K:'$D(LEXMAIL) ^TMP("LEXRXRM",$J)
K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT S LEXFI=757.001 N LEXTC S LEXTC=$$UPD(LEXFI)
S ^TMP("LEXRXR",$J,"IN","B")=$$NAM("B","Major Concept")
S ^TMP("LEXRXR",$J,"IN","AF")=$$NAM("AF","Frequency of Use")
D FILE(LEXFI)
Q
EXP ; Expressions file #757.01 Report
K ^TMP("LEXRXR",$J) K:'$D(LEXMAIL) ^TMP("LEXRXRM",$J)
K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT S LEXFI=757.01
N LEXTC S LEXTC=$$UPD(LEXFI)
S ^TMP("LEXRXR",$J,"IN","B")=$$NAM("B","Expression") S ^TMP("LEXRXR",$J,"IN","ADC")=$$NAM("ADC","Deactivated IENs")
S ^TMP("LEXRXR",$J,"IN","AH")=$$NAM("AH","SNOMED CT Hierarchy"),^TMP("LEXRXR",$J,"IN","APAR")=$$NAM("APAR","Parent Term")
S ^TMP("LEXRXR",$J,"IN","ADTERM")=$$NAM("ADTERM","Deactivated Expressions") S ^TMP("LEXRXR",$J,"IN","AMC")=$$NAM("AMC","Major Concept Expressions")
S ^TMP("LEXRXR",$J,"IN","ASL")=$$NAM("ASL","Token String Lengths") S ^TMP("LEXRXR",$J,"IN","AWRD")=$$NAM("AWRD","Words in an Expression")
D FILE(LEXFI)
Q
COD ; Codes file #757.02 Report
K ^TMP("LEXRXR",$J) K:'$D(LEXMAIL) ^TMP("LEXRXRM",$J)
K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT S LEXFI=757.02 N LEXTC S LEXTC=$$UPD(LEXFI)
S ^TMP("LEXRXR",$J,"IN","ACODE")=$$NAM("ACODE","Codes *") S ^TMP("LEXRXR",$J,"IN","ACT")=$$NAM("ACT","Code Activation Dates")
S ^TMP("LEXRXR",$J,"IN","ADC")=$$NAM("ADC","Deactivated Entries *") S ^TMP("LEXRXR",$J,"IN","ADCODE")=$$NAM("ADCODE","Deactivated Code *")
S ^TMP("LEXRXR",$J,"IN","ADX")=$$NAM("ADX","ICD-10-CM Diagnosis Codes") S ^TMP("LEXRXR",$J,"IN","AMC")=$$NAM("AMC","Code Major Concept")
S ^TMP("LEXRXR",$J,"IN","APCODE")=$$NAM("APCODE","Preferred Term Flag") S ^TMP("LEXRXR",$J,"IN","APR")=$$NAM("APR","ICD-10-PCS Procedure Codes")
S ^TMP("LEXRXR",$J,"IN","ASRC")=$$NAM("ASRC","Codes by Coding System") S ^TMP("LEXRXR",$J,"IN","AUPD")=$$NAM("AUPD","Date Coding System was Updated")
S ^TMP("LEXRXR",$J,"IN","AVA")=$$NAM("AVA","VA Coding Systems") S ^TMP("LEXRXR",$J,"IN","B")=$$NAM("B","Code Expression")
S ^TMP("LEXRXR",$J,"IN","CODE")=$$NAM("CODE","Codes") D FILE(LEXFI)
Q
SEM ; Semantic Map file #757.1 Report
K ^TMP("LEXRXR",$J) K:'$D(LEXMAIL) ^TMP("LEXRXRM",$J)
K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT S LEXFI=757.1 N LEXTC S LEXTC=$$UPD(LEXFI)
S ^TMP("LEXRXR",$J,"IN","AMCC")=$$NAM("AMCC","Major Concept Semantic Class") S ^TMP("LEXRXR",$J,"IN","AMCT")=$$NAM("AMCT","Major Concept Semantic Type")
S ^TMP("LEXRXR",$J,"IN","ASTT")=$$NAM("ASTT","Semantic Type Major Concept") S ^TMP("LEXRXR",$J,"IN","B")=$$NAM("B","Major Concept")
D FILE(LEXFI)
Q
SUB ; Subset Report
N LEXB,LEXD,LEXEXE,LEXFI,LEXFS,LEXIX,LEXM,LEXN,X K ^TMP("LEXRXR",$J)
I $D(LEXCAP)!($D(LEXTEST)) S LEXEXE="K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT" X LEXEXE
S LEXM=$E($G(LEXDOT),1) S:'$L(LEXM) LEXM=" " S:'$L($G(LEXDOT))&($D(LEXDOT)) LEXM="." S LEXFI=757.21,LEXFS=757.2
N LEXTC S LEXTC=$$UPD(LEXFI) D SIN S X=$$RC(LEXFI),X=$$IC(LEXFI) D TN D:$L($O(^TMP("LEXRXR",$J,"IN",""))) HDR(LEXFI)
S LEXIX="" F S LEXIX=$O(^TMP("LEXRXR",$J,"IN",LEXIX)) Q:'$L(LEXIX) D
. S LEXN="" F S LEXN=$O(^TMP("LEXRXR",$J,"IN",LEXIX,LEXN)) Q:'$L(LEXN) D
. . N LEXD,LEXB S LEXD=$P($G(^TMP("LEXRXR",$J,"IN",LEXIX,LEXN)),"^",1)
. . S LEXB=$P($G(^TMP("LEXRXR",$J,"IN",LEXIX,LEXN)),"^",2) D LIN(LEXN,LEXD,LEXB)
D:$L($O(^TMP("LEXRXR",$J,"IN",""))) TT D:$D(LEXTEST)!('$D(LEXMAIL)) SM K ^TMP("LEXRXR",$J)
Q
;
; Miscellaneous
FILE(X) ; Process File #X
N LEXBTS,LEXD,LEXDAT,LEXDB,LEXDN,LEXDR,LEXFI,LEXI,LEXIB,LEXIN,LEXIR,LEXIX,LEXNAM,LEXNDS,LEXTB,LEXTN
S LEXFI=+($G(X)) Q:'$D(^LEX(+LEXFI,0))
S LEXD=$$RC(LEXFI),LEXDR=+LEXD,LEXDN=$P(LEXD,"^",2),LEXDB=$P(LEXD,"^",3) S LEXTN=+($G(LEXTN))+LEXDN,LEXTB=+($G(LEXTB))+LEXDB
S LEXI=$$IC(LEXFI),LEXIR=+LEXI,LEXIN=$P(LEXI,"^",2),LEXIB=$P(LEXI,"^",3) S LEXTN=+($G(LEXTN))+LEXIN,LEXTB=+($G(LEXTB))+LEXIB
D:$L($O(^TMP("LEXRXR",$J,"IN",""))) HDR(LEXFI)
S LEXIX="" F S LEXIX=$O(^TMP("LEXRXR",$J,"IN",LEXIX)) Q:'$L(LEXIX) D
. N LEXNAM,LEXDAT,LEXNDS,LEXBTS S LEXNAM=$O(^TMP("LEXRXR",$J,"IN",LEXIX,"")) Q:'$L(LEXNAM)
. S LEXDAT=$G(^TMP("LEXRXR",$J,"IN",LEXIX,LEXNAM)),LEXNDS=$P(LEXDAT,"^",1),LEXBTS=$P(LEXDAT,"^",2) D LIN(LEXNAM,LEXNDS,LEXBTS)
D TN D:$L($O(^TMP("LEXRXR",$J,"IN",""))) TT D:$D(LEXTEST)!('$D(LEXMAIL)) SM
K ^TMP("LEXRXR",$J) K:'$D(LEXMAIL) ^TMP("LEXRXRM",$J)
Q
HDR(X) ; File Header
N LEXFI,LEXFN,LEXT S LEXFI=+($G(X)) I $D(^LEX(+LEXFI)) D
. N LEXFN,LEXT S LEXFN=$P($G(^LEX(LEXFI,0)),"^",1) Q:'$L(LEXFN)
. S LEXT=" "_LEXFN,LEXT=LEXT_$J(" ",(30-$L(LEXT)))_"File #"_LEXFI D BL,TL(LEXT)
S LEXT=" Component",LEXT=LEXT_$J(" ",(47-$L(LEXT)))_$J("Nodes",10)_" "_$J("Size",10) D BL,TL(LEXT)
S LEXT=" ------------------------------------",LEXT=LEXT_$J(" ",(47-$L(LEXT)))_$J("--------",10)_" "_$J("------",10) D TL(LEXT)
Q
RC(X) ; Record Counts
N LEXB,LEXC,LEXFI,LEXN,LEXNAM,LEXNC,LEXNN,LEXR S LEXFI=+($G(X)) Q:LEXFI'>0 "" Q:'$D(^LEX(+LEXFI,0)) ""
S (LEXR,LEXB,LEXN,LEXC)=0 F S LEXR=$O(^LEX(+LEXFI,LEXR)) Q:+LEXR'>0 D
. N LEXNN,LEXNC S LEXNN="^LEX("_+LEXFI_","_+LEXR_")",LEXNC="^LEX("_LEXFI_","_+LEXR_"," S LEXC=LEXC+1
. F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) D
. . S LEXN=+($G(LEXN))+1 S LEXB=((+($G(LEXB))+$L(LEXNN))+$L(@LEXNN))+1
S LEXNAM="Total Data Nodes" S:+LEXC>0 LEXNAM=LEXNAM_" ("_+LEXC_" Record"_$S(+LEXC>1:"s",1:"")_")"
K ^TMP("LEXRXR",$J,"TD") S X=LEXC_"^"_LEXN_"^"_LEXB,^TMP("LEXRXR",$J,"TD",LEXNAM)=X
I $D(LEXTEST) W !,LEXNAM,?47,$J(LEXN,8),?58,$J($G(LEXB),10),$S(+($G(LEXB))>0:" b",1:"")
Q X
IC(X) ; Index Counts
N LEXB,LEXC,LEXFI,LEXIB,LEXIN,LEXIX,LEXN,LEXNAM,LEXNB,LEXNC,LEXNN S LEXFI=+($G(X)) Q:+LEXFI'>0 "" Q:'$D(^LEX(+LEXFI,0)) ""
S (LEXC,LEXN,LEXB)=0,LEXIX="A" F S LEXIX=$O(^LEX(LEXFI,LEXIX)) Q:'$L(LEXIX) D
. N LEXTMP S LEXTMP=$$UPD(LEXFI,LEXIX)
. Q:$E(LEXIX,1)'?1U S LEXC=LEXC+1 N LEXIB,LEXIN,LEXNAM,LEXNN,LEXNC S (LEXIN,LEXIB)=0
. S LEXNAM=$G(^TMP("LEXRXR",$J,"IN",LEXIX)) S:'$L(LEXNAM) LEXNAM=$$NAM(LEXIX,"Unknown")
. S LEXNN="^LEX("_+LEXFI_","""_LEXIX_""")" S LEXNC="^LEX("_+LEXFI_","""_LEXIX_""","
. F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) D
. . N LEXNB S LEXIN=LEXIN+1,LEXN=LEXN+1,LEXNB=(+$L(LEXNN)+$L(@LEXNN))+1 S LEXB=+($G(LEXB))+LEXNB,LEXIB=+($G(LEXIB))+LEXNB
. K ^TMP("LEXRXR",$J,"IN",LEXIX) S ^TMP("LEXRXR",$J,"IN",LEXIX,LEXNAM)=LEXIN_"^"_+($G(LEXIB))
. W:$D(LEXTEST) !,?1,LEXNAM,?47,$J(LEXIN,8),?58,$J($G(LEXIB),10),$S(+($G(LEXIB))>0:" b",1:"")
S LEXNAM="Total Index Nodes" S:+LEXC>0 LEXNAM=LEXNAM_" ("_LEXC_$S(LEXC>1:" Indexes",1:" Index")_")"
K ^TMP("LEXRXR",$J,"TI") S X=LEXC_"^"_LEXN_"^"_LEXB,^TMP("LEXRXR",$J,"TI",LEXNAM)=X
I $D(LEXTEST) W !," ",LEXNAM,?47,$J(LEXN,8),?58,$J($G(LEXB),10),$S(+($G(LEXB))>0:" b",1:"")
Q X
TN ; Total Nodes/Bytes
N LEXB,LEXD,LEXN,LEXS S (LEXN,LEXB)=0
S LEXS=$O(^TMP("LEXRXR",$J,"TI","")) I $L(LEXS) S LEXD=$G(^TMP("LEXRXR",$J,"TI",LEXS)),LEXN=LEXN+$P(LEXD,"^",2),LEXB=LEXB+$P(LEXD,"^",3)
S LEXS=$O(^TMP("LEXRXR",$J,"TD","")) I $L(LEXS) S LEXD=$G(^TMP("LEXRXR",$J,"TD",LEXS)),LEXN=LEXN+$P(LEXD,"^",2),LEXB=LEXB+$P(LEXD,"^",3)
S ^TMP("LEXRXR",$J,"TT","Total Data/Index Nodes")=LEXN_"^"_LEXB
Q
TT ; Totals
N LEXBTS,LEXDAT,LEXNAM,LEXNDS D BL
S LEXNAM=$O(^TMP("LEXRXR",$J,"TI","")) I $D(LEXNAM) D
. S LEXDAT=$G(^TMP("LEXRXR",$J,"TI",LEXNAM)),LEXNDS=$P(LEXDAT,"^",2),LEXBTS=$P(LEXDAT,"^",3) D LIN(LEXNAM,LEXNDS,LEXBTS)
S LEXNAM=$O(^TMP("LEXRXR",$J,"TD","")) I $D(LEXNAM) D
. S LEXDAT=$G(^TMP("LEXRXR",$J,"TD",LEXNAM)),LEXNDS=$P(LEXDAT,"^",2),LEXBTS=$P(LEXDAT,"^",3) D LIN(LEXNAM,LEXNDS,LEXBTS)
S LEXNAM=$O(^TMP("LEXRXR",$J,"TT","")) I $D(LEXNAM) D
. S LEXDAT=$G(^TMP("LEXRXR",$J,"TT",LEXNAM)),LEXNDS=$P(LEXDAT,"^",1),LEXBTS=$P(LEXDAT,"^",2) D LIN(LEXNAM,LEXNDS,LEXBTS)
Q
NAM(X,Y) ; Name
N LEXI,LEXN S LEXI=$G(X) S:$E(LEXI,1)'?1U LEXI="" S:$L(LEXI)&($E(LEXI,1)?1U) LEXI=""""_LEXI_""""
S LEXN=$G(Y) S:$L(LEXI) LEXI=LEXI_$J(" ",11-$L(LEXI)) S X=LEXI_LEXN
Q X
SIN ; Subset Names
N LEXFI,LEXFS,LEXIX,LEXSB,LEXSI,LEXST S LEXFI=757.21,LEXFS=757.2,LEXIX="A"
F S LEXIX=$O(^LEX(LEXFI,LEXIX)) Q:'$L(LEXIX) D
. I LEXIX="B" S ^TMP("LEXRXR",$J,"IN",LEXIX)=$$NAM(LEXIX,"Expression IEN") Q
. I LEXIX="C" S ^TMP("LEXRXR",$J,"IN",LEXIX)=$$NAM(LEXIX,"Expression Text") Q
. N LEXSB,LEXSI,LEXST S LEXSB=LEXIX S LEXSB=$E(LEXSB,2,4) Q:'$L(LEXSB)
. S LEXSI=$O(^LEXT(LEXFS,"AA",LEXSB,0)),LEXST=$$MIX^LEXXM($P($G(^LEXT(LEXFS,+LEXSI,0)),"^",1))
. S ^TMP("LEXRXR",$J,"IN",LEXIX)=$$NAM(LEXIX,LEXST)
Q
LIN(X,Y,Z) ; Line (format name, nodes, size)
N LEXBT,LEXM,LEXND,LEXNM,LEXSIZ,LEXT S LEXNM=$G(X),LEXND=+($G(Y)),LEXBT=$G(Z),LEXSIZ=$$SIZ(LEXBT),LEXT=""
I $D(LEXCAP) S LEXT=LEXNM_"^"_LEXND S:$D(LEXBYTES) LEXT=LEXT_"^"_LEXBT S:'$D(LEXCAP) LEXT=LEXT_"^"_LEXSIZ D TL(LEXT) Q
S LEXM=$E($G(LEXDOT),1) S:'$L(LEXM) LEXM=" " S:'$L($G(LEXDOT))&($D(LEXDOT)) LEXM="."
S LEXT=" "_LEXNM S:($L(LEXT)#2)'>0 LEXT=LEXT_" " F Q:$L(LEXT)>47 S LEXT=LEXT_" "_$G(LEXM)
S:$L(LEXND)=7 LEXT=LEXT_" " S:$L(LEXND)=6 LEXT=LEXT_" " S:$L(LEXND)=5 LEXT=LEXT_" "_$G(LEXM)_" " S:$L(LEXND)=4 LEXT=LEXT_" "_$G(LEXM)_" "
S:$L(LEXND)=3 LEXT=LEXT_" "_$G(LEXM)_" "_$G(LEXM)_" " S:$L(LEXND)=2 LEXT=LEXT_" "_$G(LEXM)_" "_$G(LEXM)_" "
S:$L(LEXND)=1!($L(LEXND)'>0) LEXT=LEXT_" "_$G(LEXM)_" "_$G(LEXM)_" "_$G(LEXM)_" " S LEXT=LEXT_LEXND
S LEXT=LEXT_$J(" ",(61-$L(LEXT))) S:$D(LEXBYTES) LEXT=LEXT_$J(LEXBT,10) S:'$D(LEXBYTES) LEXT=LEXT_$J(LEXSIZ,10) D TL(LEXT)
Q
BL(X) ; Blank Line
D TL(" ")
Q
TL(X) ; Text Line
N LEXI S LEXI=$O(^TMP("LEXRXRM",$J," "),-1)+1
S ^TMP("LEXRXRM",$J,+LEXI)=$G(X),^TMP("LEXRXRM",$J,0)=LEXI
Q
SIZ(X) ; Size
N NUM,SUF S SUF=" B ",NUM=+($G(X)) Q:NUM'>0 "" Q:$D(LEXBYTES) NUM
Q:NUM'>1024&($D(LEXCAP)) (NUM_"^B") Q:NUM'>1024 (NUM_SUF)
S SUF=" KB",NUM=NUM/1024,NUM=$FN(NUM,"",0) Q:NUM'>1024&($D(LEXCAP)) (NUM_"^KB") Q:NUM'>1024 (NUM_SUF)
S SUF=" MB",NUM=NUM/1024,NUM=$FN(NUM,"",0) Q:NUM'>1024&($D(LEXCAP)) (NUM_"^MB") Q:NUM'>1024 (NUM_SUF)
S SUF=" GB",NUM=NUM/1024,NUM=$FN(NUM,"",0) Q:NUM'>1024&($D(LEXCAP)) (NUM_"^GB") Q:NUM'>1024 (NUM_SUF)
Q (NUM_" ")
SM ; Show Message
W !! N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXRXRM",$J,+LEXI)) Q:+LEXI'>0 W !,$G(^TMP("LEXRXRM",$J,+LEXI))
Q
ST ; Show Message
N LEXNN,LEXNC S LEXNN="^TMP(""LEXRXR"","_$J_")",LEXNC="^TMP(""LEXRXR"","_$J_"," W:$D(^TMP("LEXRXR",$J)) !
F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) W !,LEXNN,"=",@LEXNN
Q
MAIL ; MailMan
G:$D(LEXCAP) MAILQ N DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,LEXADR,LEXUSR,LEXTC,Y
S LEXADR="" S LEXTC=$$UPD(3.9) G:'$D(^TMP("LEXRXRM",$J)) MAILQ G:+($G(^TMP("LEXRXRM",$J,0)))=0 MAILQ K XMZ N DIFROM
S XMSUB="Lexicon Data/Index Nodes and Size" K XMY S:+($G(DUZ))>0 XMY(+($G(DUZ)))=""
S LEXUSR=$$USR(+($G(DUZ))) S:$L(LEXUSR) XMY(LEXUSR)=""
S:$D(LEXINS) LEXADR=$$ADR S:$L(LEXADR) XMY(("G.LEXINS@"_LEXADR))="" G:'$D(XMY) MAILQ
S XMTEXT="^TMP(""LEXRXRM"",$J,",XMDUZ=.5 D ^XMD I '$D(ZTQUEUED),+($G(XMZ))>0 D
. W !!," 'Lexicon Data/Index Nodes and Size' message (#",+($G(XMZ)),") sent"
MAILQ ; End of MailMan message
K ^TMP("LEXRXR",$J),^TMP("LEXRXRM",$J) K DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,LEXSUB,X,Y N LEXINS
Q
ADR(LEX) ; MailMan Address - G.LEXINS@FO-SLC.DOMAIN.EXT
N DIC,DTOUT,DUOUT,X,Y
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
Q "ISC-SLC.DOMAIN.EXT"
UPD(X,Y) ; Update Task ^%ZTSK
N LEXFI,LEXNM,LEXDES,LEXDEF,LEXIX S LEXFI=+($G(X)),LEXIX=$G(Y),LEXNM="" S X=0
S LEXDEF="" S:$G(LEXTYPE)="ALL" LEXDEF="Lexicon - Data/Index report for All Files"
I LEXFI=3.9 S LEXNM="MailMan",LEXDES="Lexicon - Sending MailMan message"
I $P(LEXFI,".",1)="757" D
. S LEXNM=$P($G(^LEX(LEXFI,0)),"^",1) Q:'$L(LEXNM) S LEXNM=LEXNM_" file #"_LEXFI
. S:$L(LEXIX)&($E(LEXIX,1)?1U) LEXNM=LEXNM_" """_LEXIX_""""
. S LEXDES="Lexicon - Checking "_LEXNM
I $D(ZTQUEUED) S:$L(LEXNM) X=$$S^%ZTLOAD(LEXDES) S:'$L(LEXNM)&($L(LEXDEF)) X=$$S^%ZTLOAD(LEXDEF)
Q X
TM(X,Y) ; Trim Character Y - Default " "
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
ENV(X) ; Environment
D HOME^%ZIS S U="^",DT=$$DT^XLFDT,DTIME=300 K POP N NM S NM=$$USR+($G(DUZ))
I '$L(NM) W !!,?5,"Invalid/Missing DUZ" N LEXBYTES,LEXCAP Q 0
Q 1
USR(X) ; User Name
Q:+($G(X))'>0 ""
Q $$GET1^DIQ(200,(+($G(X))_","),.01)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXR 15404 printed Dec 13, 2024@02:09:24 Page 2
LEXRXR ;ISL/KER - Re-Index Lexicon - Reports ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^LEX(757) SACC 1.3
+5 ; ^LEX(757.001) SACC 1.3
+6 ; ^LEX(757.01) SACC 1.3
+7 ; ^LEX(757.02) SACC 1.3
+8 ; ^LEX(757.1) SACC 1.3
+9 ; ^LEX(757.21) SACC 1.3
+10 ; ^LEXT(757.2) SACC 1.3
+11 ; ^TMP("LEXRXR",$J) SACC 2.3.2.5.1
+12 ; ^TMP("LEXRXRM",$J) SACC 2.3.2.5.1
+13 ;
+14 ; External References
+15 ; HOME^%ZIS ICR 10086
+16 ; ^%ZTLOAD ICR 10063
+17 ; $$S^%ZTLOAD ICR 10063
+18 ; ^DIC ICR 10006
+19 ; $$GET1^DIQ ICR 2056
+20 ; $$DT^XLFDT ICR 10103
+21 ; ^XMD ICR 10070
+22 ;
+23 ; Local Variables NEWed or KILLed Elsewhere
+24 ;
+25 ; LEXBYTES If set, the size in will be displayed in
+26 ; bytes (vs. MB, KB, GB)
+27 ; LEXCAP If set, the output will be displayed in a '^'
+28 ; delimited string for import to a spreadsheet
+29 ; LEXDOT Include Dot leaders in display (this can be
+30 ; set to any character)
+31 ; LEXINS Forces a copy of the report to be forwarded
+32 ; the developer at G.LEXINS MailGroup
+33 ; LEXTEST Run in Test Mode
+34 ;
ALL ; Reports (All)
+1 NEW ENV
SET ENV=$$ENV
if +ENV'>0
QUIT
+2 NEW X,Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTPRI,LEXMAIL,LEXTYPE,LEXTSK
SET LEXMAIL=""
SET LEXTYPE="ALL"
+3 SET ZTDESC="Lexicon - Data/Index report for All Files"
SET ZTRTN="ALLT^LEXRXR"
SET ZTPRI=4
SET ZTIO=""
SET ZTDTH=$HOROLOG
+4 SET ZTSAVE("LEXMAIL")=""
SET ZTSAVE("LEXTYPE")=""
SET ZTSAVE("DUZ")=""
if $DATA(LEXINS)
SET ZTSAVE("LEXINS")=""
+5 if '$DATA(LEXTEST)&('$DATA(LEXCAP))
DO ^%ZTLOAD
if $DATA(LEXTEST)!($DATA(LEXCAP))
DO @ZTRTN
+6 KILL LEXTSK
IF +($GET(ZTSK))>0
Begin DoDot:1
+7 SET LEXTSK(1)="Task #"_+($GET(ZTSK))_" was created to report the number and sizes"
+8 SET LEXTSK(2)="of the data and indexes for the primary Lexicon files."
+9 SET LEXTSK(3)="When the task completes a message will be sent to you reporting the results."
+10 DO PR^LEXU(.LEXTSK,70)
SET LEXI=0
FOR
SET LEXI=$ORDER(LEXTSK(LEXI))
if +LEXI'>0
QUIT
Begin DoDot:2
+11 SET LEXC=$$TM($GET(LEXTSK(LEXI)))
WRITE !," ",LEXC
End DoDot:2
End DoDot:1
+12 DO HOME^%ZIS
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN
if +($GET(ZTSK))>0&('$DATA(LEXINS))
WRITE !
if +($GET(ZTSK))>0&('$DATA(LEXINS))
HANG 1
+13 QUIT
ALLT ; Reports (All) Tasked
+1 KILL ^TMP("LEXRXR",$JOB),^TMP("LEXRXRM",$JOB)
DO CON
DO FRE
DO EXP
DO COD
DO SEM
DO SUB
+2 if $DATA(LEXMAIL)&('$DATA(LEXCAP))
DO MAIL
if '$DATA(LEXMAIL)!($DATA(LEXCAP))
DO MAILQ
+3 QUIT
+4 ;
+5 ; Reports
CON ; Major Concept Map file #757 Report
+1 KILL ^TMP("LEXRXR",$JOB)
if '$DATA(LEXMAIL)
KILL ^TMP("LEXRXRM",$JOB)
+2 if $DATA(LEXCAP)
KILL LEXTEST,LEXDOT
if $DATA(LEXTEST)
KILL LEXDOT
SET LEXFI=757
NEW LEXTC
SET LEXTC=$$UPD(LEXFI)
+3 SET ^TMP("LEXRXR",$JOB,"IN","B")=$$NAM("B","Expression")
+4 DO FILE(LEXFI)
+5 QUIT
FRE ; Concept Usage file #757.001 Report
+1 KILL ^TMP("LEXRXR",$JOB)
if '$DATA(LEXMAIL)
KILL ^TMP("LEXRXRM",$JOB)
+2 if $DATA(LEXCAP)
KILL LEXTEST,LEXDOT
if $DATA(LEXTEST)
KILL LEXDOT
SET LEXFI=757.001
NEW LEXTC
SET LEXTC=$$UPD(LEXFI)
+3 SET ^TMP("LEXRXR",$JOB,"IN","B")=$$NAM("B","Major Concept")
+4 SET ^TMP("LEXRXR",$JOB,"IN","AF")=$$NAM("AF","Frequency of Use")
+5 DO FILE(LEXFI)
+6 QUIT
EXP ; Expressions file #757.01 Report
+1 KILL ^TMP("LEXRXR",$JOB)
if '$DATA(LEXMAIL)
KILL ^TMP("LEXRXRM",$JOB)
+2 if $DATA(LEXCAP)
KILL LEXTEST,LEXDOT
if $DATA(LEXTEST)
KILL LEXDOT
SET LEXFI=757.01
+3 NEW LEXTC
SET LEXTC=$$UPD(LEXFI)
+4 SET ^TMP("LEXRXR",$JOB,"IN","B")=$$NAM("B","Expression")
SET ^TMP("LEXRXR",$JOB,"IN","ADC")=$$NAM("ADC","Deactivated IENs")
+5 SET ^TMP("LEXRXR",$JOB,"IN","AH")=$$NAM("AH","SNOMED CT Hierarchy")
SET ^TMP("LEXRXR",$JOB,"IN","APAR")=$$NAM("APAR","Parent Term")
+6 SET ^TMP("LEXRXR",$JOB,"IN","ADTERM")=$$NAM("ADTERM","Deactivated Expressions")
SET ^TMP("LEXRXR",$JOB,"IN","AMC")=$$NAM("AMC","Major Concept Expressions")
+7 SET ^TMP("LEXRXR",$JOB,"IN","ASL")=$$NAM("ASL","Token String Lengths")
SET ^TMP("LEXRXR",$JOB,"IN","AWRD")=$$NAM("AWRD","Words in an Expression")
+8 DO FILE(LEXFI)
+9 QUIT
COD ; Codes file #757.02 Report
+1 KILL ^TMP("LEXRXR",$JOB)
if '$DATA(LEXMAIL)
KILL ^TMP("LEXRXRM",$JOB)
+2 if $DATA(LEXCAP)
KILL LEXTEST,LEXDOT
if $DATA(LEXTEST)
KILL LEXDOT
SET LEXFI=757.02
NEW LEXTC
SET LEXTC=$$UPD(LEXFI)
+3 SET ^TMP("LEXRXR",$JOB,"IN","ACODE")=$$NAM("ACODE","Codes *")
SET ^TMP("LEXRXR",$JOB,"IN","ACT")=$$NAM("ACT","Code Activation Dates")
+4 SET ^TMP("LEXRXR",$JOB,"IN","ADC")=$$NAM("ADC","Deactivated Entries *")
SET ^TMP("LEXRXR",$JOB,"IN","ADCODE")=$$NAM("ADCODE","Deactivated Code *")
+5 SET ^TMP("LEXRXR",$JOB,"IN","ADX")=$$NAM("ADX","ICD-10-CM Diagnosis Codes")
SET ^TMP("LEXRXR",$JOB,"IN","AMC")=$$NAM("AMC","Code Major Concept")
+6 SET ^TMP("LEXRXR",$JOB,"IN","APCODE")=$$NAM("APCODE","Preferred Term Flag")
SET ^TMP("LEXRXR",$JOB,"IN","APR")=$$NAM("APR","ICD-10-PCS Procedure Codes")
+7 SET ^TMP("LEXRXR",$JOB,"IN","ASRC")=$$NAM("ASRC","Codes by Coding System")
SET ^TMP("LEXRXR",$JOB,"IN","AUPD")=$$NAM("AUPD","Date Coding System was Updated")
+8 SET ^TMP("LEXRXR",$JOB,"IN","AVA")=$$NAM("AVA","VA Coding Systems")
SET ^TMP("LEXRXR",$JOB,"IN","B")=$$NAM("B","Code Expression")
+9 SET ^TMP("LEXRXR",$JOB,"IN","CODE")=$$NAM("CODE","Codes")
DO FILE(LEXFI)
+10 QUIT
SEM ; Semantic Map file #757.1 Report
+1 KILL ^TMP("LEXRXR",$JOB)
if '$DATA(LEXMAIL)
KILL ^TMP("LEXRXRM",$JOB)
+2 if $DATA(LEXCAP)
KILL LEXTEST,LEXDOT
if $DATA(LEXTEST)
KILL LEXDOT
SET LEXFI=757.1
NEW LEXTC
SET LEXTC=$$UPD(LEXFI)
+3 SET ^TMP("LEXRXR",$JOB,"IN","AMCC")=$$NAM("AMCC","Major Concept Semantic Class")
SET ^TMP("LEXRXR",$JOB,"IN","AMCT")=$$NAM("AMCT","Major Concept Semantic Type")
+4 SET ^TMP("LEXRXR",$JOB,"IN","ASTT")=$$NAM("ASTT","Semantic Type Major Concept")
SET ^TMP("LEXRXR",$JOB,"IN","B")=$$NAM("B","Major Concept")
+5 DO FILE(LEXFI)
+6 QUIT
SUB ; Subset Report
+1 NEW LEXB,LEXD,LEXEXE,LEXFI,LEXFS,LEXIX,LEXM,LEXN,X
KILL ^TMP("LEXRXR",$JOB)
+2 IF $DATA(LEXCAP)!($DATA(LEXTEST))
SET LEXEXE="K:$D(LEXCAP) LEXTEST,LEXDOT K:$D(LEXTEST) LEXDOT"
XECUTE LEXEXE
+3 SET LEXM=$EXTRACT($GET(LEXDOT),1)
if '$LENGTH(LEXM)
SET LEXM=" "
if '$LENGTH($GET(LEXDOT))&($DATA(LEXDOT))
SET LEXM="."
SET LEXFI=757.21
SET LEXFS=757.2
+4 NEW LEXTC
SET LEXTC=$$UPD(LEXFI)
DO SIN
SET X=$$RC(LEXFI)
SET X=$$IC(LEXFI)
DO TN
if $LENGTH($ORDER(^TMP("LEXRXR",$JOB,"IN","")))
DO HDR(LEXFI)
+5 SET LEXIX=""
FOR
SET LEXIX=$ORDER(^TMP("LEXRXR",$JOB,"IN",LEXIX))
if '$LENGTH(LEXIX)
QUIT
Begin DoDot:1
+6 SET LEXN=""
FOR
SET LEXN=$ORDER(^TMP("LEXRXR",$JOB,"IN",LEXIX,LEXN))
if '$LENGTH(LEXN)
QUIT
Begin DoDot:2
+7 NEW LEXD,LEXB
SET LEXD=$PIECE($GET(^TMP("LEXRXR",$JOB,"IN",LEXIX,LEXN)),"^",1)
+8 SET LEXB=$PIECE($GET(^TMP("LEXRXR",$JOB,"IN",LEXIX,LEXN)),"^",2)
DO LIN(LEXN,LEXD,LEXB)
End DoDot:2
End DoDot:1
+9 if $LENGTH($ORDER(^TMP("LEXRXR",$JOB,"IN","")))
DO TT
if $DATA(LEXTEST)!('$DATA(LEXMAIL))
DO SM
KILL ^TMP("LEXRXR",$JOB)
+10 QUIT
+11 ;
+12 ; Miscellaneous
FILE(X) ; Process File #X
+1 NEW LEXBTS,LEXD,LEXDAT,LEXDB,LEXDN,LEXDR,LEXFI,LEXI,LEXIB,LEXIN,LEXIR,LEXIX,LEXNAM,LEXNDS,LEXTB,LEXTN
+2 SET LEXFI=+($GET(X))
if '$DATA(^LEX(+LEXFI,0))
QUIT
+3 SET LEXD=$$RC(LEXFI)
SET LEXDR=+LEXD
SET LEXDN=$PIECE(LEXD,"^",2)
SET LEXDB=$PIECE(LEXD,"^",3)
SET LEXTN=+($GET(LEXTN))+LEXDN
SET LEXTB=+($GET(LEXTB))+LEXDB
+4 SET LEXI=$$IC(LEXFI)
SET LEXIR=+LEXI
SET LEXIN=$PIECE(LEXI,"^",2)
SET LEXIB=$PIECE(LEXI,"^",3)
SET LEXTN=+($GET(LEXTN))+LEXIN
SET LEXTB=+($GET(LEXTB))+LEXIB
+5 if $LENGTH($ORDER(^TMP("LEXRXR",$JOB,"IN","")))
DO HDR(LEXFI)
+6 SET LEXIX=""
FOR
SET LEXIX=$ORDER(^TMP("LEXRXR",$JOB,"IN",LEXIX))
if '$LENGTH(LEXIX)
QUIT
Begin DoDot:1
+7 NEW LEXNAM,LEXDAT,LEXNDS,LEXBTS
SET LEXNAM=$ORDER(^TMP("LEXRXR",$JOB,"IN",LEXIX,""))
if '$LENGTH(LEXNAM)
QUIT
+8 SET LEXDAT=$GET(^TMP("LEXRXR",$JOB,"IN",LEXIX,LEXNAM))
SET LEXNDS=$PIECE(LEXDAT,"^",1)
SET LEXBTS=$PIECE(LEXDAT,"^",2)
DO LIN(LEXNAM,LEXNDS,LEXBTS)
End DoDot:1
+9 DO TN
if $LENGTH($ORDER(^TMP("LEXRXR",$JOB,"IN","")))
DO TT
if $DATA(LEXTEST)!('$DATA(LEXMAIL))
DO SM
+10 KILL ^TMP("LEXRXR",$JOB)
if '$DATA(LEXMAIL)
KILL ^TMP("LEXRXRM",$JOB)
+11 QUIT
HDR(X) ; File Header
+1 NEW LEXFI,LEXFN,LEXT
SET LEXFI=+($GET(X))
IF $DATA(^LEX(+LEXFI))
Begin DoDot:1
+2 NEW LEXFN,LEXT
SET LEXFN=$PIECE($GET(^LEX(LEXFI,0)),"^",1)
if '$LENGTH(LEXFN)
QUIT
+3 SET LEXT=" "_LEXFN
SET LEXT=LEXT_$JUSTIFY(" ",(30-$LENGTH(LEXT)))_"File #"_LEXFI
DO BL
DO TL(LEXT)
End DoDot:1
+4 SET LEXT=" Component"
SET LEXT=LEXT_$JUSTIFY(" ",(47-$LENGTH(LEXT)))_$JUSTIFY("Nodes",10)_" "_$JUSTIFY("Size",10)
DO BL
DO TL(LEXT)
+5 SET LEXT=" ------------------------------------"
SET LEXT=LEXT_$JUSTIFY(" ",(47-$LENGTH(LEXT)))_$JUSTIFY("--------",10)_" "_$JUSTIFY("------",10)
DO TL(LEXT)
+6 QUIT
RC(X) ; Record Counts
+1 NEW LEXB,LEXC,LEXFI,LEXN,LEXNAM,LEXNC,LEXNN,LEXR
SET LEXFI=+($GET(X))
if LEXFI'>0
QUIT ""
if '$DATA(^LEX(+LEXFI,0))
QUIT ""
+2 SET (LEXR,LEXB,LEXN,LEXC)=0
FOR
SET LEXR=$ORDER(^LEX(+LEXFI,LEXR))
if +LEXR'>0
QUIT
Begin DoDot:1
+3 NEW LEXNN,LEXNC
SET LEXNN="^LEX("_+LEXFI_","_+LEXR_")"
SET LEXNC="^LEX("_LEXFI_","_+LEXR_","
SET LEXC=LEXC+1
+4 FOR
SET LEXNN=$QUERY(@LEXNN)
if '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
Begin DoDot:2
+5 SET LEXN=+($GET(LEXN))+1
SET LEXB=((+($GET(LEXB))+$LENGTH(LEXNN))+$LENGTH(@LEXNN))+1
End DoDot:2
End DoDot:1
+6 SET LEXNAM="Total Data Nodes"
if +LEXC>0
SET LEXNAM=LEXNAM_" ("_+LEXC_" Record"_$SELECT(+LEXC>1:"s",1:"")_")"
+7 KILL ^TMP("LEXRXR",$JOB,"TD")
SET X=LEXC_"^"_LEXN_"^"_LEXB
SET ^TMP("LEXRXR",$JOB,"TD",LEXNAM)=X
+8 IF $DATA(LEXTEST)
WRITE !,LEXNAM,?47,$JUSTIFY(LEXN,8),?58,$JUSTIFY($GET(LEXB),10),$SELECT(+($GET(LEXB))>0:" b",1:"")
+9 QUIT X
IC(X) ; Index Counts
+1 NEW LEXB,LEXC,LEXFI,LEXIB,LEXIN,LEXIX,LEXN,LEXNAM,LEXNB,LEXNC,LEXNN
SET LEXFI=+($GET(X))
if +LEXFI'>0
QUIT ""
if '$DATA(^LEX(+LEXFI,0))
QUIT ""
+2 SET (LEXC,LEXN,LEXB)=0
SET LEXIX="A"
FOR
SET LEXIX=$ORDER(^LEX(LEXFI,LEXIX))
if '$LENGTH(LEXIX)
QUIT
Begin DoDot:1
+3 NEW LEXTMP
SET LEXTMP=$$UPD(LEXFI,LEXIX)
+4 if $EXTRACT(LEXIX,1)'?1U
QUIT
SET LEXC=LEXC+1
NEW LEXIB,LEXIN,LEXNAM,LEXNN,LEXNC
SET (LEXIN,LEXIB)=0
+5 SET LEXNAM=$GET(^TMP("LEXRXR",$JOB,"IN",LEXIX))
if '$LENGTH(LEXNAM)
SET LEXNAM=$$NAM(LEXIX,"Unknown")
+6 SET LEXNN="^LEX("_+LEXFI_","""_LEXIX_""")"
SET LEXNC="^LEX("_+LEXFI_","""_LEXIX_""","
+7 FOR
SET LEXNN=$QUERY(@LEXNN)
if '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
Begin DoDot:2
+8 NEW LEXNB
SET LEXIN=LEXIN+1
SET LEXN=LEXN+1
SET LEXNB=(+$LENGTH(LEXNN)+$LENGTH(@LEXNN))+1
SET LEXB=+($GET(LEXB))+LEXNB
SET LEXIB=+($GET(LEXIB))+LEXNB
End DoDot:2
+9 KILL ^TMP("LEXRXR",$JOB,"IN",LEXIX)
SET ^TMP("LEXRXR",$JOB,"IN",LEXIX,LEXNAM)=LEXIN_"^"_+($GET(LEXIB))
+10 if $DATA(LEXTEST)
WRITE !,?1,LEXNAM,?47,$JUSTIFY(LEXIN,8),?58,$JUSTIFY($GET(LEXIB),10),$SELECT(+($GET(LEXIB))>0:" b",1:"")
End DoDot:1
+11 SET LEXNAM="Total Index Nodes"
if +LEXC>0
SET LEXNAM=LEXNAM_" ("_LEXC_$SELECT(LEXC>1:" Indexes",1:" Index")_")"
+12 KILL ^TMP("LEXRXR",$JOB,"TI")
SET X=LEXC_"^"_LEXN_"^"_LEXB
SET ^TMP("LEXRXR",$JOB,"TI",LEXNAM)=X
+13 IF $DATA(LEXTEST)
WRITE !," ",LEXNAM,?47,$JUSTIFY(LEXN,8),?58,$JUSTIFY($GET(LEXB),10),$SELECT(+($GET(LEXB))>0:" b",1:"")
+14 QUIT X
TN ; Total Nodes/Bytes
+1 NEW LEXB,LEXD,LEXN,LEXS
SET (LEXN,LEXB)=0
+2 SET LEXS=$ORDER(^TMP("LEXRXR",$JOB,"TI",""))
IF $LENGTH(LEXS)
SET LEXD=$GET(^TMP("LEXRXR",$JOB,"TI",LEXS))
SET LEXN=LEXN+$PIECE(LEXD,"^",2)
SET LEXB=LEXB+$PIECE(LEXD,"^",3)
+3 SET LEXS=$ORDER(^TMP("LEXRXR",$JOB,"TD",""))
IF $LENGTH(LEXS)
SET LEXD=$GET(^TMP("LEXRXR",$JOB,"TD",LEXS))
SET LEXN=LEXN+$PIECE(LEXD,"^",2)
SET LEXB=LEXB+$PIECE(LEXD,"^",3)
+4 SET ^TMP("LEXRXR",$JOB,"TT","Total Data/Index Nodes")=LEXN_"^"_LEXB
+5 QUIT
TT ; Totals
+1 NEW LEXBTS,LEXDAT,LEXNAM,LEXNDS
DO BL
+2 SET LEXNAM=$ORDER(^TMP("LEXRXR",$JOB,"TI",""))
IF $DATA(LEXNAM)
Begin DoDot:1
+3 SET LEXDAT=$GET(^TMP("LEXRXR",$JOB,"TI",LEXNAM))
SET LEXNDS=$PIECE(LEXDAT,"^",2)
SET LEXBTS=$PIECE(LEXDAT,"^",3)
DO LIN(LEXNAM,LEXNDS,LEXBTS)
End DoDot:1
+4 SET LEXNAM=$ORDER(^TMP("LEXRXR",$JOB,"TD",""))
IF $DATA(LEXNAM)
Begin DoDot:1
+5 SET LEXDAT=$GET(^TMP("LEXRXR",$JOB,"TD",LEXNAM))
SET LEXNDS=$PIECE(LEXDAT,"^",2)
SET LEXBTS=$PIECE(LEXDAT,"^",3)
DO LIN(LEXNAM,LEXNDS,LEXBTS)
End DoDot:1
+6 SET LEXNAM=$ORDER(^TMP("LEXRXR",$JOB,"TT",""))
IF $DATA(LEXNAM)
Begin DoDot:1
+7 SET LEXDAT=$GET(^TMP("LEXRXR",$JOB,"TT",LEXNAM))
SET LEXNDS=$PIECE(LEXDAT,"^",1)
SET LEXBTS=$PIECE(LEXDAT,"^",2)
DO LIN(LEXNAM,LEXNDS,LEXBTS)
End DoDot:1
+8 QUIT
NAM(X,Y) ; Name
+1 NEW LEXI,LEXN
SET LEXI=$GET(X)
if $EXTRACT(LEXI,1)'?1U
SET LEXI=""
if $LENGTH(LEXI)&($EXTRACT(LEXI,1)?1U)
SET LEXI=""""_LEXI_""""
+2 SET LEXN=$GET(Y)
if $LENGTH(LEXI)
SET LEXI=LEXI_$JUSTIFY(" ",11-$LENGTH(LEXI))
SET X=LEXI_LEXN
+3 QUIT X
SIN ; Subset Names
+1 NEW LEXFI,LEXFS,LEXIX,LEXSB,LEXSI,LEXST
SET LEXFI=757.21
SET LEXFS=757.2
SET LEXIX="A"
+2 FOR
SET LEXIX=$ORDER(^LEX(LEXFI,LEXIX))
if '$LENGTH(LEXIX)
QUIT
Begin DoDot:1
+3 IF LEXIX="B"
SET ^TMP("LEXRXR",$JOB,"IN",LEXIX)=$$NAM(LEXIX,"Expression IEN")
QUIT
+4 IF LEXIX="C"
SET ^TMP("LEXRXR",$JOB,"IN",LEXIX)=$$NAM(LEXIX,"Expression Text")
QUIT
+5 NEW LEXSB,LEXSI,LEXST
SET LEXSB=LEXIX
SET LEXSB=$EXTRACT(LEXSB,2,4)
if '$LENGTH(LEXSB)
QUIT
+6 SET LEXSI=$ORDER(^LEXT(LEXFS,"AA",LEXSB,0))
SET LEXST=$$MIX^LEXXM($PIECE($GET(^LEXT(LEXFS,+LEXSI,0)),"^",1))
+7 SET ^TMP("LEXRXR",$JOB,"IN",LEXIX)=$$NAM(LEXIX,LEXST)
End DoDot:1
+8 QUIT
LIN(X,Y,Z) ; Line (format name, nodes, size)
+1 NEW LEXBT,LEXM,LEXND,LEXNM,LEXSIZ,LEXT
SET LEXNM=$GET(X)
SET LEXND=+($GET(Y))
SET LEXBT=$GET(Z)
SET LEXSIZ=$$SIZ(LEXBT)
SET LEXT=""
+2 IF $DATA(LEXCAP)
SET LEXT=LEXNM_"^"_LEXND
if $DATA(LEXBYTES)
SET LEXT=LEXT_"^"_LEXBT
if '$DATA(LEXCAP)
SET LEXT=LEXT_"^"_LEXSIZ
DO TL(LEXT)
QUIT
+3 SET LEXM=$EXTRACT($GET(LEXDOT),1)
if '$LENGTH(LEXM)
SET LEXM=" "
if '$LENGTH($GET(LEXDOT))&($DATA(LEXDOT))
SET LEXM="."
+4 SET LEXT=" "_LEXNM
if ($LENGTH(LEXT)#2)'>0
SET LEXT=LEXT_" "
FOR
if $LENGTH(LEXT)>47
QUIT
SET LEXT=LEXT_" "_$GET(LEXM)
+5 if $LENGTH(LEXND)=7
SET LEXT=LEXT_" "
if $LENGTH(LEXND)=6
SET LEXT=LEXT_" "
if $LENGTH(LEXND)=5
SET LEXT=LEXT_" "_$GET(LEXM)_" "
if $LENGTH(LEXND)=4
SET LEXT=LEXT_" "_$GET(LEXM)_" "
+6 if $LENGTH(LEXND)=3
SET LEXT=LEXT_" "_$GET(LEXM)_" "_$GET(LEXM)_" "
if $LENGTH(LEXND)=2
SET LEXT=LEXT_" "_$GET(LEXM)_" "_$GET(LEXM)_" "
+7 if $LENGTH(LEXND)=1!($LENGTH(LEXND)'>0)
SET LEXT=LEXT_" "_$GET(LEXM)_" "_$GET(LEXM)_" "_$GET(LEXM)_" "
SET LEXT=LEXT_LEXND
+8 SET LEXT=LEXT_$JUSTIFY(" ",(61-$LENGTH(LEXT)))
if $DATA(LEXBYTES)
SET LEXT=LEXT_$JUSTIFY(LEXBT,10)
if '$DATA(LEXBYTES)
SET LEXT=LEXT_$JUSTIFY(LEXSIZ,10)
DO TL(LEXT)
+9 QUIT
BL(X) ; Blank Line
+1 DO TL(" ")
+2 QUIT
TL(X) ; Text Line
+1 NEW LEXI
SET LEXI=$ORDER(^TMP("LEXRXRM",$JOB," "),-1)+1
+2 SET ^TMP("LEXRXRM",$JOB,+LEXI)=$GET(X)
SET ^TMP("LEXRXRM",$JOB,0)=LEXI
+3 QUIT
SIZ(X) ; Size
+1 NEW NUM,SUF
SET SUF=" B "
SET NUM=+($GET(X))
if NUM'>0
QUIT ""
if $DATA(LEXBYTES)
QUIT NUM
+2 if NUM'>1024&($DATA(LEXCAP))
QUIT (NUM_"^B")
if NUM'>1024
QUIT (NUM_SUF)
+3 SET SUF=" KB"
SET NUM=NUM/1024
SET NUM=$FNUMBER(NUM,"",0)
if NUM'>1024&($DATA(LEXCAP))
QUIT (NUM_"^KB")
if NUM'>1024
QUIT (NUM_SUF)
+4 SET SUF=" MB"
SET NUM=NUM/1024
SET NUM=$FNUMBER(NUM,"",0)
if NUM'>1024&($DATA(LEXCAP))
QUIT (NUM_"^MB")
if NUM'>1024
QUIT (NUM_SUF)
+5 SET SUF=" GB"
SET NUM=NUM/1024
SET NUM=$FNUMBER(NUM,"",0)
if NUM'>1024&($DATA(LEXCAP))
QUIT (NUM_"^GB")
if NUM'>1024
QUIT (NUM_SUF)
+6 QUIT (NUM_" ")
SM ; Show Message
+1 WRITE !!
NEW LEXI
SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXRXRM",$JOB,+LEXI))
if +LEXI'>0
QUIT
WRITE !,$GET(^TMP("LEXRXRM",$JOB,+LEXI))
+2 QUIT
ST ; Show Message
+1 NEW LEXNN,LEXNC
SET LEXNN="^TMP(""LEXRXR"","_$JOB_")"
SET LEXNC="^TMP(""LEXRXR"","_$JOB_","
if $DATA(^TMP("LEXRXR",$JOB))
WRITE !
+2 FOR
SET LEXNN=$QUERY(@LEXNN)
if '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
WRITE !,LEXNN,"=",@LEXNN
+3 QUIT
MAIL ; MailMan
+1 if $DATA(LEXCAP)
GOTO MAILQ
NEW DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,LEXADR,LEXUSR,LEXTC,Y
+2 SET LEXADR=""
SET LEXTC=$$UPD(3.9)
if '$DATA(^TMP("LEXRXRM",$JOB))
GOTO MAILQ
if +($GET(^TMP("LEXRXRM",$JOB,0)))=0
GOTO MAILQ
KILL XMZ
NEW DIFROM
+3 SET XMSUB="Lexicon Data/Index Nodes and Size"
KILL XMY
if +($GET(DUZ))>0
SET XMY(+($GET(DUZ)))=""
+4 SET LEXUSR=$$USR(+($GET(DUZ)))
if $LENGTH(LEXUSR)
SET XMY(LEXUSR)=""
+5 if $DATA(LEXINS)
SET LEXADR=$$ADR
if $LENGTH(LEXADR)
SET XMY(("G.LEXINS@"_LEXADR))=""
if '$DATA(XMY)
GOTO MAILQ
+6 SET XMTEXT="^TMP(""LEXRXRM"",$J,"
SET XMDUZ=.5
DO ^XMD
IF '$DATA(ZTQUEUED)
IF +($GET(XMZ))>0
Begin DoDot:1
+7 WRITE !!," 'Lexicon Data/Index Nodes and Size' message (#",+($GET(XMZ)),") sent"
End DoDot:1
MAILQ ; End of MailMan message
+1 KILL ^TMP("LEXRXR",$JOB),^TMP("LEXRXRM",$JOB)
KILL DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,LEXSUB,X,Y
NEW LEXINS
+2 QUIT
ADR(LEX) ; MailMan Address - G.LEXINS@FO-SLC.DOMAIN.EXT
+1 NEW DIC,DTOUT,DUOUT,X,Y
+2 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+3 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+4 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="ISC-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+5 QUIT "ISC-SLC.DOMAIN.EXT"
UPD(X,Y) ; Update Task ^%ZTSK
+1 NEW LEXFI,LEXNM,LEXDES,LEXDEF,LEXIX
SET LEXFI=+($GET(X))
SET LEXIX=$GET(Y)
SET LEXNM=""
SET X=0
+2 SET LEXDEF=""
if $GET(LEXTYPE)="ALL"
SET LEXDEF="Lexicon - Data/Index report for All Files"
+3 IF LEXFI=3.9
SET LEXNM="MailMan"
SET LEXDES="Lexicon - Sending MailMan message"
+4 IF $PIECE(LEXFI,".",1)="757"
Begin DoDot:1
+5 SET LEXNM=$PIECE($GET(^LEX(LEXFI,0)),"^",1)
if '$LENGTH(LEXNM)
QUIT
SET LEXNM=LEXNM_" file #"_LEXFI
+6 if $LENGTH(LEXIX)&($EXTRACT(LEXIX,1)?1U)
SET LEXNM=LEXNM_" """_LEXIX_""""
+7 SET LEXDES="Lexicon - Checking "_LEXNM
End DoDot:1
+8 IF $DATA(ZTQUEUED)
if $LENGTH(LEXNM)
SET X=$$S^%ZTLOAD(LEXDES)
if '$LENGTH(LEXNM)&($LENGTH(LEXDEF))
SET X=$$S^%ZTLOAD(LEXDEF)
+9 QUIT X
TM(X,Y) ; Trim Character Y - Default " "
+1 SET X=$GET(X)
if X=""
QUIT X
SET Y=$GET(Y)
if '$LENGTH(Y)
SET Y=" "
+2 FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 QUIT X
ENV(X) ; Environment
+1 DO HOME^%ZIS
SET U="^"
SET DT=$$DT^XLFDT
SET DTIME=300
KILL POP
NEW NM
SET NM=$$USR+($GET(DUZ))
+2 IF '$LENGTH(NM)
WRITE !!,?5,"Invalid/Missing DUZ"
NEW LEXBYTES,LEXCAP
QUIT 0
+3 QUIT 1
USR(X) ; User Name
+1 if +($GET(X))'>0
QUIT ""
+2 QUIT $$GET1^DIQ(200,(+($GET(X))_","),.01)
