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