LEXXGP1 ;ISL/KER - Global Post-Install (Repair Expressions) ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
;
;
; 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("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
; ^%ZTLOAD ICR 10063
; $$S^%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.MED.VA.GOV
; (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)
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
ALL ;
K ^TMP("LEXAWRD",$J),^TMP("LEXASL",$J),^TMP("LEXASLU",$J)
K ^TMP("LEXSUB",$J),^TMP("LEXXGPTIM",$J) N DIC,DTOUT,DUOUT,LEX,LEX1
N LEX2,LEX3,LEX4,LEXB,LEXBD,LEXBEG,LEXBEGD,LEXBEGT,LEXBT,LEXC,LEXCHR
N LEXCHRS,LEXCMD,LEXCOM,LEXCTL,LEXD,LEXDF,LEXE,LEXEL,LEXELP,LEXELPT
N LEXEND,LEXENDD,LEXENDT,LEXET,LEXEX,LEXEXP,LEXF,LEXFC,LEXFIR,LEXFUL
N LEXHDR,LEXI,LEXID,LEXIDS,LEXIDX,LEXINAM,LEXIT,LEXJ,LEXLAST,LEXLN
N LEXLOOK,LEXLOUD,LEXLWRD,LEXM,LEXMC,LEXMCEI,LEXMCI,LEXN,LEXNAM
N LEXNEW,LEXNM,LEXNOD,LEXO,LEXO1,LEXO2,LEXP,LEXPDT,LEXPRE,LEXRI,LEXRT
N LEXRT1,LEXRT2,LEXS,LEXSI,LEXSUB,LEXT,LEXTDAT,LEXTEST,LEXTEXP,LEXTK
N 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^LEXXGP2
I '$D(ZTQUEUED) D
. N LEXTXT S LEXTXT=$$FMTT Q:'$L(LEXTXT) W !," ",LEXTXT
I $G(LEXQUIT)="ALL" D
. D:$D(LEXMAIL) XM^LEXXGP2
. K ^TMP("LEXASL"),^TMP("LEXASLU"),^TMP("LEXAWRD")
. K ^TMP("LEXSUB"),^TMP("LEXTKN"),^TMP("LEXXGPDAT")
. K ^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
. K:'$D(LEXMAIL) ^TMP("LEXXGPMSG")
. K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
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)
K ^TMP("LEXASL",$J),^TMP("LEXASLU",$J) S LEXBEG=$$BEG
D AWRDB,ASLB H 1 S LEXEND=$$END D SAV^LEXXGP2(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
N ZTQUEUED,LEXTEST
I $G(LEXQUIT)="EXP" D
. D:$D(LEXMAIL) XM^LEXXGP2
. K ^TMP("LEXASL"),^TMP("LEXASLU"),^TMP("LEXAWRD"),^TMP("LEXTKN")
. K ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
. K:'$D(LEXMAIL) ^TMP("LEXXGPMSG")
. K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
Q
AWRDB ; AWRD Word Index Build 8.5 minutes
; Create the AWRD Index in the ^TMP global
N LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT
N LEXEX,LEXEXP,LEXIDX,LEXMC,LEXMCEI,LEXMCI,LEXRI,LEXSI,LEXTKC
N LEXTKN,LEXTXT,X K ^TMP("LEXAWRD",$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"))
F S LEXEX=$O(^LEX(757.01,LEXEX)) Q:+LEXEX'>0 D
. N X,LEXEXP,LEXIDX,LEXMCI,LEXMCEI,LEXSI,LEXTKN,LEXTKC
. 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
. . . S LEXTKN=$O(^TMP("LEXTKN",$J,LEXTKC,"")) Q:'$L(LEXTKN)
. . . I '$D(^TMP("LEXAWRD",$J,LEXTKN,LEXMCEI)) D
. . . . I '$D(^LEX(757.01,LEXEX,4,"B",LEXTKN)) D
. . . . . S ^TMP("LEXAWRD",$J,LEXTKN,LEXMCEI,LEXEX)=""
. 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=$G(^LEX(757.01,LEXEX,5,LEXSI,0)) Q:'$L(LEXTKN)
. . S ^TMP("LEXAWRD",$J,$$UP^XLFSTR(LEXTKN),+LEXEX,+LEXMCEI,LEXSI)=""
. ; 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 S LEXTKN=$P(^LEX(757.05,LEXRI,0),U,1) Q:LEXTKN=""
. . . S LEXMC=$P($G(^LEX(757.01,LEXEX,1)),U,1) Q:+LEXMC'>0
. . . S ^TMP("LEXAWRD",$J,LEXTKN,LEXEX,"LINKED")=""
K ^TMP("LEXTKN",$J) H 1 S LEXEND=$$END D SAV^LEXXGP2(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 N ZTQUEUED,LEXTEST
I $G(LEXQUIT)="AWRDB" D
. D:$D(LEXMAIL) XM^LEXXGP2
. K ^TMP("LEXAWRD"),^TMP("LEXTKN"),^TMP("LEXXGPDAT")
. K ^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
. K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
Q
AWRDR ; AWRD Word Index Replace 2.5 minutes
N LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXCMD
N LEXCOM,LEXCTL,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT,LEXLAST,LEXIT
N LEXLWRD,LEXNOD,LEXRT,LEXRT1,LEXRT2,LEXTDAT,LEXTK,LEXTMP
N LEXTWRD,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 S LEXRT1="^LEX(757.01,""AWRD"","
S LEXRT2="^TMP(""LEXAWRD"","_$J_"," F LEXRT=LEXRT1,LEXRT2 D
. S LEXTK="" F S LEXTK=$O(@(LEXRT_""""_LEXTK_""")")) Q:'$L(LEXTK) D
. . S LEXCHR=$E($TR(LEXTK," ",""),1)
. . S LEXTK=$E(LEXTK,1)_"~" S:$L(LEXCHR) LEXCHRS(LEXCHR)=""
S LEXCHR="" F S LEXCHR=$O(LEXCHRS(LEXCHR)) Q:'$L(LEXCHR) D
. ; For words beginning with a character
. W:'$D(ZTQUEUED)&($D(LEXTEST)) LEXCHR
. S (LEXLWRD,LEXTWRD)=$C($A(LEXCHR)-1)_"~",LEXIT=0
. F S LEXLWRD=$O(^LEX(757.01,"AWRD",LEXLWRD)) D Q:LEXIT>0
. . S:'$L(LEXLWRD) LEXIT=1 S:$E(LEXLWRD,1)'=LEXCHR LEXIT=1
. . Q:LEXIT>0 N LEXCMD
. . ; Delete words from the ^LEX global
. . I $D(LEXFUL) D
. . . N LEXNOD,LEXCTL,LEXIT S LEXIT=0
. . . S LEXNOD="^LEX(757.01,""AWRD"","""_LEXLWRD_""")"
. . . S LEXCTL="^LEX(757.01,""AWRD"","""_LEXLWRD_""","
. . . F S LEXNOD=$Q(@LEXNOD) D Q:LEXIT>0
. . . . S:'$L(LEXNOD) LEXIT=1 S:LEXNOD'[LEXCTL LEXIT=1
. . . . Q:LEXIT>0 S LEX2=LEX2+1
. . S LEXCMD="K ^LEX(757.01,""AWRD"","""_LEXLWRD_""")"
. . X LEXCMD S LEX1=LEX1+1
. S LEXIT=0 F S LEXTWRD=$O(^TMP("LEXAWRD",$J,LEXTWRD)) D Q:LEXIT>0
. . S:'$L(LEXTWRD) LEXIT=1 S:$E(LEXTWRD,1)'=LEXCHR LEXIT=1
. . Q:LEXIT>0 N LEXNOD,LEXCTL
. . S LEXNOD="^TMP(""LEXAWRD"","_$J_","""_LEXTWRD_""")"
. . S LEXCTL="^TMP(""LEXAWRD"","_$J_","""_LEXTWRD_""","
. . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . ; Copy Index from ^TMP to ^LEX
. . . N LEXCMD
. . . S LEXCMD="S ^LEX(757.01,""AWRD"""_$P(LEXNOD,$J,2,229)_"="""""
. . . X LEXCMD S LEX3=LEX3+1
. ; Repeat for all characters
H 1 S LEXEND=$$END D SAV^LEXXGP2(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^LEXXGP2(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^LEXXGP2(LEXBEG,"","",LEXCOM)
. W:'$D(ZTQUEUED) !," ",LEXCOM
N ZTQUEUED,LEXTEST
Q
;
ASLB ; ASL String Length Index Build 6.5 minutes
N LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXE,LEXELP,LEXEND,LEXENDD,LEXENDT
N LEXF,LEXFC,LEXFIR,LEXM,LEXO,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTK,LEXIT
N LEXTKN,LEXTMP,LEXTXT S LEXBEG=$$BEG S:'$D(LEXQUIT) LEXQUIT="ASLB"
S LEXTXT="Build 'ASL' String Length Index"
I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
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)
; For each Word
K ^TMP("LEXASL",$J),^TMP("LEXASLU",$J) S (LEXFIR,LEXFC,LEXTK)=""
F S LEXTK=$O(@(LEXRT_""""_LEXTK_""")")) Q:'$L(LEXTK) D
. N LEXP,LEXS,LEXC,LEXF,LEXTKN S LEXTKN=LEXTK
. F Q:$E(LEXTKN,1)'=" " S LEXTKN=$E(LEXTKN,2,$L(LEXTKN))
. F Q:$E(LEXTKN,$L(LEXTKN))'=" " S LEXTKN=$E(LEXTKN,1,($L(LEXTKN)-1))
. S LEXF=$E(LEXTKN,1)
. W:'$D(ZTQUEUED)&($D(LEXTEST))&(LEXFIR'=LEXF)&(LEXFC'[LEXF) LEXF
. S LEXFIR=LEXF S:LEXFC'[LEXF LEXFC=LEXFC_LEXF
. ; Count the occurrences of each string
. F LEXP=1:1:$L(LEXTKN) S LEXS=$$UP^XLFSTR($E(LEXTKN,1,LEXP)) D
. . Q:'$L($G(LEXS)) I '$D(^TMP("LEXASLU",$J,LEXS)) D
. . . N LEXE,LEXM,LEXO,LEXT S LEXT=0
. . . I $L(LEXS)>1 D
. . . . S LEXO=$E(LEXS,1,($L(LEXS)-1))
. . . . S LEXO=LEXO_$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
. . . K:$L($G(LEXS)) ^TMP("LEXASL",$J,LEXS)
. . . S:$L($G(LEXS))&(+($G(LEXT))>0) ^TMP("LEXASL",$J,LEXS,LEXT)=""
. . S ^TMP("LEXASLU",$J,LEXS)=""
H 1 S LEXEND=$$END D SAV^LEXXGP2(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 ASLR N ZTQUEUED,LEXTEST
I $G(LEXQUIT)="ASLB" D
. D:$D(LEXMAIL) XM^LEXXGP2
. K ^TMP("LEXASL"),^TMP("LEXASLU"),^TMP("LEXAWRD"),^TMP("LEXTKN")
. K ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
. K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
Q
ASLR ; ASL String Length Index Replace 0.5 minutes
N LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXCMD
N LEXCOM,LEXCTL,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT,LEXLWRD
N LEXNOD,LEXRT,LEXRT1,LEXRT2,LEXTK,LEXTMP,LEXTWRD,LEXTXT
S (LEX1,LEX2,LEX3)=0 Q:'$D(LEXQUIT)
S LEXBEG=$$BEG,LEXTXT="Replace 'ASL' String Length Index"
I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
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)=""
S LEXCHR="" F S LEXCHR=$O(LEXCHRS(LEXCHR)) Q:'$L(LEXCHR) D
. ; For strings beginning with character
. N LEXLWRD,LEXTWRD,LEXIT
. W:'$D(ZTQUEUED)&($D(LEXTEST)) LEXCHR
. S (LEXLWRD,LEXTWRD)=$C($A(LEXCHR)-1)_"~" S LEXIT=0
. F S LEXLWRD=$O(^LEX(757.01,"ASL",LEXLWRD)) D Q:LEXIT>0
. . S:'$L(LEXLWRD) LEXIT=1 S:$E(LEXLWRD,1)'=LEXCHR LEXIT=1
. . Q:LEXIT>0 N LEXNOD,LEXCTL,LEXCMD
. . ; Delete strings from the ^LEX global
. . S LEXNOD="^LEX(757.01,""ASL"","""_LEXTWRD_""")"
. . S LEXCTL="^LEX(757.01,""ASL"","""_LEXTWRD_""","
. . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . S LEX2=LEX2+1
. . S LEXCMD="K ^LEX(757.01,""ASL"","""_LEXLWRD_""")"
. . X LEXCMD S LEX1=LEX1+1
. S LEXTWRD=$C($A(LEXCHR)-1)_"~" S LEXIT=0
. F S LEXTWRD=$O(^TMP("LEXASL",$J,LEXTWRD)) D Q:LEXIT>0
. . S:'$L(LEXTWRD) LEXIT=1 S:$E(LEXTWRD,1)'=LEXCHR LEXIT=1
. . Q:LEXIT>0 N LEXNOD,LEXCTL
. . S LEXNOD="^TMP(""LEXASL"","_$J_","""_LEXTWRD_""")"
. . S LEXCTL="^TMP(""LEXASL"","_$J_","""_LEXTWRD_""","
. . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . ; Copy Index from ^TMP to ^LEX
. . . N LEXCMD
. . . S LEXCMD="S ^LEX(757.01,""ASL"""_$P(LEXNOD,$J,2,229)_"="""""
. . . X LEXCMD S LEX3=LEX3+1
. ; Repeat for all characters
H 1 S LEXEND=$$END D SAV^LEXXGP2(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 LEX3>0,$D(LEXFUL) D
. S LEXCOM=LEX3_" 'ASL' Index Node"_$S(LEX3>1:"s",1:"")
. D SAV^LEXXGP2(LEXBEG,"","",LEXCOM)
. W:'$D(ZTQUEUED) !," ",LEXCOM
N ZTQUEUED,LEXTEST
Q
;
SUB ; Subset file Indexes Aaaa
D SUB^LEXXGP2
Q
;
; Miscellaneous
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
LEXXGP1 ;ISL/KER - Global Post-Install (Repair Expressions) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
+2 ;
+3 ;
+4 ; Global Variables
+5 ; ^TMP("LEXASL") SACC 2.3.2.5.1
+6 ; ^TMP("LEXASLU") SACC 2.3.2.5.1
+7 ; ^TMP("LEXAWRD") SACC 2.3.2.5.1
+8 ; ^TMP("LEXSUB") SACC 2.3.2.5.1
+9 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+10 ; ^TMP("LEXXGPDAT") SACC 2.3.2.5.1
+11 ; ^TMP("LEXXGPMSG") SACC 2.3.2.5.1
+12 ; ^TMP("LEXXGPRPT") SACC 2.3.2.5.1
+13 ; ^TMP("LEXXGPTIM") SACC 2.3.2.5.1
+14 ;
+15 ; External References
+16 ; HOME^%ZIS ICR 10086
+17 ; ^%ZTLOAD ICR 10063
+18 ; $$S^%ZTLOAD ICR 10063
+19 ; $$FMDIFF^XLFDT ICR 10103
+20 ; $$FMTE^XLFDT ICR 10103
+21 ; $$NOW^XLFDT ICR 10103
+22 ; $$UP^XLFSTR ICR 10104
+23 ; MES^XPDUTL ICR 10141
+24 ;
+25 ; Local Variables NEWed or KILLed Elsewhere
+26 ;
+27 ; LEXMAIL Set and Killed by the developer, used to
+28 ; report the timing of the task and
+29 ; send to the user by MailMan message
+30 ;
+31 ; LEXHOME Set and Killed by the developer in the
+32 ; post-install, used to send the timing
+33 ; message to G.LEXINS@FO-SLC.MED.VA.GOV
+34 ; (see entry point POST2)
+35 ;
+36 ; FileMan LEXXGP
+37 ;
+38 ; Lexicon Lexicon
+39 ; Re-Index Time Available Time Available
+40 ; -------------- ---- --------- ---- ---------
+41 ; Build 'AWRD' 33.5 No 8.5 Yes
+42 ; Replace 'AWRD' -- -- 2.5 No
+43 ; Build 'ASL' 8.5 No 6.5 Yes
+44 ; Replace 'ASL' -- -- 0.5 No
+45 ; Build 'ASUB' 15.5 No 11.5 Yes
+46 ; Replace 'ASUB' -- -- 1.5 No
+47 ;
+48 ; Lexicon
+49 ; Unavailable: 57.5 4.5 Minutes
+50 ;
+51 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 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+11 QUIT
ALL ;
+1 KILL ^TMP("LEXAWRD",$JOB),^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB)
+2 KILL ^TMP("LEXSUB",$JOB),^TMP("LEXXGPTIM",$JOB)
NEW DIC,DTOUT,DUOUT,LEX,LEX1
+3 NEW LEX2,LEX3,LEX4,LEXB,LEXBD,LEXBEG,LEXBEGD,LEXBEGT,LEXBT,LEXC,LEXCHR
+4 NEW LEXCHRS,LEXCMD,LEXCOM,LEXCTL,LEXD,LEXDF,LEXE,LEXEL,LEXELP,LEXELPT
+5 NEW LEXEND,LEXENDD,LEXENDT,LEXET,LEXEX,LEXEXP,LEXF,LEXFC,LEXFIR,LEXFUL
+6 NEW LEXHDR,LEXI,LEXID,LEXIDS,LEXIDX,LEXINAM,LEXIT,LEXJ,LEXLAST,LEXLN
+7 NEW LEXLOOK,LEXLOUD,LEXLWRD,LEXM,LEXMC,LEXMCEI,LEXMCI,LEXN,LEXNAM
+8 NEW LEXNEW,LEXNM,LEXNOD,LEXO,LEXO1,LEXO2,LEXP,LEXPDT,LEXPRE,LEXRI,LEXRT
+9 NEW LEXRT1,LEXRT2,LEXS,LEXSI,LEXSUB,LEXT,LEXTDAT,LEXTEST,LEXTEXP,LEXTK
+10 NEW LEXTKC,LEXTKN,LEXTMP,LEXTWRD,LEXTX,LEXTXT,LEXV,LEXX,X,XCNP,XMDUZ
+11 NEW XMSCR,XMSUB,XMTEXT,XMY,XMZ,Y
IF '$DATA(LEXQUIT)
SET LEXQUIT="ALL"
+12 NEW LEXTXT,LEXFUL
SET LEXFUL=""
DO EXP
DO SUB^LEXXGP2
+13 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+14 NEW LEXTXT
SET LEXTXT=$$FMTT
IF '$LENGTH(LEXTXT)
QUIT
WRITE !," ",LEXTXT
End DoDot:1
+15 IF $GET(LEXQUIT)="ALL"
Begin DoDot:1
+16 IF $DATA(LEXMAIL)
DO XM^LEXXGP2
+17 KILL ^TMP("LEXASL"),^TMP("LEXASLU"),^TMP("LEXAWRD")
+18 KILL ^TMP("LEXSUB"),^TMP("LEXTKN"),^TMP("LEXXGPDAT")
+19 KILL ^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
+20 IF '$DATA(LEXMAIL)
KILL ^TMP("LEXXGPMSG")
+21 KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
End DoDot:1
+22 QUIT
+23 ;
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)
+4 KILL ^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB)
SET LEXBEG=$$BEG
+5 DO AWRDB
DO ASLB
HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP2(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 NEW ZTQUEUED,LEXTEST
+12 IF $GET(LEXQUIT)="EXP"
Begin DoDot:1
+13 IF $DATA(LEXMAIL)
DO XM^LEXXGP2
+14 KILL ^TMP("LEXASL"),^TMP("LEXASLU"),^TMP("LEXAWRD"),^TMP("LEXTKN")
+15 KILL ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
+16 IF '$DATA(LEXMAIL)
KILL ^TMP("LEXXGPMSG")
+17 KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
End DoDot:1
+18 QUIT
AWRDB ; AWRD Word Index Build 8.5 minutes
+1 ; Create the AWRD Index in the ^TMP global
+2 NEW LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT
+3 NEW LEXEX,LEXEXP,LEXIDX,LEXMC,LEXMCEI,LEXMCI,LEXRI,LEXSI,LEXTKC
+4 NEW LEXTKN,LEXTXT,X
KILL ^TMP("LEXAWRD",$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 FOR
SET LEXEX=$ORDER(^LEX(757.01,LEXEX))
IF +LEXEX'>0
QUIT
Begin DoDot:1
+8 NEW X,LEXEXP,LEXIDX,LEXMCI,LEXMCEI,LEXSI,LEXTKN,LEXTKC
+9 SET LEXEXP=$$UP^XLFSTR($GET(^LEX(757.01,LEXEX,0)))
IF '$LENGTH(LEXEXP)
QUIT
+10 SET LEXMCI=$PIECE($GET(^LEX(757.01,LEXEX,1)),"^",1)
IF +LEXMCI'>0
QUIT
+11 SET LEXMCEI=$PIECE($GET(^LEX(757,LEXMCI,0)),"^",1)
IF +LEXMCEI'>0
QUIT
+12 ; Words (main)
+13 KILL ^TMP("LEXTKN",$JOB)
SET LEXIDX=""
SET X=LEXEXP
DO PTX^LEXTOKN
+14 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
Begin DoDot:2
+15 SET LEXTKN=""
SET LEXTKC=0
+16 FOR
SET LEXTKC=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC))
IF +LEXTKC'>0
QUIT
Begin DoDot:3
+17 SET LEXTKN=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC,""))
IF '$LENGTH(LEXTKN)
QUIT
+18 IF '$DATA(^TMP("LEXAWRD",$JOB,LEXTKN,LEXMCEI))
Begin DoDot:4
+19 IF '$DATA(^LEX(757.01,LEXEX,4,"B",LEXTKN))
Begin DoDot:5
+20 SET ^TMP("LEXAWRD",$JOB,LEXTKN,LEXMCEI,LEXEX)=""
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+21 KILL ^TMP("LEXTKN",$JOB)
+22 ; Supplemental Words
+23 SET LEXSI=0
FOR
SET LEXSI=$ORDER(^LEX(757.01,LEXEX,5,LEXSI))
IF +LEXSI'>0
QUIT
Begin DoDot:2
+24 NEW LEXTKN
SET LEXTKN=$GET(^LEX(757.01,LEXEX,5,LEXSI,0))
IF '$LENGTH(LEXTKN)
QUIT
+25 SET ^TMP("LEXAWRD",$JOB,$$UP^XLFSTR(LEXTKN),+LEXEX,+LEXMCEI,LEXSI)=""
End DoDot:2
+26 ; Linked Words
+27 IF $DATA(^LEX(757.05,"AEXP",LEXEX))
Begin DoDot:2
+28 NEW LEXRI
SET LEXRI=0
+29 FOR
SET LEXRI=$ORDER(^LEX(757.05,"AEXP",LEXEX,LEXRI))
IF +LEXRI=0
QUIT
Begin DoDot:3
+30 NEW LEXTKN,LEXMC
SET LEXTKN=$PIECE(^LEX(757.05,LEXRI,0),U,1)
IF LEXTKN=""
QUIT
+31 SET LEXMC=$PIECE($GET(^LEX(757.01,LEXEX,1)),U,1)
IF +LEXMC'>0
QUIT
+32 SET ^TMP("LEXAWRD",$JOB,LEXTKN,LEXEX,"LINKED")=""
End DoDot:3
End DoDot:2
End DoDot:1
+33 KILL ^TMP("LEXTKN",$JOB)
HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP2(LEXBEG,LEXEND,LEXTXT)
+34 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+35 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+36 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+37 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+38 SET LEXTXT=" "_LEXTXT
IF '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+39 DO AWRDR
NEW ZTQUEUED,LEXTEST
+40 IF $GET(LEXQUIT)="AWRDB"
Begin DoDot:1
+41 IF $DATA(LEXMAIL)
DO XM^LEXXGP2
+42 KILL ^TMP("LEXAWRD"),^TMP("LEXTKN"),^TMP("LEXXGPDAT")
+43 KILL ^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
+44 KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
End DoDot:1
+45 QUIT
AWRDR ; AWRD Word Index Replace 2.5 minutes
+1 NEW LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXCMD
+2 NEW LEXCOM,LEXCTL,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT,LEXLAST,LEXIT
+3 NEW LEXLWRD,LEXNOD,LEXRT,LEXRT1,LEXRT2,LEXTDAT,LEXTK,LEXTMP
+4 NEW LEXTWRD,LEXTXT
SET (LEX1,LEX2,LEX3)=0
IF '$DATA(LEXQUIT)
QUIT
+5 SET LEXBEG=$$BEG
SET LEXTXT="Replace 'AWRD' Word Index"
+6 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+7 KILL LEXCHRS
SET LEXRT1="^LEX(757.01,""AWRD"","
+8 SET LEXRT2="^TMP(""LEXAWRD"","_$JOB_","
FOR LEXRT=LEXRT1,LEXRT2
Begin DoDot:1
+9 SET LEXTK=""
FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
IF '$LENGTH(LEXTK)
QUIT
Begin DoDot:2
+10 SET LEXCHR=$EXTRACT($TRANSLATE(LEXTK," ",""),1)
+11 SET LEXTK=$EXTRACT(LEXTK,1)_"~"
IF $LENGTH(LEXCHR)
SET LEXCHRS(LEXCHR)=""
End DoDot:2
End DoDot:1
+12 SET LEXCHR=""
FOR
SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))
IF '$LENGTH(LEXCHR)
QUIT
Begin DoDot:1
+13 ; For words beginning with a character
+14 IF '$DATA(ZTQUEUED)&($DATA(LEXTEST))
WRITE LEXCHR
+15 SET (LEXLWRD,LEXTWRD)=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXIT=0
+16 FOR
SET LEXLWRD=$ORDER(^LEX(757.01,"AWRD",LEXLWRD))
Begin DoDot:2
+17 IF '$LENGTH(LEXLWRD)
SET LEXIT=1
IF $EXTRACT(LEXLWRD,1)'=LEXCHR
SET LEXIT=1
+18 IF LEXIT>0
QUIT
NEW LEXCMD
+19 ; Delete words from the ^LEX global
+20 IF $DATA(LEXFUL)
Begin DoDot:3
+21 NEW LEXNOD,LEXCTL,LEXIT
SET LEXIT=0
+22 SET LEXNOD="^LEX(757.01,""AWRD"","""_LEXLWRD_""")"
+23 SET LEXCTL="^LEX(757.01,""AWRD"","""_LEXLWRD_""","
+24 FOR
SET LEXNOD=$QUERY(@LEXNOD)
Begin DoDot:4
+25 IF '$LENGTH(LEXNOD)
SET LEXIT=1
IF LEXNOD'[LEXCTL
SET LEXIT=1
+26 IF LEXIT>0
QUIT
SET LEX2=LEX2+1
End DoDot:4
IF LEXIT>0
QUIT
End DoDot:3
+27 SET LEXCMD="K ^LEX(757.01,""AWRD"","""_LEXLWRD_""")"
+28 XECUTE LEXCMD
SET LEX1=LEX1+1
End DoDot:2
IF LEXIT>0
QUIT
+29 SET LEXIT=0
FOR
SET LEXTWRD=$ORDER(^TMP("LEXAWRD",$JOB,LEXTWRD))
Begin DoDot:2
+30 IF '$LENGTH(LEXTWRD)
SET LEXIT=1
IF $EXTRACT(LEXTWRD,1)'=LEXCHR
SET LEXIT=1
+31 IF LEXIT>0
QUIT
NEW LEXNOD,LEXCTL
+32 SET LEXNOD="^TMP(""LEXAWRD"","_$JOB_","""_LEXTWRD_""")"
+33 SET LEXCTL="^TMP(""LEXAWRD"","_$JOB_","""_LEXTWRD_""","
+34 FOR
SET LEXNOD=$QUERY(@LEXNOD)
IF '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:3
+35 ; Copy Index from ^TMP to ^LEX
+36 NEW LEXCMD
+37 SET LEXCMD="S ^LEX(757.01,""AWRD"""_$PIECE(LEXNOD,$JOB,2,229)_"="""""
+38 XECUTE LEXCMD
SET LEX3=LEX3+1
End DoDot:3
End DoDot:2
IF LEXIT>0
QUIT
+39 ; Repeat for all characters
End DoDot:1
+40 HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP2(LEXBEG,LEXEND,LEXTXT)
+41 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+42 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+43 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+44 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+45 SET LEXTXT=" "_LEXTXT
IF '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+46 IF LEX1>0
IF $DATA(LEXFUL)
Begin DoDot:1
+47 SET LEXCOM=LEX1_" Word"_$SELECT(LEX1>1:"s",1:"")
+48 DO SAV^LEXXGP2(LEXBEG,"","",LEXCOM)
+49 IF '$DATA(ZTQUEUED)
WRITE !," ",LEXCOM
End DoDot:1
+50 IF LEX3>0
IF $DATA(LEXFUL)
Begin DoDot:1
+51 SET LEXCOM=LEX3_" 'AWRD' Index Node"_$SELECT(LEX3>1:"s",1:"")
+52 DO SAV^LEXXGP2(LEXBEG,"","",LEXCOM)
+53 IF '$DATA(ZTQUEUED)
WRITE !," ",LEXCOM
End DoDot:1
+54 NEW ZTQUEUED,LEXTEST
+55 QUIT
+56 ;
ASLB ; ASL String Length Index Build 6.5 minutes
+1 NEW LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXE,LEXELP,LEXEND,LEXENDD,LEXENDT
+2 NEW LEXF,LEXFC,LEXFIR,LEXM,LEXO,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTK,LEXIT
+3 NEW LEXTKN,LEXTMP,LEXTXT
SET LEXBEG=$$BEG
IF '$DATA(LEXQUIT)
SET LEXQUIT="ASLB"
+4 SET LEXTXT="Build 'ASL' String Length Index"
+5 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+6 SET LEXRT=""
IF $DATA(^LEX(757.01,"AWRD"))
SET LEXRT="^LEX(757.01,""AWRD"","
+7 IF $DATA(^TMP("LEXAWRD",$JOB))
SET LEXRT="^TMP(""LEXAWRD"","_$JOB_","
IF '$LENGTH(LEXRT)
QUIT
+8 ; For each Word
+9 KILL ^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB)
SET (LEXFIR,LEXFC,LEXTK)=""
+10 FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
IF '$LENGTH(LEXTK)
QUIT
Begin DoDot:1
+11 NEW LEXP,LEXS,LEXC,LEXF,LEXTKN
SET LEXTKN=LEXTK
+12 FOR
IF $EXTRACT(LEXTKN,1)'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,2,$LENGTH(LEXTKN))
+13 FOR
IF $EXTRACT(LEXTKN,$LENGTH(LEXTKN))'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,1,($LENGTH(LEXTKN)-1))
+14 SET LEXF=$EXTRACT(LEXTKN,1)
+15 IF '$DATA(ZTQUEUED)&($DATA(LEXTEST))&(LEXFIR'=LEXF)&(LEXFC'[LEXF)
WRITE LEXF
+16 SET LEXFIR=LEXF
IF LEXFC'[LEXF
SET LEXFC=LEXFC_LEXF
+17 ; Count the occurrences of each string
+18 FOR LEXP=1:1:$LENGTH(LEXTKN)
SET LEXS=$$UP^XLFSTR($EXTRACT(LEXTKN,1,LEXP))
Begin DoDot:2
+19 IF '$LENGTH($GET(LEXS))
QUIT
IF '$DATA(^TMP("LEXASLU",$JOB,LEXS))
Begin DoDot:3
+20 NEW LEXE,LEXM,LEXO,LEXT
SET LEXT=0
+21 IF $LENGTH(LEXS)>1
Begin DoDot:4
+22 SET LEXO=$EXTRACT(LEXS,1,($LENGTH(LEXS)-1))
+23 SET LEXO=LEXO_$CHAR(($ASCII($EXTRACT(LEXS,$LENGTH(LEXS)))-1))_"~"
End DoDot:4
+24 IF $LENGTH(LEXS)=1
SET LEXO=$CHAR(($ASCII(LEXS)-1))_"~"
SET LEXIT=0
+25 FOR
SET LEXO=$ORDER(@(LEXRT_""""_LEXO_""")"))
Begin DoDot:4
+26 IF '$LENGTH(LEXO)
SET LEXIT=1
IF $EXTRACT(LEXO,1,$LENGTH(LEXS))'=LEXS
SET LEXIT=1
+27 IF LEXIT>0
QUIT
NEW LEXM
SET LEXM=0
+28 FOR
SET LEXM=$ORDER(@(LEXRT_""""_LEXO_""","_LEXM_")"))
IF +LEXM'>0
QUIT
Begin DoDot:5
+29 NEW LEXE,LEXRT2
SET LEXE=0
SET LEXRT2=LEXRT_""""_LEXO_""","_LEXM_","
+30 FOR
SET LEXE=$ORDER(@(LEXRT2_LEXE_")"))
IF +LEXE'>0
QUIT
SET LEXT=LEXT+1
End DoDot:5
End DoDot:4
IF LEXIT>0
QUIT
+31 IF $LENGTH($GET(LEXS))
KILL ^TMP("LEXASL",$JOB,LEXS)
+32 IF $LENGTH($GET(LEXS))&(+($GET(LEXT))>0)
SET ^TMP("LEXASL",$JOB,LEXS,LEXT)=""
End DoDot:3
+33 SET ^TMP("LEXASLU",$JOB,LEXS)=""
End DoDot:2
End DoDot:1
+34 HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP2(LEXBEG,LEXEND,LEXTXT)
+35 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+36 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+37 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+38 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+39 SET LEXTXT=" "_LEXTXT
IF '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+40 DO ASLR
NEW ZTQUEUED,LEXTEST
+41 IF $GET(LEXQUIT)="ASLB"
Begin DoDot:1
+42 IF $DATA(LEXMAIL)
DO XM^LEXXGP2
+43 KILL ^TMP("LEXASL"),^TMP("LEXASLU"),^TMP("LEXAWRD"),^TMP("LEXTKN")
+44 KILL ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
+45 KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
End DoDot:1
+46 QUIT
ASLR ; ASL String Length Index Replace 0.5 minutes
+1 NEW LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXCMD
+2 NEW LEXCOM,LEXCTL,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT,LEXLWRD
+3 NEW LEXNOD,LEXRT,LEXRT1,LEXRT2,LEXTK,LEXTMP,LEXTWRD,LEXTXT
+4 SET (LEX1,LEX2,LEX3)=0
IF '$DATA(LEXQUIT)
QUIT
+5 SET LEXBEG=$$BEG
SET LEXTXT="Replace 'ASL' String Length Index"
+6 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+7 KILL LEXCHRS
SET LEXRT1="^LEX(757.01,""AWRD"","
+8 SET LEXRT2="^TMP(""LEXAWRD"","_$JOB_","
FOR LEXRT=LEXRT1,LEXRT2
Begin DoDot:1
+9 NEW LEXTK
SET LEXTK=""
+10 FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
IF '$LENGTH(LEXTK)
QUIT
Begin DoDot:2
+11 NEW LEXCHR
SET LEXCHR=$EXTRACT($TRANSLATE(LEXTK," ",""),1)
+12 SET LEXTK=$EXTRACT(LEXTK,1)_"~"
IF $LENGTH(LEXCHR)
SET LEXCHRS(LEXCHR)=""
End DoDot:2
End DoDot:1
+13 SET LEXCHR=""
FOR
SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))
IF '$LENGTH(LEXCHR)
QUIT
Begin DoDot:1
+14 ; For strings beginning with character
+15 NEW LEXLWRD,LEXTWRD,LEXIT
+16 IF '$DATA(ZTQUEUED)&($DATA(LEXTEST))
WRITE LEXCHR
+17 SET (LEXLWRD,LEXTWRD)=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXIT=0
+18 FOR
SET LEXLWRD=$ORDER(^LEX(757.01,"ASL",LEXLWRD))
Begin DoDot:2
+19 IF '$LENGTH(LEXLWRD)
SET LEXIT=1
IF $EXTRACT(LEXLWRD,1)'=LEXCHR
SET LEXIT=1
+20 IF LEXIT>0
QUIT
NEW LEXNOD,LEXCTL,LEXCMD
+21 ; Delete strings from the ^LEX global
+22 SET LEXNOD="^LEX(757.01,""ASL"","""_LEXTWRD_""")"
+23 SET LEXCTL="^LEX(757.01,""ASL"","""_LEXTWRD_""","
+24 FOR
SET LEXNOD=$QUERY(@LEXNOD)
IF '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:3
+25 SET LEX2=LEX2+1
End DoDot:3
+26 SET LEXCMD="K ^LEX(757.01,""ASL"","""_LEXLWRD_""")"
+27 XECUTE LEXCMD
SET LEX1=LEX1+1
End DoDot:2
IF LEXIT>0
QUIT
+28 SET LEXTWRD=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXIT=0
+29 FOR
SET LEXTWRD=$ORDER(^TMP("LEXASL",$JOB,LEXTWRD))
Begin DoDot:2
+30 IF '$LENGTH(LEXTWRD)
SET LEXIT=1
IF $EXTRACT(LEXTWRD,1)'=LEXCHR
SET LEXIT=1
+31 IF LEXIT>0
QUIT
NEW LEXNOD,LEXCTL
+32 SET LEXNOD="^TMP(""LEXASL"","_$JOB_","""_LEXTWRD_""")"
+33 SET LEXCTL="^TMP(""LEXASL"","_$JOB_","""_LEXTWRD_""","
+34 FOR
SET LEXNOD=$QUERY(@LEXNOD)
IF '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:3
+35 ; Copy Index from ^TMP to ^LEX
+36 NEW LEXCMD
+37 SET LEXCMD="S ^LEX(757.01,""ASL"""_$PIECE(LEXNOD,$JOB,2,229)_"="""""
+38 XECUTE LEXCMD
SET LEX3=LEX3+1
End DoDot:3
End DoDot:2
IF LEXIT>0
QUIT
+39 ; Repeat for all characters
End DoDot:1
+40 HANG 1
SET LEXEND=$$END
DO SAV^LEXXGP2(LEXBEG,LEXEND,LEXTXT)
+41 SET LEXELP=$$ELP(LEXBEG,LEXEND)
SET LEXBEGD=$$ED(LEXBEG)
+42 SET LEXBEGT=$$ET(LEXBEG)
SET LEXENDT=$$ET(LEXEND)
SET LEXDF=$$DF(LEXBEG)
+43 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+44 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+45 SET LEXTXT=" "_LEXTXT
IF '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+46 IF LEX3>0
IF $DATA(LEXFUL)
Begin DoDot:1
+47 SET LEXCOM=LEX3_" 'ASL' Index Node"_$SELECT(LEX3>1:"s",1:"")
+48 DO SAV^LEXXGP2(LEXBEG,"","",LEXCOM)
+49 IF '$DATA(ZTQUEUED)
WRITE !," ",LEXCOM
End DoDot:1
+50 NEW ZTQUEUED,LEXTEST
+51 QUIT
+52 ;
SUB ; Subset file Indexes Aaaa
+1 DO SUB^LEXXGP2
+2 QUIT
+3 ;
+4 ; Miscellaneous
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
