- 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 Feb 18, 2025@23:35:28 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)
