LEXXGP1 ;ISL/KER - Global Post-Install (Repair Expressions) ;05/23/2017
;;2.0;LEXICON UTILITY;**80,86,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^TMP("LEXASL") SACC 2.3.2.5.1
; ^TMP("LEXASLU") SACC 2.3.2.5.1
; ^TMP("LEXAWRD") SACC 2.3.2.5.1
; ^TMP("LEXAWRDK") SACC 2.3.2.5.1
; ^TMP("LEXAWRDU") SACC 2.3.2.5.1
; ^TMP("LEXSUB") SACC 2.3.2.5.1
; ^TMP("LEXTKN") SACC 2.3.2.5.1
; ^TMP("LEXXGPDAT") SACC 2.3.2.5.1
; ^TMP("LEXXGPMSG") SACC 2.3.2.5.1
; ^TMP("LEXXGPRPT") SACC 2.3.2.5.1
; ^TMP("LEXXGPTIM") SACC 2.3.2.5.1
;
; External References
; HOME^%ZIS ICR 10086
; $$S^%ZTLOAD ICR 10063
; ^%ZTLOAD ICR 10063
; $$FMDIFF^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
; MES^XPDUTL ICR 10141
;
; Local Variables NEWed or KILLed Elsewhere
;
; LEXMAIL Set and Killed by the developer, used to
; report the timing of the task and
; send to the user by MailMan message
;
; LEXHOME Set and Killed by the developer in the
; post-install, used to send the timing
; message to G.LEXINS@FO-SLC.DOMAIN.EXT
; (see entry point POST2)
;
; FileMan LEXXGP
;
; Lexicon Lexicon
; Re-Index Time Available Time Available
; -------------- ---- --------- ---- ---------
; Build 'AWRD' 33.5 No 8.5 Yes
; Replace 'AWRD' -- -- 2.5 No
; Build 'ASL' 8.5 No 6.5 Yes
; Replace 'ASL' -- -- 0.5 No
; Build 'ASUB' 15.5 No 11.5 Yes
; Replace 'ASUB' -- -- 1.5 No
;
; Lexicon
; Unavailable: 57.5 4.5 Minutes
;
Q
EN ; Interactive Entry Point
D ALL
Q
POST ; Entry Point from Post-Install
N LEXMAIL,LEXHOME S LEXMAIL="" D POST3
Q
POST2 ; Entry Point from Post-Install (home)
N LEXMAIL,LEXHOME S LEXHOME="",LEXMAIL="" D POST3
Q
POST3 ; Called by POST/POST2 starts task
N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,LEXTN
S ZTRTN="ALL^LEXXGP1"
S (LEXTN,ZTDESC)="Repair indexes in files #757.01/757.21"
I $D(LEXMAIL) S LEXMAIL=1,ZTSAVE("LEXMAIL")=""
I $D(LEXHOME) S LEXHOME=1,ZTSAVE("LEXHOME")=""
S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS I $D(LEXLOUD) D
. S LEXT=" "_$G(LEXTN)_" tasked"
. S:+($G(ZTSK))>0 LEXT=LEXT_" (#"_+($G(ZTSK))_")"
. D MES^XPDUTL(LEXT)
Q
ALL ; Index all Lookup Indexes
S:$D(ZTQUEUED) ZTREQ="@"
K ^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXAWRDK",$J),^TMP("LEXASL",$J),^TMP("LEXASLU",$J),^TMP("LEXSUB",$J)
K ^TMP("LEXXGPTIM",$J) N DIC,DTOUT,DUOUT,LEX,LEX1,LEX2,LEX3,LEX4,LEXB,LEXBD,LEXBEG,LEXBEGD,LEXBEGT,LEXBT,LEXC,LEXCHR
N LEXCHRS,LEXCMD,LEXCOM,LEXCTL,LEXD,LEXDF,LEXE,LEXEL,LEXELP,LEXELPT,LEXEND,LEXENDD,LEXENDT,LEXET,LEXEX,LEXEXP,LEXF
N LEXFC,LEXFIR,LEXFUL,LEXHDR,LEXI,LEXID,LEXIDS,LEXIDX,LEXINAM,LEXIT,LEXJ,LEXLAST,LEXLN,LEXLOOK,LEXLOUD,LEXLWRD,LEXM
N LEXMC,LEXMCEI,LEXMCI,LEXN,LEXNAM,LEXNEW,LEXNM,LEXNOD,LEXO,LEXO1,LEXO2,LEXP,LEXPDT,LEXPRE,LEXRI,LEXRT,LEXRT1,LEXRT2
N LEXS,LEXSI,LEXSUB,LEXT,LEXTDAT,LEXTEXP,LEXTK,LEXTKC,LEXTKN,LEXTMP,LEXTWRD,LEXTX,LEXTXT,LEXV,LEXX,X,XCNP,XMDUZ
N XMSCR,XMSUB,XMTEXT,XMY,XMZ,Y S:'$D(LEXQUIT) LEXQUIT="ALL" N LEXTXT,LEXFUL S LEXFUL="" D EXP,SUB^LEXXGP3
I '$D(ZTQUEUED) D
. N LEXTXT S LEXTXT=$$FMTT Q:'$L(LEXTXT) W !," ",LEXTXT
I $G(LEXQUIT)="ALL" D
. D:$D(LEXMAIL) XM^LEXXGP3 K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME I '$D(LEXTEST) D
. . K ^TMP("LEXASL",$J),^TMP("LEXASLU",$J),^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXAWRDK",$J)
. . K ^TMP("LEXSUB",$J),^TMP("LEXTKN",$J),^TMP("LEXXGPDAT",$J),^TMP("LEXXGPTIM",$J),^TMP("LEXXGPRPT",$J)
. . K:'$D(LEXMAIL) ^TMP("LEXXGPMSG",$J) N ZTQUEUED,LEXTEST
Q
;
EXP ; Expression file Main Indexes AWRD/ASL
N LEXBEG,LEXBEGD,LEXBEGT,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT
N LEXTMP,LEXTXT S LEXTXT="Expression Indexes"
S:'$D(LEXQUIT) LEXQUIT="EXP" K ^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXAWRDK",$J)
K ^TMP("LEXASL",$J),^TMP("LEXASLU",$J) S LEXBEG=$$BEG
D AWRDB,ASLB^LEXXGP2 H 1 S LEXEND=$$END D SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
S LEXELP=$$ELP(LEXBEG,LEXEND),LEXBEGD=$$ED(LEXBEG)
S LEXBEGT=$$ET(LEXBEG),LEXENDT=$$ET(LEXEND),LEXDF=$$DF(LEXBEG)
S LEXTXT=$G(LEXTXT)_$J(" ",(35-$L($G(LEXTXT))))
S LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
S LEXTXT=" "_LEXTXT W:'$D(ZTQUEUED) !,LEXTXT
I $G(LEXQUIT)="EXP" D
. D:$D(LEXMAIL) XM^LEXXGP3 K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME I '$D(LEXTEST) D
. . K ^TMP("LEXASL",$J),^TMP("LEXASLU",$J),^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXAWRDK",$J)
. . K ^TMP("LEXTKN",$J),^TMP("LEXXGPDAT",$J),^TMP("LEXXGPTIM",$J),^TMP("LEXXGPRPT",$J)
. . K:'$D(LEXMAIL) ^TMP("LEXXGPMSG",$J) N ZTQUEUED,LEXTEST
Q
AWRDB ; AWRD Word Index Build 8.5 minutes
; Create the AWRD Index in the ^TMP global
N LEX0P3,LEX0P4,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXELP,LEXEND,LEXENDT,LEXEX
N LEXEXP,LEXIDX,LEXMC,LEXMCEI,LEXMCI,LEXND,LEXRI,LEXSI,LEXTKC,LEXTKN,LEXTMP,LEXTXT
K ^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXAWRDK",$J) S:'$D(LEXQUIT) LEXQUIT="AWRDB"
S LEXBEG=$$BEG,LEXEX=0,LEXTXT="Build 'AWRD' Word Index"
I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
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 LEX0P3=+LEXEX,LEX0P4=+($G(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 LEXDEA=$$DEA(+LEXEX) Q:LEXDEA>0
. S LEXTTYP=$P($G(^LEX(757.01,+LEXEX,1)),"^",2) Q:LEXTTYP=8
. 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 $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(""LEXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXMCEI_")" Q:$D(@LEXND)
. . . . S LEXND="^TMP(""LEXAWRD"","_$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 LEXND,LEXTKN S LEXTKN=$$UP^XLFSTR($G(^LEX(757.01,LEXEX,5,LEXSI,0))) Q:'$L(LEXTKN)
. . S LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")" Q:$D(@LEXND)
. . I $D(LEXUNQ) S LEXND="^TMP(""LEXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXEX_")" Q:$D(@LEXND)
. . S LEXND="^TMP(""LEXAWRD"","_$J_","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_LEXSI_")"
. . S @LEXND="" N LEXUNQ
. ; 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)
. . . 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(""LEXAWRD"","_$J_","_$$QQ(LEXTKN)_","_LEXEX_")" Q:$D(@LEXND)
. . . S LEXND="^TMP(""LEXAWRD"","_$J_","_$$QQ(LEXTKN)_","_LEXEX_",""LINKED"")"
. . . S @LEXND="" N LEXUNQ
K ^TMP("LEXTKN",$J) H 1 S LEXEND=$$END D SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
S LEXELP=$$ELP(LEXBEG,LEXEND),LEXBEGD=$$ED(LEXBEG)
S LEXBEGT=$$ET(LEXBEG),LEXENDT=$$ET(LEXEND),LEXDF=$$DF(LEXBEG)
S LEXTXT=$G(LEXTXT)_$J(" ",(35-$L($G(LEXTXT))))
S LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
S LEXTXT=" "_LEXTXT W:'$D(ZTQUEUED) !,LEXTXT
D AWRDR I $G(LEXQUIT)="AWRDB" D
. D:$D(LEXMAIL) XM^LEXXGP3 I '$D(LEXTEST) D
. . K ^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXAWRDK",$J),^TMP("LEXTKN",$J),^TMP("LEXXGPDAT",$J)
. . K ^TMP("LEXXGPTIM",$J),^TMP("LEXXGPRPT",$J) N ZTQUEUED,LEXTEST
Q
AWRDR ; AWRD Word Index Replace 2.5 minutes
N LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXCOM,LEXCTL,LEXDATA
N LEXDF,LEXELP,LEXEND,LEXENDT,LEXEX,LEXIT,LEXLTKN,LEXMC,LEXND,LEXNOD,LEXSP,LEXTK
N LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTKN,LEXTTKN,LEXTXT S (LEX1,LEX2,LEX3)=0
Q:'$D(LEXQUIT) S LEXBEG=$$BEG,LEXTXT="Replace 'AWRD' Word Index"
I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
K LEXCHRS D CHRS
K ^TMP("LEXAWRDK",$J),^TMP("LEXAWRDU",$J)
S LEXIT=0,LEXCHR="" F S LEXCHR=$O(LEXCHRS(LEXCHR)) Q:'$L(LEXCHR) D
. N LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
. ; For words beginning with a character
. 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) 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
. . . ; Delete words from the ^LEX global
. . . I $L(LEXLTKN) Q:$D(^TMP("LEXAWRDU",$J,LEXLTKN))
. . . S:$L(LEXLTKN) ^TMP("LEXAWRDU",$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 S LEX2=LEX2+1
. . . S LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXLTKN)_")"
. . . K @LEXND S LEX1=LEX1+1
. . S LEXIT=0 F S LEXTTKN=$O(^TMP("LEXAWRD",$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(""LEXAWRD"","_$J_","_$$QQ(LEXTTKN)_")"
. . . S LEXCTL="^TMP(""LEXAWRD"","_$J_","_$$QQ(LEXTTKN)_","
. . . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . . ; Copy Index from ^TMP to ^LEX
. . . . ; ^TMP("LEXAWRD",$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("LEXAWRDK",$J,LEXKEY)) LEX3=LEX3+1
. . . . S ^TMP("LEXAWRDK",$J,LEXKEY)=""
. ; Repeat for all characters
K:'$D(LEXTEST)!($D(ZTQUEUED)) ^TMP("LEXAWRDK",$J),^TMP("LEXAWRDU",$J)
H 1 S LEXEND=$$END D SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
S LEXELP=$$ELP(LEXBEG,LEXEND),LEXBEGD=$$ED(LEXBEG)
S LEXBEGT=$$ET(LEXBEG),LEXENDT=$$ET(LEXEND),LEXDF=$$DF(LEXBEG)
S LEXTXT=$G(LEXTXT)_$J(" ",(35-$L($G(LEXTXT))))
S LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
S LEXTXT=" "_LEXTXT W:'$D(ZTQUEUED) !,LEXTXT
I LEX1>0,$D(LEXFUL) D
. S LEXCOM=LEX1_" Word"_$S(LEX1>1:"s",1:"")
. D SAV^LEXXGP3(LEXBEG,"","",LEXCOM) W:'$D(ZTQUEUED) !," ",LEXCOM
I LEX3>0,$D(LEXFUL) D
. S LEXCOM=LEX3_" 'AWRD' Index Node"_$S(LEX3>1:"s",1:"")
. D SAV^LEXXGP3(LEXBEG,"","",LEXCOM) W:'$D(ZTQUEUED) !," ",LEXCOM
Q
;
; Miscellaneous
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
SCT(X) ; String Count (exact string)
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("LEXAWRD",$J)) LEXRT="^TMP(""LEXAWRD"","_$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
CHRS ; Get Characters - Sets LEXCHRS
N LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK K LEXCHRS S LEXRT1="^LEX(757.01,""AWRD"","
S LEXRT2="^TMP(""LEXAWRD"","_$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
FMTT(X) ; Format Total
N LEXI,LEXTXT,LEXTMP,LEXBEG,LEXBEGD,LEXBEGT,LEXEND,LEXENDD,LEXENDT,LEXELP
S LEXBEG=$G(^TMP("LEXXGPTIM",$J,"BEG")) Q:$P(LEXBEG,".",1)'?7N ""
S LEXEND=$G(^TMP("LEXXGPTIM",$J,"END")) Q:$P(LEXEND,".",1)'?7N ""
Q:LEXEND'>LEXBEG "" S LEXTXT="Total Time to Repair Indexes"
S LEXELP=$$ELP(LEXBEG,LEXEND),LEXBEGD=$$ED(LEXBEG),LEXBEGT=$$ET(LEXBEG),LEXENDT=$$ET(LEXEND),LEXDF=$$DF(LEXBEG)
Q:'$L(LEXBEGT) "" Q:'$L(LEXENDT) "" Q:'$L(LEXELP) ""
S X=LEXTXT_$J(" ",(35-$L(LEXTXT)))_LEXBEGD_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
Q X
FMT(X,LEXBD,LEXBT,LEXET,LEXEL) ; Format Line
N LEXTX S LEXTX=$G(X),LEXBD=$G(LEXBD),LEXBT=$G(LEXBT),LEXET=$G(LEXET),LEXEL=$G(LEXEL)
Q:'$L(LEXTX)!('$L(LEXBD))!('$L(LEXBT))!('$L(LEXET))!('$L(LEXEL)) ""
S X=$G(LEXTX)_$J(" ",(35-$L($G(LEXTX))))_LEXBD_" "_LEXBT_" "_LEXET_" "_LEXEL
Q X
DF(X) ; Date Display Format
N LEXO,LEXD,LEXDF,LEXP,LEXC S (X,LEXD)=$P($G(X),".",1) Q:LEXD'?7N "--/--/----"
S LEXP=$O(^TMP("LEXXGPDAT",$J,(LEXD_".001")),-1) S LEXC=1
S:$L(LEXP) LEXC=$O(^TMP("LEXXGPDAT",$J,LEXP," "),-1)
S LEXO=$$ED(LEXD) S:LEXP=LEXD&(LEXC>1) LEXO=" "" "" " S X=LEXO
Q X
ED(X) ; External Date from Fileman
N LEX,LEXT,LEXBD S LEX=$G(X) Q:$P(LEX,".",1)'?7N ""
S LEXT=$$FMTE^XLFDT($G(LEX),"5ZS"),X=$P(LEXT,"@",1)
Q X
ET(X) ; External Time from Fileman
N LEX,LEXT,LEXBD S LEX=$G(X) Q:$P(LEX,".",1)'?7N ""
S LEXT=$$FMTE^XLFDT($G(LEX),"5ZS"),X=$P(LEXT,"@",2)
S:'$L(X) X="00:00:00" S:'$L($P(X,":",1)) $P(X,":",1)="00"
S:'$L($P(X,":",2)) $P(X,":",2)="00" S:'$L($P(X,":",3)) $P(X,":",3)="00"
Q X
BEG(X) ; Begin Date/Time
S X=$$NOW^XLFDT N Y S Y=$G(^TMP("LEXXGPTIM",$J,"BEG"))
S:'$L(Y) Y=X S:+X<Y Y=X S:$P(Y,".",1)?7N ^TMP("LEXXGPTIM",$J,"BEG")=Y
Q X
END(X) ; End Date/Time
S X=$$NOW^XLFDT N Y S Y=$G(^TMP("LEXXGPTIM",$J,"END"))
S:'$L(Y) Y=X S:+X>Y Y=X S:$P(Y,".",1)?7N ^TMP("LEXXGPTIM",$J,"END")=Y
Q X
ELP(X,Y) ; Elapsed Time
N LEXBEG,LEXEND,LEXELP S LEXBEG=$G(X),LEXEND=$G(Y)
Q:$P(LEXBEG,".",1)'?7N " "
Q:$P(LEXEND,".",1)'?7N " "
S LEXELP=$TR($$FMDIFF^XLFDT(LEXEND,LEXBEG,3)," ","0")
S X=LEXELP
Q X
CLR ; Clear Variables
K LEXLOUD,LEXTEST,LEXJ,LEXMAIL,LEXHOME,LEXQUIT
Q
DEA(X) ; Expression/Concept Deactive
N 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[HLEXXGP1 16892 printed Dec 13, 2024@02:10:15 Page 2
LEXXGP1 ;ISL/KER - Global Post-Install (Repair Expressions) ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**80,86,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXASL") SACC 2.3.2.5.1
+5 ; ^TMP("LEXASLU") SACC 2.3.2.5.1
+6 ; ^TMP("LEXAWRD") SACC 2.3.2.5.1
+7 ; ^TMP("LEXAWRDK") SACC 2.3.2.5.1
+8 ; ^TMP("LEXAWRDU") SACC 2.3.2.5.1
+9 ; ^TMP("LEXSUB") SACC 2.3.2.5.1
+10 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+11 ; ^TMP("LEXXGPDAT") SACC 2.3.2.5.1
+12 ; ^TMP("LEXXGPMSG") SACC 2.3.2.5.1
+13 ; ^TMP("LEXXGPRPT") SACC 2.3.2.5.1
+14 ; ^TMP("LEXXGPTIM") SACC 2.3.2.5.1
+15 ;
+16 ; External References
+17 ; HOME^%ZIS ICR 10086
+18 ; $$S^%ZTLOAD ICR 10063
+19 ; ^%ZTLOAD ICR 10063
+20 ; $$FMDIFF^XLFDT ICR 10103
+21 ; $$FMTE^XLFDT ICR 10103
+22 ; $$NOW^XLFDT ICR 10103
+23 ; $$UP^XLFSTR ICR 10104
+24 ; MES^XPDUTL ICR 10141
+25 ;
+26 ; Local Variables NEWed or KILLed Elsewhere
+27 ;
+28 ; LEXMAIL Set and Killed by the developer, used to
+29 ; report the timing of the task and
+30 ; send to the user by MailMan message
+31 ;
+32 ; LEXHOME Set and Killed by the developer in the
+33 ; post-install, used to send the timing
+34 ; message to G.LEXINS@FO-SLC.DOMAIN.EXT
+35 ; (see entry point POST2)
+36 ;
+37 ; FileMan LEXXGP
+38 ;
+39 ; Lexicon Lexicon
+40 ; Re-Index Time Available Time Available
+41 ; -------------- ---- --------- ---- ---------
+42 ; Build 'AWRD' 33.5 No 8.5 Yes
+43 ; Replace 'AWRD' -- -- 2.5 No
+44 ; Build 'ASL' 8.5 No 6.5 Yes
+45 ; Replace 'ASL' -- -- 0.5 No
+46 ; Build 'ASUB' 15.5 No 11.5 Yes
+47 ; Replace 'ASUB' -- -- 1.5 No
+48 ;
+49 ; Lexicon
+50 ; Unavailable: 57.5 4.5 Minutes
+51 ;
+52 QUIT
EN ; Interactive Entry Point
+1 DO ALL
+2 QUIT
POST ; Entry Point from Post-Install
+1 NEW LEXMAIL,LEXHOME
SET LEXMAIL=""
DO POST3
+2 QUIT
POST2 ; Entry Point from Post-Install (home)
+1 NEW LEXMAIL,LEXHOME
SET LEXHOME=""
SET LEXMAIL=""
DO POST3
+2 QUIT
POST3 ; Called by POST/POST2 starts task
+1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ,LEXTN
+2 SET ZTRTN="ALL^LEXXGP1"
+3 SET (LEXTN,ZTDESC)="Repair indexes in files #757.01/757.21"
+4 IF $DATA(LEXMAIL)
SET LEXMAIL=1
SET ZTSAVE("LEXMAIL")=""
+5 IF $DATA(LEXHOME)
SET LEXHOME=1
SET ZTSAVE("LEXHOME")=""
+6 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
IF $DATA(LEXLOUD)
Begin DoDot:1
+7 SET LEXT=" "_$GET(LEXTN)_" tasked"
+8 if +($GET(ZTSK))>0
SET LEXT=LEXT_" (#"_+($GET(ZTSK))_")"
+9 DO MES^XPDUTL(LEXT)
End DoDot:1
+10 QUIT
ALL ; Index all Lookup Indexes
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXAWRDK",$JOB),^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB),^TMP("LEXSUB",$JOB)
+3 KILL ^TMP("LEXXGPTIM",$JOB)
NEW DIC,DTOUT,DUOUT,LEX,LEX1,LEX2,LEX3,LEX4,LEXB,LEXBD,LEXBEG,LEXBEGD,LEXBEGT,LEXBT,LEXC,LEXCHR
+4 NEW LEXCHRS,LEXCMD,LEXCOM,LEXCTL,LEXD,LEXDF,LEXE,LEXEL,LEXELP,LEXELPT,LEXEND,LEXENDD,LEXENDT,LEXET,LEXEX,LEXEXP,LEXF
+5 NEW LEXFC,LEXFIR,LEXFUL,LEXHDR,LEXI,LEXID,LEXIDS,LEXIDX,LEXINAM,LEXIT,LEXJ,LEXLAST,LEXLN,LEXLOOK,LEXLOUD,LEXLWRD,LEXM
+6 NEW LEXMC,LEXMCEI,LEXMCI,LEXN,LEXNAM,LEXNEW,LEXNM,LEXNOD,LEXO,LEXO1,LEXO2,LEXP,LEXPDT,LEXPRE,LEXRI,LEXRT,LEXRT1,LEXRT2
+7 NEW LEXS,LEXSI,LEXSUB,LEXT,LEXTDAT,LEXTEXP,LEXTK,LEXTKC,LEXTKN,LEXTMP,LEXTWRD,LEXTX,LEXTXT,LEXV,LEXX,X,XCNP,XMDUZ
+8 NEW XMSCR,XMSUB,XMTEXT,XMY,XMZ,Y
if '$DATA(LEXQUIT)
SET LEXQUIT="ALL"
NEW LEXTXT,LEXFUL
SET LEXFUL=""
DO EXP
DO SUB^LEXXGP3
+9 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+10 NEW LEXTXT
SET LEXTXT=$$FMTT
if '$LENGTH(LEXTXT)
QUIT
WRITE !," ",LEXTXT
End DoDot:1
+11 IF $GET(LEXQUIT)="ALL"
Begin DoDot:1
+12 if $DATA(LEXMAIL)
DO XM^LEXXGP3
KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
IF '$DATA(LEXTEST)
Begin DoDot:2
+13 KILL ^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB),^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXAWRDK",$JOB)
+14 KILL ^TMP("LEXSUB",$JOB),^TMP("LEXTKN",$JOB),^TMP("LEXXGPDAT",$JOB),^TMP("LEXXGPTIM",$JOB),^TMP("LEXXGPRPT",$JOB)
+15 if '$DATA(LEXMAIL)
KILL ^TMP("LEXXGPMSG",$JOB)
NEW ZTQUEUED,LEXTEST
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
EXP ; Expression file Main Indexes AWRD/ASL
+1 NEW LEXBEG,LEXBEGD,LEXBEGT,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT
+2 NEW LEXTMP,LEXTXT
SET LEXTXT="Expression Indexes"
+3 if '$DATA(LEXQUIT)
SET LEXQUIT="EXP"
KILL ^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXAWRDK",$JOB)
+4 KILL ^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB)
SET LEXBEG=$$BEG
+5 DO AWRDB
DO ASLB^LEXXGP2
HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
+6 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+7 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+8 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+9 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+10 SET LEXTXT=" "_LEXTXT
if '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+11 IF $GET(LEXQUIT)="EXP"
Begin DoDot:1
+12 if $DATA(LEXMAIL)
DO XM^LEXXGP3
KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
IF '$DATA(LEXTEST)
Begin DoDot:2
+13 KILL ^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB),^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXAWRDK",$JOB)
+14 KILL ^TMP("LEXTKN",$JOB),^TMP("LEXXGPDAT",$JOB),^TMP("LEXXGPTIM",$JOB),^TMP("LEXXGPRPT",$JOB)
+15 if '$DATA(LEXMAIL)
KILL ^TMP("LEXXGPMSG",$JOB)
NEW ZTQUEUED,LEXTEST
End DoDot:2
End DoDot:1
+16 QUIT
AWRDB ; AWRD Word Index Build 8.5 minutes
+1 ; Create the AWRD Index in the ^TMP global
+2 NEW LEX0P3,LEX0P4,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXELP,LEXEND,LEXENDT,LEXEX
+3 NEW LEXEXP,LEXIDX,LEXMC,LEXMCEI,LEXMCI,LEXND,LEXRI,LEXSI,LEXTKC,LEXTKN,LEXTMP,LEXTXT
+4 KILL ^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXAWRDK",$JOB)
if '$DATA(LEXQUIT)
SET LEXQUIT="AWRDB"
+5 SET LEXBEG=$$BEG
SET LEXEX=0
SET LEXTXT="Build 'AWRD' Word Index"
+6 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+7 SET LEXEX=0
FOR
SET LEXEX=$ORDER(^LEX(757.01,LEXEX))
if +LEXEX'>0
QUIT
Begin DoDot:1
+8 NEW X,LEXEXP,LEXIDX,LEXMC,LEXMCI,LEXMCEI,LEXRI,LEXSI,LEXTKN,LEXTKC,LEXTMP,LEXDEA,LEXTTYP
+9 SET LEX0P3=+LEXEX
SET LEX0P4=+($GET(LEX0P4))+1
+10 SET LEXEXP=$$UP^XLFSTR($GET(^LEX(757.01,LEXEX,0)))
if '$LENGTH(LEXEXP)
QUIT
+11 SET LEXMCI=$PIECE($GET(^LEX(757.01,LEXEX,1)),"^",1)
if +LEXMCI'>0
QUIT
+12 SET LEXDEA=$$DEA(+LEXEX)
if LEXDEA>0
QUIT
+13 SET LEXTTYP=$PIECE($GET(^LEX(757.01,+LEXEX,1)),"^",2)
if LEXTTYP=8
QUIT
+14 SET LEXMCEI=$PIECE($GET(^LEX(757,LEXMCI,0)),"^",1)
if +LEXMCEI'>0
QUIT
+15 ; Words (main)
+16 KILL ^TMP("LEXTKN",$JOB)
SET LEXIDX=""
SET X=LEXEXP
DO PTX^LEXTOKN
+17 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
Begin DoDot:2
+18 SET LEXTKN=""
SET LEXTKC=0
+19 FOR
SET LEXTKC=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC))
if +LEXTKC'>0
QUIT
Begin DoDot:3
+20 NEW LEXND,LEXTKN
SET LEXTKN=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC,""))
if '$LENGTH(LEXTKN)
QUIT
+21 IF $LENGTH($GET(LEXTKN))
IF +($GET(LEXMCI))>0
IF +($GET(LEXMCEI))>0
IF +($GET(LEXEX))>0
Begin DoDot:4
+22 NEW LEXND
SET LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+23 SET LEXND="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXMCEI_")"
if $DATA(@LEXND)
QUIT
+24 SET LEXND="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXMCEI_","_LEXEX_")"
SET @LEXND=""
End DoDot:4
End DoDot:3
End DoDot:2
+25 KILL ^TMP("LEXTKN",$JOB)
+26 ; Supplemental Words
+27 SET LEXSI=0
FOR
SET LEXSI=$ORDER(^LEX(757.01,LEXEX,5,LEXSI))
if +LEXSI'>0
QUIT
Begin DoDot:2
+28 NEW LEXND,LEXTKN
SET LEXTKN=$$UP^XLFSTR($GET(^LEX(757.01,LEXEX,5,LEXSI,0)))
if '$LENGTH(LEXTKN)
QUIT
+29 SET LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+30 IF $DATA(LEXUNQ)
SET LEXND="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXEX_")"
if $DATA(@LEXND)
QUIT
+31 SET LEXND="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_+LEXEX_","_+LEXMCEI_","_LEXSI_")"
+32 SET @LEXND=""
NEW LEXUNQ
End DoDot:2
+33 ; Linked Words
+34 IF $DATA(^LEX(757.05,"AEXP",LEXEX))
Begin DoDot:2
+35 NEW LEXRI
SET LEXRI=0
+36 FOR
SET LEXRI=$ORDER(^LEX(757.05,"AEXP",LEXEX,LEXRI))
if +LEXRI=0
QUIT
Begin DoDot:3
+37 NEW LEXTKN,LEXMC,LEXND
SET LEXTKN=$$UP^XLFSTR($PIECE(^LEX(757.05,LEXRI,0),U,1))
if '$LENGTH(LEXTKN)
QUIT
+38 SET LEXND="^LEX(757.01,"_LEXEX_",4,""B"","_$$QQ(LEXTKN)_")"
if $DATA(@LEXND)
QUIT
+39 SET LEXMC=$PIECE($GET(^LEX(757.01,LEXEX,1)),U,1)
if +LEXMC'>0
QUIT
+40 IF $DATA(LEXUNQ)
SET LEXND="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_LEXEX_")"
if $DATA(@LEXND)
QUIT
+41 SET LEXND="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTKN)_","_LEXEX_",""LINKED"")"
+42 SET @LEXND=""
NEW LEXUNQ
End DoDot:3
End DoDot:2
End DoDot:1
+43 KILL ^TMP("LEXTKN",$JOB)
HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
+44 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+45 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+46 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+47 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+48 SET LEXTXT=" "_LEXTXT
if '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+49 DO AWRDR
IF $GET(LEXQUIT)="AWRDB"
Begin DoDot:1
+50 if $DATA(LEXMAIL)
DO XM^LEXXGP3
IF '$DATA(LEXTEST)
Begin DoDot:2
+51 KILL ^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXAWRDK",$JOB),^TMP("LEXTKN",$JOB),^TMP("LEXXGPDAT",$JOB)
+52 KILL ^TMP("LEXXGPTIM",$JOB),^TMP("LEXXGPRPT",$JOB)
NEW ZTQUEUED,LEXTEST
End DoDot:2
End DoDot:1
+53 QUIT
AWRDR ; AWRD Word Index Replace 2.5 minutes
+1 NEW LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXCOM,LEXCTL,LEXDATA
+2 NEW LEXDF,LEXELP,LEXEND,LEXENDT,LEXEX,LEXIT,LEXLTKN,LEXMC,LEXND,LEXNOD,LEXSP,LEXTK
+3 NEW LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTKN,LEXTTKN,LEXTXT
SET (LEX1,LEX2,LEX3)=0
+4 if '$DATA(LEXQUIT)
QUIT
SET LEXBEG=$$BEG
SET LEXTXT="Replace 'AWRD' Word Index"
+5 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+6 KILL LEXCHRS
DO CHRS
+7 KILL ^TMP("LEXAWRDK",$JOB),^TMP("LEXAWRDU",$JOB)
+8 SET LEXIT=0
SET LEXCHR=""
FOR
SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))
if '$LENGTH(LEXCHR)
QUIT
Begin DoDot:1
+9 NEW LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
+10 ; For words beginning with a character
+11 SET (LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5)=""
SET LEXIT=0
+12 SET LEXTK1=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXTK2=LEXCHR
SET LEXTK3=LEXCHR_" "
+13 if LEXCHR?1N
SET LEXTK4=LEXCHR-.00000001
if LEXCHR="."
SET LEXTK5=.00000001
+14 FOR LEXTK=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5
Begin DoDot:2
+15 if '$LENGTH(LEXTK)
QUIT
NEW LEXIT
SET LEXIT=0
SET (LEXLTKN,LEXTTKN)=LEXTK
+16 FOR
SET LEXLTKN=$ORDER(^LEX(757.01,"AWRD",LEXLTKN))
Begin DoDot:3
+17 if '$LENGTH(LEXLTKN)
SET LEXIT=1
+18 if LEXCHR'?1N&($EXTRACT(LEXLTKN,1)'=LEXCHR)
SET LEXIT=1
+19 if LEXCHR?1N&($EXTRACT(LEXLTKN,1)'?1N)
SET LEXIT=1
+20 if LEXIT>0
QUIT
+21 NEW LEXND
+22 ; Delete words from the ^LEX global
+23 IF $LENGTH(LEXLTKN)
if $DATA(^TMP("LEXAWRDU",$JOB,LEXLTKN))
QUIT
+24 if $LENGTH(LEXLTKN)
SET ^TMP("LEXAWRDU",$JOB,LEXLTKN)=""
+25 NEW LEXDATA,LEXND
+26 IF $DATA(LEXFUL)
Begin DoDot:4
+27 NEW LEXNOD,LEXCTL,LEXIT,LEXND
SET LEXIT=0
+28 SET LEXNOD="^LEX(757.01,""AWRD"","""_LEXLTKN_""")"
+29 SET LEXCTL="^LEX(757.01,""AWRD"","""_LEXLTKN_""","
+30 FOR
SET LEXNOD=$QUERY(@LEXNOD)
Begin DoDot:5
+31 if '$LENGTH(LEXNOD)
SET LEXIT=1
if LEXNOD'[LEXCTL
SET LEXIT=1
+32 if LEXIT>0
QUIT
NEW LEXFUL
SET LEX2=LEX2+1
End DoDot:5
if LEXIT>0
QUIT
End DoDot:4
+33 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXLTKN)_")"
+34 KILL @LEXND
SET LEX1=LEX1+1
End DoDot:3
if LEXIT>0
QUIT
+35 SET LEXIT=0
FOR
SET LEXTTKN=$ORDER(^TMP("LEXAWRD",$JOB,LEXTTKN))
Begin DoDot:3
+36 if '$LENGTH(LEXTTKN)
SET LEXIT=1
+37 if LEXCHR'?1N&($EXTRACT(LEXTTKN,1)'=LEXCHR)
SET LEXIT=1
+38 if LEXCHR?1N&($EXTRACT(LEXTTKN,1)'?1N)
SET LEXIT=1
+39 if LEXIT>0
QUIT
+40 NEW LEXND,LEXNOD,LEXCTL,LEXKEY
+41 SET LEXNOD="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTTKN)_")"
+42 SET LEXCTL="^TMP(""LEXAWRD"","_$JOB_","_$$QQ(LEXTTKN)_","
+43 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:4
+44 ; Copy Index from ^TMP to ^LEX
+45 ; ^TMP("LEXAWRD",$J,WORD,MCIEN,EXIEN,SPIEN)
+46 ; ^LEX(757.01,"AWRD",WORD,MCIEN,EXIEN,SPIEN)
+47 NEW LEXND,LEXTKN,LEXMC,LEXEX,LEXSP,LEXTND,LEXKEY
+48 SET LEXTND=$TRANSLATE(LEXNOD,"""","")
+49 SET LEXTKN=$PIECE(LEXTND,",",3)
+50 SET LEXMC=$PIECE(LEXTND,",",4)
if +LEXMC'>0
QUIT
+51 SET LEXEX=$PIECE($PIECE(LEXNOD,",",5),")",1)
if '$LENGTH(LEXEX)
QUIT
+52 SET LEXSP=$PIECE($PIECE(LEXTND,",",6),")",1)
+53 SET LEXND="^LEX(757.01,""AWRD"","_$$QQ(LEXTKN)
+54 SET LEXND=LEXND_","_LEXMC_","_$$QQ(LEXEX)
+55 if $LENGTH(LEXSP)
SET LEXND=LEXND_","_$$QQ(LEXSP)
+56 SET LEXND=LEXND_")"
SET LEXKEY=$TRANSLATE(LEXND,"""","")
+57 SET @LEXND=""
if '$DATA(^TMP("LEXAWRDK",$JOB,LEXKEY))
SET LEX3=LEX3+1
+58 SET ^TMP("LEXAWRDK",$JOB,LEXKEY)=""
End DoDot:4
End DoDot:3
if LEXIT>0
QUIT
End DoDot:2
+59 ; Repeat for all characters
End DoDot:1
+60 if '$DATA(LEXTEST)!($DATA(ZTQUEUED))
KILL ^TMP("LEXAWRDK",$JOB),^TMP("LEXAWRDU",$JOB)
+61 HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
+62 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+63 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+64 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+65 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+66 SET LEXTXT=" "_LEXTXT
if '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+67 IF LEX1>0
IF $DATA(LEXFUL)
Begin DoDot:1
+68 SET LEXCOM=LEX1_" Word"_$SELECT(LEX1>1:"s",1:"")
+69 DO SAV^LEXXGP3(LEXBEG,"","",LEXCOM)
if '$DATA(ZTQUEUED)
WRITE !," ",LEXCOM
End DoDot:1
+70 IF LEX3>0
IF $DATA(LEXFUL)
Begin DoDot:1
+71 SET LEXCOM=LEX3_" 'AWRD' Index Node"_$SELECT(LEX3>1:"s",1:"")
+72 DO SAV^LEXXGP3(LEXBEG,"","",LEXCOM)
if '$DATA(ZTQUEUED)
WRITE !," ",LEXCOM
End DoDot:1
+73 QUIT
+74 ;
+75 ; Miscellaneous
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
SCT(X) ; String Count (exact string)
+1 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("LEXAWRD",$JOB))
SET LEXRT="^TMP(""LEXAWRD"","_$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
CHRS ; Get Characters - Sets LEXCHRS
+1 NEW LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK
KILL LEXCHRS
SET LEXRT1="^LEX(757.01,""AWRD"","
+2 SET LEXRT2="^TMP(""LEXAWRD"","_$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
FMTT(X) ; Format Total
+1 NEW LEXI,LEXTXT,LEXTMP,LEXBEG,LEXBEGD,LEXBEGT,LEXEND,LEXENDD,LEXENDT,LEXELP
+2 SET LEXBEG=$GET(^TMP("LEXXGPTIM",$JOB,"BEG"))
if $PIECE(LEXBEG,".",1)'?7N
QUIT ""
+3 SET LEXEND=$GET(^TMP("LEXXGPTIM",$JOB,"END"))
if $PIECE(LEXEND,".",1)'?7N
QUIT ""
+4 if LEXEND'>LEXBEG
QUIT ""
SET LEXTXT="Total Time to Repair Indexes"
+5 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+6 if '$LENGTH(LEXBEGT)
QUIT ""
if '$LENGTH(LEXENDT)
QUIT ""
if '$LENGTH(LEXELP)
QUIT ""
+7 SET X=LEXTXT_$JUSTIFY(" ",(35-$LENGTH(LEXTXT)))_LEXBEGD_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+8 QUIT X
FMT(X,LEXBD,LEXBT,LEXET,LEXEL) ; Format Line
+1 NEW LEXTX
SET LEXTX=$GET(X)
SET LEXBD=$GET(LEXBD)
SET LEXBT=$GET(LEXBT)
SET LEXET=$GET(LEXET)
SET LEXEL=$GET(LEXEL)
+2 if '$LENGTH(LEXTX)!('$LENGTH(LEXBD))!('$LENGTH(LEXBT))!('$LENGTH(LEXET))!('$LENGTH(LEXEL))
QUIT ""
+3 SET X=$GET(LEXTX)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTX))))_LEXBD_" "_LEXBT_" "_LEXET_" "_LEXEL
+4 QUIT X
DF(X) ; Date Display Format
+1 NEW LEXO,LEXD,LEXDF,LEXP,LEXC
SET (X,LEXD)=$PIECE($GET(X),".",1)
if LEXD'?7N
QUIT "--/--/----"
+2 SET LEXP=$ORDER(^TMP("LEXXGPDAT",$JOB,(LEXD_".001")),-1)
SET LEXC=1
+3 if $LENGTH(LEXP)
SET LEXC=$ORDER(^TMP("LEXXGPDAT",$JOB,LEXP," "),-1)
+4 SET LEXO=$$ED(LEXD)
if LEXP=LEXD&(LEXC>1)
SET LEXO=" "" "" "
SET X=LEXO
+5 QUIT X
ED(X) ; External Date from Fileman
+1 NEW LEX,LEXT,LEXBD
SET LEX=$GET(X)
if $PIECE(LEX,".",1)'?7N
QUIT ""
+2 SET LEXT=$$FMTE^XLFDT($GET(LEX),"5ZS")
SET X=$PIECE(LEXT,"@",1)
+3 QUIT X
ET(X) ; External Time from Fileman
+1 NEW LEX,LEXT,LEXBD
SET LEX=$GET(X)
if $PIECE(LEX,".",1)'?7N
QUIT ""
+2 SET LEXT=$$FMTE^XLFDT($GET(LEX),"5ZS")
SET X=$PIECE(LEXT,"@",2)
+3 if '$LENGTH(X)
SET X="00:00:00"
if '$LENGTH($PIECE(X,"
SET $PIECE(X,":",1)="00"
+4 if '$LENGTH($PIECE(X,"
SET $PIECE(X,":",2)="00"
if '$LENGTH($PIECE(X,"
SET $PIECE(X,":",3)="00"
+5 QUIT X
BEG(X) ; Begin Date/Time
+1 SET X=$$NOW^XLFDT
NEW Y
SET Y=$GET(^TMP("LEXXGPTIM",$JOB,"BEG"))
+2 if '$LENGTH(Y)
SET Y=X
if +X<Y
SET Y=X
if $PIECE(Y,".",1)?7N
SET ^TMP("LEXXGPTIM",$JOB,"BEG")=Y
+3 QUIT X
END(X) ; End Date/Time
+1 SET X=$$NOW^XLFDT
NEW Y
SET Y=$GET(^TMP("LEXXGPTIM",$JOB,"END"))
+2 if '$LENGTH(Y)
SET Y=X
if +X>Y
SET Y=X
if $PIECE(Y,".",1)?7N
SET ^TMP("LEXXGPTIM",$JOB,"END")=Y
+3 QUIT X
ELP(X,Y) ; Elapsed Time
+1 NEW LEXBEG,LEXEND,LEXELP
SET LEXBEG=$GET(X)
SET LEXEND=$GET(Y)
+2 if $PIECE(LEXBEG,".",1)'?7N
QUIT " "
+3 if $PIECE(LEXEND,".",1)'?7N
QUIT " "
+4 SET LEXELP=$TRANSLATE($$FMDIFF^XLFDT(LEXEND,LEXBEG,3)," ","0")
+5 SET X=LEXELP
+6 QUIT X
CLR ; Clear Variables
+1 KILL LEXLOUD,LEXTEST,LEXJ,LEXMAIL,LEXHOME,LEXQUIT
+2 QUIT
DEA(X) ; Expression/Concept Deactive
+1 NEW 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
