LEXRXC3 ;ISL/KER - Re-Index 757.01 AWRD ;05/23/2017
;;2.0;LEXICON UTILITY;**81,86,103**;Sep 23, 1996;Build 2
;
;
; Global Variables
; ^TMP("LEXRXASL") SACC 2.3.2.5.1
; ^TMP("LEXRXASLU") SACC 2.3.2.5.1
; ^TMP("LEXRXAWRD") SACC 2.3.2.5.1
; ^TMP("LEXRXERR") SACC 2.3.2.5.1
; ^TMP("LEXRXPRO") SACC 2.3.2.5.1
; ^TMP("LEXTKN") SACC 2.3.2.5.1
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; LEXTEST Test variable NEWed/KILLed by Developer
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
; The AWRD cross-references is used to create the ASL
; cross-reference, hence the AWRD cross-reference must
; be repaired/re-indexed before ASL.
;
Q
EN ; Main Entry Point
R75701 ; Repair file 757.01
D KGBL,RAWRD,RASL^LEXRXC4,KGBL
D:'$D(ZTQUEUED) LEX
Q
;
RAWRD ; Index ^LEX(757.01,"AWRD",WORD,MC,EXP)
S:$D(ZTQUEUED) ZTREQ="@" N DA,DIK,LEX0P3,LEX0P4,LEXBEG,LEXCHR,LEXCHRS,LEXCTL,LEXDATA,LEXDIF,LEXE,LEXELP,LEXEND,LEXERR,LEXEX,LEXEXCL,LEXEXP
N LEXFI,LEXFUL,LEXHI,LEXI,LEXIDX,LEXIDXT,LEXIT,LEXL,LEXLO,LEXLTKN,LEXM,LEXMC,LEXMCE,LEXMCEI,LEXMCI,LEXND,LEXNDS
N LEXNOD,LEXRI,LEXRT,LEXRT1,LEXRT2,LEXRXTMP,LEXS,LEXS1,LEXS2,LEXS3,LEXS4,LEXSI,LEXSP,LEXSTR,LEXT,LEXTC
N LEXTK,LEXTKC,LEXTKN,LEXTMP,LEXTNG,LEXTTKN,LEXW,LEXWDS,X S LEXRXTMP=$D(^TMP("LEXRX",$J))
S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""AWRD""")
Q:LEXTC=1 S (LEX0P3,LEX0P4)=0,LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.01
K ^TMP("LEXRXPRO",$J,"AWRD"),^TMP("LEXRXERR",$J,"AWRD"),^TMP("LEXRXAWRD",$J),^TMP("LEXRXAWRDK",$J),^TMP("LEXRXAWRDU",$J)
S LEXIDX="AWRD",LEXIDXT="^LEX(757.01,""AWRD"",WORD,MC,EXP)"
; Build
N LEXEX S LEXEX=0 F S LEXEX=$O(^LEX(757.01,LEXEX)) Q:+LEXEX'>0 D
. N X,LEXEXP,LEXIDX,LEXMC,LEXMCI,LEXMCEI,LEXRI,LEXSI,LEXTKN,LEXTKC,LEXTMP,LEXDEA,LEXTTYP
. S LEXDEA=$$DEA(+LEXEX) Q:LEXDEA>0 S LEXTTYP=$P($G(^LEX(757.01,LEXEX,1)),"^",2) Q:LEXTTYP=8
. S ^TMP("LEXRXPRO",$J,"AWRD","BUILD","IEN")=+LEXEX,LEX0P3=+LEXEX,LEX0P4=LEX0P4+1
. S LEXEXP=$$UP^XLFSTR($G(^LEX(757.01,LEXEX,0))) Q:'$L(LEXEXP)
. S LEXMCI=$P($G(^LEX(757.01,LEXEX,1)),"^",1) Q:+LEXMCI'>0
. S LEXMCEI=$P($G(^LEX(757,LEXMCI,0)),"^",1) Q:+LEXMCEI'>0
. ; Words (main)
. K ^TMP("LEXTKN",$J) S LEXIDX="",X=LEXEXP D PTX^LEXTOKN
. I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
. . S LEXTKN="",LEXTKC=0
. . F S LEXTKC=$O(^TMP("LEXTKN",$J,LEXTKC)) Q:+LEXTKC'>0 D
. . . N LEXND,LEXTKN S LEXTKN=$O(^TMP("LEXTKN",$J,LEXTKC,"")) Q:'$L(LEXTKN)
. . . I +($G(LEXEACT))>0 K ^LEX(757.01,"AWRD",LEXTKN,+($G(LEXMCEI)),+($G(LEXEX))) Q
. . . S LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)_","_LEXMCEI_")" I '$D(@LEXND) D
. . . . N LEXND S LEXND="^LEX(757.01,"_+LEXEX_",4,""B"","_$$QQ(LEXTKN)_")" Q:$D(@LEXND)
. . . . S LEXND="^LEX(757.01,"_+LEXMCEI_",4,""B"","_$$QQ(LEXTKN)_")" Q:$D(@LEXND)
. . . . S LEXERR=+($G(LEXERR))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",0)=$G(^TMP("LEXRXERR",$J,"AWRD",0))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",1)=$G(^TMP("LEXRXERR",$J,"AWRD",1))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",1,0)="Missing word in ""AWRD"" index"
. . . . S LEXND="^TMP(""LEXRXERR"","_$J_",""AWRD"",1,""ERR"","_$$QQ(LEXTKN)_","_LEXMCEI_","_LEXEX_")" S @LEXND=""
. . . . S ^TMP("LEXRXPRO",$J,"AWRD","ERR")=+($G(^TMP("LEXRXPRO",$J,"AWRD","ERR")))+1
. . . I $L($G(LEXTKN)),+($G(LEXMCI))>0,+($G(LEXMCEI))>0,+($G(LEXEX))>0 D
. . . . N LEXND S LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")" Q:$D(@LEXND)
. . . . S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXMCEI_")" Q:$D(@LEXND)
. . . . S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXMCEI_","_LEXEX_")" S @LEXND=""
. K ^TMP("LEXTKN",$J)
. ; Supplemental Words
. S LEXSI=0 F S LEXSI=$O(^LEX(757.01,LEXEX,5,LEXSI)) Q:+LEXSI'>0 D
. . N LEXTKN S LEXTKN=$$UP^XLFSTR($G(^LEX(757.01,LEXEX,5,LEXSI,0))) Q:'$L(LEXTKN)
. . I +($G(LEXEACT))>0 K ^LEX(757.01,"AWRD",LEXTKN,+($G(LEXEX)),+($G(LEXMCEI)),+($G(LEXSI))) Q
. . N LEXND S LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")" Q:$D(@LEXND)
. . I $D(LEXUNQ) S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXEX_")" Q:$D(@LEXND)
. . S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_LEXSI_")" S @LEXND=""
. . S LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_LEXSI_")" I '$D(@LEXND) D
. . . N LEXND,LEXUNQ S LEXERR=+($G(LEXERR))+1
. . . S ^TMP("LEXRXERR",$J,"AWRD",0)=$G(^TMP("LEXRXERR",$J,"AWRD",0))+1
. . . S ^TMP("LEXRXERR",$J,"AWRD",2)=$G(^TMP("LEXRXERR",$J,"AWRD",2))+1
. . . S ^TMP("LEXRXERR",$J,"AWRD",2,0)="Missing supplemental word in ""AWRD"" index"
. . . S LEXND="^TMP(""LEXRXERR"","_$J_",""AWRD"",2,""ERR"","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_+LEXSI_")" S @LEXND=""
. . . S ^TMP("LEXRXPRO",$J,"AWRD","ERR")=+($G(^TMP("LEXRXPRO",$J,"AWRD","ERR")))+1
. ; Linked Words
. I $D(^LEX(757.05,"AEXP",LEXEX)) D
. . N LEXRI S LEXRI=0
. . F S LEXRI=$O(^LEX(757.05,"AEXP",LEXEX,LEXRI)) Q:+LEXRI=0 D
. . . N LEXTKN,LEXMC,LEXND S LEXTKN=$$UP^XLFSTR($P(^LEX(757.05,LEXRI,0),U,1)) Q:'$L(LEXTKN)
. . . I +($G(LEXEACT))>0 K ^LEX(757.01,"AWRD",LEXTKN,+($G(LEXEX)),"LINKED") Q
. . . S LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")" Q:$D(@LEXND)
. . . S LEXMC=$P($G(^LEX(757.01,LEXEX,1)),U,1) Q:+LEXMC'>0
. . . I $D(LEXUNQ) S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTKN)_","_LEXEX_")" Q:$D(@LEXND)
. . . S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTKN)_","_LEXEX_",""LINKED"")" S @LEXND=""
. . . S LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)_","_LEXEX_",""LINKED"")" I '$D(@LEXND) D
. . . . N LEXND,LEXUNQ S LEXERR=+($G(LEXERR))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",0)=$G(^TMP("LEXRXERR",$J,"AWRD",0))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",3)=$G(^TMP("LEXRXERR",$J,"AWRD",3))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",3,0)="Missing linked word in ""AWRD"" index"
. . . . S LEXND="^TMP(""LEXRXERR"","_$J_",""AWRD"",3,""ERR"","_$$QQ(LEXTKN)_","_+LEXEX_",""LINKED"")" S @LEXND=""
. . . . S ^TMP("LEXRXPRO",$J,"AWRD","ERR")=+($G(^TMP("LEXRXPRO",$J,"AWRD","ERR")))+1
; Replace
N LEXCHR,LEXCHRS,LEXCTL,LEXDATA,LEXIT,LEXNOD,LEXRT,LEXRT1,LEXRT2 D CHRS
S LEXIT=0,LEXCHR="" F S LEXCHR=$O(LEXCHRS(LEXCHR)) Q:'$L(LEXCHR) D
. S:$L(LEXCHR) ^TMP("LEXRXPRO",$J,"AWRD","REPLACE","CHR")=LEXCHR
. N LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
. S (LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5)="",LEXIT=0
. S LEXTK1=$C($A(LEXCHR)-1)_"~",LEXTK2=LEXCHR,LEXTK3=LEXCHR_" "
. S:LEXCHR?1N LEXTK4=LEXCHR-.00000001 S:LEXCHR="." LEXTK5=.00000001
. F LEXTK=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5 D
. . Q:'$L(LEXTK) N LEXIT S LEXIT=0 S (LEXLTKN,LEXTTKN)=LEXTK
. . F S LEXLTKN=$O(^LEX(757.01,"AWRD",LEXLTKN)) D Q:LEXIT>0
. . . S:$L(LEXLTKN) ^TMP("LEXRXPRO",$J,"AWRD","REPLACE","WORD")=LEXLTKN
. . . S:'$L(LEXLTKN) LEXIT=1
. . . S:LEXCHR'?1N&($E(LEXLTKN,1)'=LEXCHR) LEXIT=1
. . . S:LEXCHR?1N&($E(LEXLTKN,1)'?1N) LEXIT=1
. . . Q:LEXIT>0
. . . N LEXND
. . . I $L(LEXLTKN) Q:$D(^TMP("LEXRXAWRDU",$J,LEXLTKN))
. . . S:$L(LEXLTKN) ^TMP("LEXRXAWRDU",$J,LEXLTKN)=""
. . . N LEXDATA,LEXND
. . . I $D(LEXFUL) D
. . . . N LEXNOD,LEXCTL,LEXIT,LEXND S LEXIT=0
. . . . S LEXNOD="^LEX(757.01,""AWRD"","""_LEXLTKN_""")"
. . . . S LEXCTL="^LEX(757.01,""AWRD"","""_LEXLTKN_""","
. . . . F S LEXNOD=$Q(@LEXNOD) D Q:LEXIT>0
. . . . . S:'$L(LEXNOD) LEXIT=1 S:LEXNOD'[LEXCTL LEXIT=1
. . . . . Q:LEXIT>0 N LEXFUL
. . . ; Error: Word in LEX and not in TMP
. . . S LEXND="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXLTKN)_")"
. . . I '$D(@LEXND) D
. . . . N LEXND S LEXERR=+($G(LEXERR))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",0)=$G(^TMP("LEXRXERR",$J,"AWRD",0))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",7)=$G(^TMP("LEXRXERR",$J,"AWRD",7))+1
. . . . S ^TMP("LEXRXERR",$J,"AWRD",7,0)="Invalid word found in ""AWRD"" index"
. . . . S LEXND="^TMP(""LEXRXERR"","_$J_",""AWRD"",7,""ERR"","_$$QQ(LEXLTKN)_")" S @LEXND=""
. . . . S ^TMP("LEXRXPRO",$J,"AWRD","ERR")=+($G(^TMP("LEXRXPRO",$J,"AWRD","ERR")))+1
. . . S LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXLTKN)_")" K @LEXND
. . S LEXIT=0 F S LEXTTKN=$O(^TMP("LEXRXAWRD",$J,LEXTTKN)) D Q:LEXIT>0
. . . S:'$L(LEXTTKN) LEXIT=1
. . . S:LEXCHR'?1N&($E(LEXTTKN,1)'=LEXCHR) LEXIT=1
. . . S:LEXCHR?1N&($E(LEXTTKN,1)'?1N) LEXIT=1
. . . Q:LEXIT>0
. . . N LEXND,LEXNOD,LEXCTL,LEXKEY
. . . S LEXNOD="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTTKN)_")"
. . . S LEXCTL="^TMP(""LEXRXAWRD"","_$J_","_$$QQ(LEXTTKN)_","
. . . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . . ; Copy Index from ^TMP to ^LEX
. . . . ; ^TMP("LEXRXAWRD",$J,WORD,MCIEN,EXIEN,SPIEN)
. . . . ; ^LEX(757.01,"AWRD",WORD,MCIEN,EXIEN,SPIEN)
. . . . N LEXND,LEXTKN,LEXMC,LEXEX,LEXSP,LEXTND,LEXKEY
. . . . S LEXTND=$TR(LEXNOD,"""","")
. . . . S LEXTKN=$P(LEXTND,",",3)
. . . . S LEXMC=$P(LEXTND,",",4) Q:+LEXMC'>0
. . . . S LEXEX=$P($P(LEXNOD,",",5),")",1) Q:'$L(LEXEX)
. . . . S LEXSP=$P($P(LEXTND,",",6),")",1)
. . . . S LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)
. . . . S LEXND=LEXND_","_LEXMC_","_$$QQ(LEXEX)
. . . . S:$L(LEXSP) LEXND=LEXND_","_$$QQ(LEXSP)
. . . . S LEXND=LEXND_")",LEXKEY=$TR(LEXND,"""","")
. . . . S @LEXND="" S:'$D(^TMP("LEXRXAWRDK",$J,LEXKEY)) LEXNDS=+($G(LEXNDS))+1
. . . . S ^TMP("LEXAWRDK",$J,LEXKEY)="",^TMP("LEXRXREP",$J,"AWRD")=+($G(LEXNDS))
. ; Repeat for all characters
K ^TMP("LEXRXAWRDU",$J),^TMP("LEXRXAWRDK",$J) S ^TMP("LEXRXERR",$J,"AWRD",0)=+($G(^TMP("LEXRXERR",$J,"AWRD",0)))
S LEXFI="757.01",LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
S:+LEX0P3>0 $P(^LEX(757.01,0),"^",3)=LEX0P3 S:+LEX0P4>0 $P(^LEX(757.01,0),"^",4)=LEX0P4
Q
;
; Miscellaneous
SCT(X) ; String Count (exact string)
S:$D(ZTQUEUED) ZTREQ="@" N LEX,LEXA,LEXE,LEXIT,LEXM,LEXN,LEXO,LEXOUT,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTKN
S LEXS=$$UP^XLFSTR($G(X)) Q:'$L(LEXS) 0 S LEXRT="" S:$D(^LEX(757.01,"AWRD")) LEXRT="^LEX(757.01,""AWRD"","
S:$D(^TMP("LEXRXAWRD",$J)) LEXRT="^TMP(""LEXRXAWRD"","_$J_"," Q:'$L(LEXRT) 0 S (LEXA,LEXN,LEXT)=0
S:$L(LEXS)>1 LEXO=$E(LEXS,1,($L(LEXS)-1))_$C(($A($E(LEXS,$L(LEXS)))-1))_"~"
S:$L(LEXS)=1 LEXO=$C(($A(LEXS)-1))_"~" S LEXIT=0
F S LEXO=$O(@(LEXRT_""""_LEXO_""")")) D Q:LEXIT>0
. S:'$L(LEXO) LEXIT=1 S:$E(LEXO,1,$L(LEXS))'=LEXS LEXIT=1
. Q:LEXIT>0 N LEXM S LEXM=0 F S LEXM=$O(@(LEXRT_""""_LEXO_""","_LEXM_")")) Q:+LEXM'>0 D
. . N LEXE,LEXRT2 S LEXE=0,LEXRT2=LEXRT_""""_LEXO_""","_LEXM_","
. . F S LEXE=$O(@(LEXRT2_LEXE_")")) Q:+LEXE'>0 S LEXT=LEXT+1,LEXA=LEXA+1
I $TR(LEXS,".","")?1N.N,$L(LEXS,".")'>2 I +LEXS=LEXS D
. N LEXFC S LEXFC=$E(LEXS,1) S:$E(LEXS,1)?1N LEXO=LEXS-.000000001
. S:$E(LEXS,1)="." LEXO=.000000001 S LEXIT=0
. F S LEXO=$O(@(LEXRT_+LEXO_")")) D Q:LEXIT>0 Q:'$L(LEXO)
. . S:LEXFC?1N&($E(LEXO,1)'?1N) LEXIT=1
. . S:LEXFC?1P&($E(LEXO,1)'?1P) LEXIT=1 Q:LEXIT>0
. . Q:'$L(LEXO) Q:$E(LEXO,1,$L(LEXS))'=LEXS N LEXM S LEXM=0
. . F S LEXM=$O(@(LEXRT_+LEXO_","_LEXM_")")) Q:+LEXM'>0 D
. . . N LEXE,LEXRT2 S LEXE=0,LEXRT2=LEXRT_+LEXO_","_LEXM_","
. . . F S LEXE=$O(@(LEXRT2_LEXE_")")) Q:+LEXE'>0 S LEXT=LEXT+1,LEXN=LEXN+1
S X=LEXT
Q X
QQ(X) ; Set Quotes
N LEXS,LEXT S LEXS=$TR($G(X),"""",""),LEXT=0
S:$TR(LEXS,".","")'?1N.N LEXT=1 I $TR(LEXS,".","")?1N.N S:$L(+LEXS)'=$L(LEXS) LEXT=1
S X=LEXS S:LEXT=1 X=""""_LEXS_""""
Q X
CHRS ; Get Characters - Sets LEXCHRS
N LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK K LEXCHRS S LEXRT1="^LEX(757.01,""AWRD"","
S LEXRT2="^TMP(""LEXRXAWRD"","_$J_"," F LEXRT=LEXRT1,LEXRT2 D
. N LEXTK S LEXTK="#" F S LEXTK=$O(@(LEXRT_""""_LEXTK_""")")) Q:'$L(LEXTK) D
. . N LEXCHR S LEXCHR=$E($TR(LEXTK," ",""),1) S LEXTK=$E(LEXTK,1)_"~"
. . S:$L(LEXCHR) LEXCHRS(LEXCHR)=""
Q
CLR ; Clear
Q
KGBL ; Kill Global Arrays
K:'$D(LEXTEST) ^TMP("LEXRXASL",$J),^TMP("LEXRXASLU",$J),^TMP("LEXRXAWRD",$J),^TMP("LEXRXAWRDU",$J)
K:'$D(LEXTEST) ^TMP("LEXRXPRO",$J),^TMP("LEXRXERR",$J),^TMP("LEXRXREP",$J),^TMP("LEXTKN",$J),^TMP("LEXRXAWRDK",$J)
K:+($G(LEXRXTMP))'>0&('$D(LEXTEST)) ^TMP("LEXRX",$J)
Q
ERRS ; Display Errors
N LEXEC,LEXEN,LEXET,LEXIX,LEXTC,LEXTT S (LEXTC,LEXTT)=0 F LEXIX="AWRD","ASL" D
. N LEXEN,LEXET,LEXEC S (LEXEN,LEXET,LEXEC)=0
. F S LEXEN=$O(^TMP("LEXRXERR",$J,LEXIX,LEXEN)) Q:+LEXEN'>0 D
. . S LEXET=LEXET+$G(^TMP("LEXRXERR",$J,LEXIX,LEXEN))
. S:+LEXET>0 LEXTC=LEXTC+1 Q:+LEXET'>0 W !,"Errors in Index """,LEXIX,"""",!
. S LEXEN=0 F S LEXEN=$O(^TMP("LEXRXERR",$J,LEXIX,LEXEN)) Q:+LEXEN'>0 D
. . Q:$G(^TMP("LEXRXERR",$J,LEXIX,LEXEN))'>0 S LEXEC=LEXEC+1
. . W !,$J($G(^TMP("LEXRXERR",$J,LEXIX,LEXEN)),10)," "
. . W $G(^TMP("LEXRXERR",$J,LEXIX,LEXEN,0)) S LEXTT=LEXTT+$G(^TMP("LEXRXERR",$J,LEXIX,LEXEN))
. W:LEXEC>1&(LEXET>0) !,$J(LEXET,10)," """,LEXIX,""" Index Total"
W:LEXTC>1&(LEXTT>0) !,$J(LEXTT,10)," Total Errors"
Q
LEX ; Lexicon Counts
N LEXSTR,LEXSTN,LEXTKN,LEXTKT,LEXNN,LEXNC,LEXTNT
S LEXTKN="" F S LEXTKN=$O(^LEX(757.01,"AWRD",LEXTKN)) Q:'$L(LEXTKN) S LEXTKT=+($G(LEXTKT))+1
S LEXNN="^LEX(757.01,""AWRD"")",LEXNC="^LEX(757.01,""AWRD"","
F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) S LEXTNT=+($G(LEXTNT))+1
S LEXTKN="" F S LEXTKN=$O(^LEX(757.01,"ASL",LEXTKN)) Q:'$L(LEXTKN) S LEXSTR=+($G(LEXSTR))+1
S LEXNN="^LEX(757.01,""ASL"")",LEXNC="^LEX(757.01,""ASL"","
F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) S LEXSTN=+($G(LEXSTN))+1
W:(+($G(LEXTKT))+($G(LEXTNT))+($G(LEXSTR))>0) !
W:'$D(ZTQUEUED)&(+($G(LEXTKT))>0) !,"AWRD Words: ",$J(+($G(LEXTKT)),7)
w:'$D(ZTQUEUED)&(+($G(LEXTNT))>0) !,"AWRD Nodes: ",$J(+($G(LEXTNT)),7)
W:'$D(ZTQUEUED)&(+($G(LEXSTR))>0) !,"ASL Strings: ",$J(+($G(LEXSTR)),7)
Q
DEA(X) ; Expression/Concept Deactive
N LEXEACT,LEXNAM,LEXTEST,ZTQUEUED,LEXA,LEXEA,LEXEIEN,LEXMA,LEXMIEN,LEXN S LEXEIEN=+($G(X)),LEXN=$G(^LEX(757.01,+LEXEIEN,1))
S LEXEA=+($P(LEXN,"^",5)),LEXMIEN=+LEXN,LEXN=+($P(LEXN,"^",2)) Q:LEXN=1&(LEXEA>0) 1 Q:LEXN=1&(LEXEA'>0) 0
S LEXMIEN=+($G(^LEX(757,+LEXMIEN,0))),LEXMA=+($P($G(^LEX(757.01,+LEXMIEN,1)),"^",5)) Q:(LEXEA+LEXMA)>0 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXC3 14692 printed Apr 09, 2024@21:13:05 Page 2
LEXRXC3 ;ISL/KER - Re-Index 757.01 AWRD ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**81,86,103**;Sep 23, 1996;Build 2
+2 ;
+3 ;
+4 ; Global Variables
+5 ; ^TMP("LEXRXASL") SACC 2.3.2.5.1
+6 ; ^TMP("LEXRXASLU") SACC 2.3.2.5.1
+7 ; ^TMP("LEXRXAWRD") SACC 2.3.2.5.1
+8 ; ^TMP("LEXRXERR") SACC 2.3.2.5.1
+9 ; ^TMP("LEXRXPRO") SACC 2.3.2.5.1
+10 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+11 ;
+12 ; External References
+13 ; $$FMDIFF^XLFDT ICR 10103
+14 ; $$NOW^XLFDT ICR 10103
+15 ; $$UP^XLFSTR ICR 10104
+16 ;
+17 ; Local Variables NEWed or KILLed Elsewhere
+18 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+19 ; LEXTEST Test variable NEWed/KILLed by Developer
+20 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+21 ;
+22 ; The AWRD cross-references is used to create the ASL
+23 ; cross-reference, hence the AWRD cross-reference must
+24 ; be repaired/re-indexed before ASL.
+25 ;
+26 QUIT
EN ; Main Entry Point
R75701 ; Repair file 757.01
+1 DO KGBL
DO RAWRD
DO RASL^LEXRXC4
DO KGBL
+2 if '$DATA(ZTQUEUED)
DO LEX
+3 QUIT
+4 ;
RAWRD ; Index ^LEX(757.01,"AWRD",WORD,MC,EXP)
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
NEW DA,DIK,LEX0P3,LEX0P4,LEXBEG,LEXCHR,LEXCHRS,LEXCTL,LEXDATA,LEXDIF,LEXE,LEXELP,LEXEND,LEXERR,LEXEX,LEXEXCL,LEXEXP
+2 NEW LEXFI,LEXFUL,LEXHI,LEXI,LEXIDX,LEXIDXT,LEXIT,LEXL,LEXLO,LEXLTKN,LEXM,LEXMC,LEXMCE,LEXMCEI,LEXMCI,LEXND,LEXNDS
+3 NEW LEXNOD,LEXRI,LEXRT,LEXRT1,LEXRT2,LEXRXTMP,LEXS,LEXS1,LEXS2,LEXS3,LEXS4,LEXSI,LEXSP,LEXSTR,LEXT,LEXTC
+4 NEW LEXTK,LEXTKC,LEXTKN,LEXTMP,LEXTNG,LEXTTKN,LEXW,LEXWDS,X
SET LEXRXTMP=$DATA(^TMP("LEXRX",$JOB))
+5 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""AWRD""")
+6 if LEXTC=1
QUIT
SET (LEX0P3,LEX0P4)=0
SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXFI=757.01
+7 KILL ^TMP("LEXRXPRO",$JOB,"AWRD"),^TMP("LEXRXERR",$JOB,"AWRD"),^TMP("LEXRXAWRD",$JOB),^TMP("LEXRXAWRDK",$JOB),^TMP("LEXRXAWRDU",$JOB)
+8 SET LEXIDX="AWRD"
SET LEXIDXT="^LEX(757.01,""AWRD"",WORD,MC,EXP)"
+9 ; Build
+10 NEW LEXEX
SET LEXEX=0
FOR
SET LEXEX=$ORDER(^LEX(757.01,LEXEX))
if +LEXEX'>0
QUIT
Begin DoDot:1
+11 NEW X,LEXEXP,LEXIDX,LEXMC,LEXMCI,LEXMCEI,LEXRI,LEXSI,LEXTKN,LEXTKC,LEXTMP,LEXDEA,LEXTTYP
+12 SET LEXDEA=$$DEA(+LEXEX)
if LEXDEA>0
QUIT
SET LEXTTYP=$PIECE($GET(^LEX(757.01,LEXEX,1)),"^",2)
if LEXTTYP=8
QUIT
+13 SET ^TMP("LEXRXPRO",$JOB,"AWRD","BUILD","IEN")=+LEXEX
SET LEX0P3=+LEXEX
SET LEX0P4=LEX0P4+1
+14 SET LEXEXP=$$UP^XLFSTR($GET(^LEX(757.01,LEXEX,0)))
if '$LENGTH(LEXEXP)
QUIT
+15 SET LEXMCI=$PIECE($GET(^LEX(757.01,LEXEX,1)),"^",1)
if +LEXMCI'>0
QUIT
+16 SET LEXMCEI=$PIECE($GET(^LEX(757,LEXMCI,0)),"^",1)
if +LEXMCEI'>0
QUIT
+17 ; Words (main)
+18 KILL ^TMP("LEXTKN",$JOB)
SET LEXIDX=""
SET X=LEXEXP
DO PTX^LEXTOKN
+19 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
Begin DoDot:2
+20 SET LEXTKN=""
SET LEXTKC=0
+21 FOR
SET LEXTKC=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC))
if +LEXTKC'>0
QUIT
Begin DoDot:3
+22 NEW LEXND,LEXTKN
SET LEXTKN=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC,""))
if '$LENGTH(LEXTKN)
QUIT
+23 IF +($GET(LEXEACT))>0
KILL ^LEX(757.01,"AWRD",LEXTKN,+($GET(LEXMCEI)),+($GET(LEXEX)))
QUIT
+24 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)_","_LEXMCEI_")"
IF '$DATA(@LEXND)
Begin DoDot:4
+25 NEW LEXND
SET LEXND="^LEX(757.01,"_+LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+26 SET LEXND="^LEX(757.01,"_+LEXMCEI_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+27 SET LEXERR=+($GET(LEXERR))+1
+28 SET ^TMP("LEXRXERR",$JOB,"AWRD",0)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",0))+1
+29 SET ^TMP("LEXRXERR",$JOB,"AWRD",1)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",1))+1
+30 SET ^TMP("LEXRXERR",$JOB,"AWRD",1,0)="Missing word in ""AWRD"" index"
+31 SET LEXND="^TMP(""LEXRXERR"","_$JOB_",""AWRD"",1,""ERR"","_$$QQ(LEXTKN)_","_LEXMCEI_","_LEXEX_")"
SET @LEXND=""
+32 SET ^TMP("LEXRXPRO",$JOB,"AWRD","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"AWRD","ERR")))+1
End DoDot:4
+33 IF $LENGTH($GET(LEXTKN))
IF +($GET(LEXMCI))>0
IF +($GET(LEXMCEI))>0
IF +($GET(LEXEX))>0
Begin DoDot:4
+34 NEW LEXND
SET LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+35 SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXMCEI_")"
if $DATA(@LEXND)
QUIT
+36 SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXMCEI_","_LEXEX_")"
SET @LEXND=""
End DoDot:4
End DoDot:3
End DoDot:2
+37 KILL ^TMP("LEXTKN",$JOB)
+38 ; Supplemental Words
+39 SET LEXSI=0
FOR
SET LEXSI=$ORDER(^LEX(757.01,LEXEX,5,LEXSI))
if +LEXSI'>0
QUIT
Begin DoDot:2
+40 NEW LEXTKN
SET LEXTKN=$$UP^XLFSTR($GET(^LEX(757.01,LEXEX,5,LEXSI,0)))
if '$LENGTH(LEXTKN)
QUIT
+41 IF +($GET(LEXEACT))>0
KILL ^LEX(757.01,"AWRD",LEXTKN,+($GET(LEXEX)),+($GET(LEXMCEI)),+($GET(LEXSI)))
QUIT
+42 NEW LEXND
SET LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+43 IF $DATA(LEXUNQ)
SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXEX_")"
if $DATA(@LEXND)
QUIT
+44 SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_LEXSI_")"
SET @LEXND=""
+45 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_LEXSI_")"
IF '$DATA(@LEXND)
Begin DoDot:3
+46 NEW LEXND,LEXUNQ
SET LEXERR=+($GET(LEXERR))+1
+47 SET ^TMP("LEXRXERR",$JOB,"AWRD",0)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",0))+1
+48 SET ^TMP("LEXRXERR",$JOB,"AWRD",2)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",2))+1
+49 SET ^TMP("LEXRXERR",$JOB,"AWRD",2,0)="Missing supplemental word in ""AWRD"" index"
+50 SET LEXND="^TMP(""LEXRXERR"","_$JOB_",""AWRD"",2,""ERR"","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_+LEXSI_")"
SET @LEXND=""
+51 SET ^TMP("LEXRXPRO",$JOB,"AWRD","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"AWRD","ERR")))+1
End DoDot:3
End DoDot:2
+52 ; Linked Words
+53 IF $DATA(^LEX(757.05,"AEXP",LEXEX))
Begin DoDot:2
+54 NEW LEXRI
SET LEXRI=0
+55 FOR
SET LEXRI=$ORDER(^LEX(757.05,"AEXP",LEXEX,LEXRI))
if +LEXRI=0
QUIT
Begin DoDot:3
+56 NEW LEXTKN,LEXMC,LEXND
SET LEXTKN=$$UP^XLFSTR($PIECE(^LEX(757.05,LEXRI,0),U,1))
if '$LENGTH(LEXTKN)
QUIT
+57 IF +($GET(LEXEACT))>0
KILL ^LEX(757.01,"AWRD",LEXTKN,+($GET(LEXEX)),"LINKED")
QUIT
+58 SET LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+59 SET LEXMC=$PIECE($GET(^LEX(757.01,LEXEX,1)),U,1)
if +LEXMC'>0
QUIT
+60 IF $DATA(LEXUNQ)
SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_LEXEX_")"
if $DATA(@LEXND)
QUIT
+61 SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_LEXEX_",""LINKED"")"
SET @LEXND=""
+62 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)_","_LEXEX_",""LINKED"")"
IF '$DATA(@LEXND)
Begin DoDot:4
+63 NEW LEXND,LEXUNQ
SET LEXERR=+($GET(LEXERR))+1
+64 SET ^TMP("LEXRXERR",$JOB,"AWRD",0)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",0))+1
+65 SET ^TMP("LEXRXERR",$JOB,"AWRD",3)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",3))+1
+66 SET ^TMP("LEXRXERR",$JOB,"AWRD",3,0)="Missing linked word in ""AWRD"" index"
+67 SET LEXND="^TMP(""LEXRXERR"","_$JOB_",""AWRD"",3,""ERR"","_$$QQ(LEXTKN)_","_+LEXEX_",""LINKED"")"
SET @LEXND=""
+68 SET ^TMP("LEXRXPRO",$JOB,"AWRD","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"AWRD","ERR")))+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+69 ; Replace
+70 NEW LEXCHR,LEXCHRS,LEXCTL,LEXDATA,LEXIT,LEXNOD,LEXRT,LEXRT1,LEXRT2
DO CHRS
+71 SET LEXIT=0
SET LEXCHR=""
FOR
SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))
if '$LENGTH(LEXCHR)
QUIT
Begin DoDot:1
+72 if $LENGTH(LEXCHR)
SET ^TMP("LEXRXPRO",$JOB,"AWRD","REPLACE","CHR")=LEXCHR
+73 NEW LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
+74 SET (LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5)=""
SET LEXIT=0
+75 SET LEXTK1=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXTK2=LEXCHR
SET LEXTK3=LEXCHR_" "
+76 if LEXCHR?1N
SET LEXTK4=LEXCHR-.00000001
if LEXCHR="."
SET LEXTK5=.00000001
+77 FOR LEXTK=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5
Begin DoDot:2
+78 if '$LENGTH(LEXTK)
QUIT
NEW LEXIT
SET LEXIT=0
SET (LEXLTKN,LEXTTKN)=LEXTK
+79 FOR
SET LEXLTKN=$ORDER(^LEX(757.01,"AWRD",LEXLTKN))
Begin DoDot:3
+80 if $LENGTH(LEXLTKN)
SET ^TMP("LEXRXPRO",$JOB,"AWRD","REPLACE","WORD")=LEXLTKN
+81 if '$LENGTH(LEXLTKN)
SET LEXIT=1
+82 if LEXCHR'?1N&($EXTRACT(LEXLTKN,1)'=LEXCHR)
SET LEXIT=1
+83 if LEXCHR?1N&($EXTRACT(LEXLTKN,1)'?1N)
SET LEXIT=1
+84 if LEXIT>0
QUIT
+85 NEW LEXND
+86 IF $LENGTH(LEXLTKN)
if $DATA(^TMP("LEXRXAWRDU",$JOB,LEXLTKN))
QUIT
+87 if $LENGTH(LEXLTKN)
SET ^TMP("LEXRXAWRDU",$JOB,LEXLTKN)=""
+88 NEW LEXDATA,LEXND
+89 IF $DATA(LEXFUL)
Begin DoDot:4
+90 NEW LEXNOD,LEXCTL,LEXIT,LEXND
SET LEXIT=0
+91 SET LEXNOD="^LEX(757.01,""AWRD"","""_LEXLTKN_""")"
+92 SET LEXCTL="^LEX(757.01,""AWRD"","""_LEXLTKN_""","
+93 FOR
SET LEXNOD=$QUERY(@LEXNOD)
Begin DoDot:5
+94 if '$LENGTH(LEXNOD)
SET LEXIT=1
if LEXNOD'[LEXCTL
SET LEXIT=1
+95 if LEXIT>0
QUIT
NEW LEXFUL
End DoDot:5
if LEXIT>0
QUIT
End DoDot:4
+96 ; Error: Word in LEX and not in TMP
+97 SET LEXND="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXLTKN)_")"
+98 IF '$DATA(@LEXND)
Begin DoDot:4
+99 NEW LEXND
SET LEXERR=+($GET(LEXERR))+1
+100 SET ^TMP("LEXRXERR",$JOB,"AWRD",0)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",0))+1
+101 SET ^TMP("LEXRXERR",$JOB,"AWRD",7)=$GET(^TMP("LEXRXERR",$JOB,"AWRD",7))+1
+102 SET ^TMP("LEXRXERR",$JOB,"AWRD",7,0)="Invalid word found in ""AWRD"" index"
+103 SET LEXND="^TMP(""LEXRXERR"","_$JOB_",""AWRD"",7,""ERR"","_$$QQ(LEXLTKN)_")"
SET @LEXND=""
+104 SET ^TMP("LEXRXPRO",$JOB,"AWRD","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"AWRD","ERR")))+1
End DoDot:4
+105 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXLTKN)_")"
KILL @LEXND
End DoDot:3
if LEXIT>0
QUIT
+106 SET LEXIT=0
FOR
SET LEXTTKN=$ORDER(^TMP("LEXRXAWRD",$JOB,LEXTTKN))
Begin DoDot:3
+107 if '$LENGTH(LEXTTKN)
SET LEXIT=1
+108 if LEXCHR'?1N&($EXTRACT(LEXTTKN,1)'=LEXCHR)
SET LEXIT=1
+109 if LEXCHR?1N&($EXTRACT(LEXTTKN,1)'?1N)
SET LEXIT=1
+110 if LEXIT>0
QUIT
+111 NEW LEXND,LEXNOD,LEXCTL,LEXKEY
+112 SET LEXNOD="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTTKN)_")"
+113 SET LEXCTL="^TMP(""LEXRXAWRD"","_$JOB_","_$$QQ(LEXTTKN)_","
+114 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:4
+115 ; Copy Index from ^TMP to ^LEX
+116 ; ^TMP("LEXRXAWRD",$J,WORD,MCIEN,EXIEN,SPIEN)
+117 ; ^LEX(757.01,"AWRD",WORD,MCIEN,EXIEN,SPIEN)
+118 NEW LEXND,LEXTKN,LEXMC,LEXEX,LEXSP,LEXTND,LEXKEY
+119 SET LEXTND=$TRANSLATE(LEXNOD,"""","")
+120 SET LEXTKN=$PIECE(LEXTND,",",3)
+121 SET LEXMC=$PIECE(LEXTND,",",4)
if +LEXMC'>0
QUIT
+122 SET LEXEX=$PIECE($PIECE(LEXNOD,",",5),")",1)
if '$LENGTH(LEXEX)
QUIT
+123 SET LEXSP=$PIECE($PIECE(LEXTND,",",6),")",1)
+124 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)
+125 SET LEXND=LEXND_","_LEXMC_","_$$QQ(LEXEX)
+126 if $LENGTH(LEXSP)
SET LEXND=LEXND_","_$$QQ(LEXSP)
+127 SET LEXND=LEXND_")"
SET LEXKEY=$TRANSLATE(LEXND,"""","")
+128 SET @LEXND=""
if '$DATA(^TMP("LEXRXAWRDK",$JOB,LEXKEY))
SET LEXNDS=+($GET(LEXNDS))+1
+129 SET ^TMP("LEXAWRDK",$JOB,LEXKEY)=""
SET ^TMP("LEXRXREP",$JOB,"AWRD")=+($GET(LEXNDS))
End DoDot:4
End DoDot:3
if LEXIT>0
QUIT
End DoDot:2
+130 ; Repeat for all characters
End DoDot:1
+131 KILL ^TMP("LEXRXAWRDU",$JOB),^TMP("LEXRXAWRDK",$JOB)
SET ^TMP("LEXRXERR",$JOB,"AWRD",0)=+($GET(^TMP("LEXRXERR",$JOB,"AWRD",0)))
+132 SET LEXFI="757.01"
SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+133 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+134 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+135 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+136 if +LEX0P3>0
SET $PIECE(^LEX(757.01,0),"^",3)=LEX0P3
if +LEX0P4>0
SET $PIECE(^LEX(757.01,0),"^",4)=LEX0P4
+137 QUIT
+138 ;
+139 ; Miscellaneous
SCT(X) ; String Count (exact string)
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
NEW LEX,LEXA,LEXE,LEXIT,LEXM,LEXN,LEXO,LEXOUT,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTKN
+2 SET LEXS=$$UP^XLFSTR($GET(X))
if '$LENGTH(LEXS)
QUIT 0
SET LEXRT=""
if $DATA(^LEX(757.01,"AWRD"))
SET LEXRT="^LEX(757.01,""AWRD"","
+3 if $DATA(^TMP("LEXRXAWRD",$JOB))
SET LEXRT="^TMP(""LEXRXAWRD"","_$JOB_","
if '$LENGTH(LEXRT)
QUIT 0
SET (LEXA,LEXN,LEXT)=0
+4 if $LENGTH(LEXS)>1
SET LEXO=$EXTRACT(LEXS,1,($LENGTH(LEXS)-1))_$CHAR(($ASCII($EXTRACT(LEXS,$LENGTH(LEXS)))-1))_"~"
+5 if $LENGTH(LEXS)=1
SET LEXO=$CHAR(($ASCII(LEXS)-1))_"~"
SET LEXIT=0
+6 FOR
SET LEXO=$ORDER(@(LEXRT_""""_LEXO_""")"))
Begin DoDot:1
+7 if '$LENGTH(LEXO)
SET LEXIT=1
if $EXTRACT(LEXO,1,$LENGTH(LEXS))'=LEXS
SET LEXIT=1
+8 if LEXIT>0
QUIT
NEW LEXM
SET LEXM=0
FOR
SET LEXM=$ORDER(@(LEXRT_""""_LEXO_""","_LEXM_")"))
if +LEXM'>0
QUIT
Begin DoDot:2
+9 NEW LEXE,LEXRT2
SET LEXE=0
SET LEXRT2=LEXRT_""""_LEXO_""","_LEXM_","
+10 FOR
SET LEXE=$ORDER(@(LEXRT2_LEXE_")"))
if +LEXE'>0
QUIT
SET LEXT=LEXT+1
SET LEXA=LEXA+1
End DoDot:2
End DoDot:1
if LEXIT>0
QUIT
+11 IF $TRANSLATE(LEXS,".","")?1N.N
IF $LENGTH(LEXS,".")'>2
IF +LEXS=LEXS
Begin DoDot:1
+12 NEW LEXFC
SET LEXFC=$EXTRACT(LEXS,1)
if $EXTRACT(LEXS,1)?1N
SET LEXO=LEXS-.000000001
+13 if $EXTRACT(LEXS,1)="."
SET LEXO=.000000001
SET LEXIT=0
+14 FOR
SET LEXO=$ORDER(@(LEXRT_+LEXO_")"))
Begin DoDot:2
+15 if LEXFC?1N&($EXTRACT(LEXO,1)'?1N)
SET LEXIT=1
+16 if LEXFC?1P&($EXTRACT(LEXO,1)'?1P)
SET LEXIT=1
if LEXIT>0
QUIT
+17 if '$LENGTH(LEXO)
QUIT
if $EXTRACT(LEXO,1,$LENGTH(LEXS))'=LEXS
QUIT
NEW LEXM
SET LEXM=0
+18 FOR
SET LEXM=$ORDER(@(LEXRT_+LEXO_","_LEXM_")"))
if +LEXM'>0
QUIT
Begin DoDot:3
+19 NEW LEXE,LEXRT2
SET LEXE=0
SET LEXRT2=LEXRT_+LEXO_","_LEXM_","
+20 FOR
SET LEXE=$ORDER(@(LEXRT2_LEXE_")"))
if +LEXE'>0
QUIT
SET LEXT=LEXT+1
SET LEXN=LEXN+1
End DoDot:3
End DoDot:2
if LEXIT>0
QUIT
if '$LENGTH(LEXO)
QUIT
End DoDot:1
+21 SET X=LEXT
+22 QUIT X
QQ(X) ; Set Quotes
+1 NEW LEXS,LEXT
SET LEXS=$TRANSLATE($GET(X),"""","")
SET LEXT=0
+2 if $TRANSLATE(LEXS,".","")'?1N.N
SET LEXT=1
IF $TRANSLATE(LEXS,".","")?1N.N
if $LENGTH(+LEXS)'=$LENGTH(LEXS)
SET LEXT=1
+3 SET X=LEXS
if LEXT=1
SET X=""""_LEXS_""""
+4 QUIT X
CHRS ; Get Characters - Sets LEXCHRS
+1 NEW LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK
KILL LEXCHRS
SET LEXRT1="^LEX(757.01,""AWRD"","
+2 SET LEXRT2="^TMP(""LEXRXAWRD"","_$JOB_","
FOR LEXRT=LEXRT1,LEXRT2
Begin DoDot:1
+3 NEW LEXTK
SET LEXTK="#"
FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
if '$LENGTH(LEXTK)
QUIT
Begin DoDot:2
+4 NEW LEXCHR
SET LEXCHR=$EXTRACT($TRANSLATE(LEXTK," ",""),1)
SET LEXTK=$EXTRACT(LEXTK,1)_"~"
+5 if $LENGTH(LEXCHR)
SET LEXCHRS(LEXCHR)=""
End DoDot:2
End DoDot:1
+6 QUIT
CLR ; Clear
+1 QUIT
KGBL ; Kill Global Arrays
+1 if '$DATA(LEXTEST)
KILL ^TMP("LEXRXASL",$JOB),^TMP("LEXRXASLU",$JOB),^TMP("LEXRXAWRD",$JOB),^TMP("LEXRXAWRDU",$JOB)
+2 if '$DATA(LEXTEST)
KILL ^TMP("LEXRXPRO",$JOB),^TMP("LEXRXERR",$JOB),^TMP("LEXRXREP",$JOB),^TMP("LEXTKN",$JOB),^TMP("LEXRXAWRDK",$JOB)
+3 if +($GET(LEXRXTMP))'>0&('$DATA(LEXTEST))
KILL ^TMP("LEXRX",$JOB)
+4 QUIT
ERRS ; Display Errors
+1 NEW LEXEC,LEXEN,LEXET,LEXIX,LEXTC,LEXTT
SET (LEXTC,LEXTT)=0
FOR LEXIX="AWRD","ASL"
Begin DoDot:1
+2 NEW LEXEN,LEXET,LEXEC
SET (LEXEN,LEXET,LEXEC)=0
+3 FOR
SET LEXEN=$ORDER(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN))
if +LEXEN'>0
QUIT
Begin DoDot:2
+4 SET LEXET=LEXET+$GET(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN))
End DoDot:2
+5 if +LEXET>0
SET LEXTC=LEXTC+1
if +LEXET'>0
QUIT
WRITE !,"Errors in Index """,LEXIX,"""",!
+6 SET LEXEN=0
FOR
SET LEXEN=$ORDER(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN))
if +LEXEN'>0
QUIT
Begin DoDot:2
+7 if $GET(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN))'>0
QUIT
SET LEXEC=LEXEC+1
+8 WRITE !,$JUSTIFY($GET(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN)),10)," "
+9 WRITE $GET(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN,0))
SET LEXTT=LEXTT+$GET(^TMP("LEXRXERR",$JOB,LEXIX,LEXEN))
End DoDot:2
+10 if LEXEC>1&(LEXET>0)
WRITE !,$JUSTIFY(LEXET,10)," """,LEXIX,""" Index Total"
End DoDot:1
+11 if LEXTC>1&(LEXTT>0)
WRITE !,$JUSTIFY(LEXTT,10)," Total Errors"
+12 QUIT
LEX ; Lexicon Counts
+1 NEW LEXSTR,LEXSTN,LEXTKN,LEXTKT,LEXNN,LEXNC,LEXTNT
+2 SET LEXTKN=""
FOR
SET LEXTKN=$ORDER(^LEX(757.01,"AWRD",LEXTKN))
if '$LENGTH(LEXTKN)
QUIT
SET LEXTKT=+($GET(LEXTKT))+1
+3 SET LEXNN="^LEX(757.01,""AWRD"")"
SET LEXNC="^LEX(757.01,""AWRD"","
+4 FOR
SET LEXNN=$QUERY(@LEXNN)
if '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
SET LEXTNT=+($GET(LEXTNT))+1
+5 SET LEXTKN=""
FOR
SET LEXTKN=$ORDER(^LEX(757.01,"ASL",LEXTKN))
if '$LENGTH(LEXTKN)
QUIT
SET LEXSTR=+($GET(LEXSTR))+1
+6 SET LEXNN="^LEX(757.01,""ASL"")"
SET LEXNC="^LEX(757.01,""ASL"","
+7 FOR
SET LEXNN=$QUERY(@LEXNN)
if '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
SET LEXSTN=+($GET(LEXSTN))+1
+8 if (+($GET(LEXTKT))+($GET(LEXTNT))+($GET(LEXSTR))>0)
WRITE !
+9 if '$DATA(ZTQUEUED)&(+($GET(LEXTKT))>0)
WRITE !,"AWRD Words: ",$JUSTIFY(+($GET(LEXTKT)),7)
+10 if '$DATA(ZTQUEUED)&(+($GET(LEXTNT))>0)
WRITE !,"AWRD Nodes: ",$JUSTIFY(+($GET(LEXTNT)),7)
+11 if '$DATA(ZTQUEUED)&(+($GET(LEXSTR))>0)
WRITE !,"ASL Strings: ",$JUSTIFY(+($GET(LEXSTR)),7)
+12 QUIT
DEA(X) ; Expression/Concept Deactive
+1 NEW LEXEACT,LEXNAM,LEXTEST,ZTQUEUED,LEXA,LEXEA,LEXEIEN,LEXMA,LEXMIEN,LEXN
SET LEXEIEN=+($GET(X))
SET LEXN=$GET(^LEX(757.01,+LEXEIEN,1))
+2 SET LEXEA=+($PIECE(LEXN,"^",5))
SET LEXMIEN=+LEXN
SET LEXN=+($PIECE(LEXN,"^",2))
if LEXN=1&(LEXEA>0)
QUIT 1
if LEXN=1&(LEXEA'>0)
QUIT 0
+3 SET LEXMIEN=+($GET(^LEX(757,+LEXMIEN,0)))
SET LEXMA=+($PIECE($GET(^LEX(757.01,+LEXMIEN,1)),"^",5))
if (LEXEA+LEXMA)>0
QUIT 1
+4 QUIT 0
