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