Routine: LEXXGP3

LEXXGP3 ;ISL/KER - Global Post-Install (Repair Subsets) ;05/23/2017

 ;;2.0;LEXICON UTILITY;**86,103**;Sep 23, 1996;Build 2

 ; Global Variables

 ;    ^TMP("LEXAWRD")     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

 ;    $$S^%ZTLOAD         ICR  10063

 ;    ^DIC                ICR  10006

 ;    IXALL^DIK           ICR  10013

 ;    $$GET1^DIQ          ICR   2056

 ;    $$UP^XLFSTR         ICR  10104

 ;    ^XMD                ICR  10070

 ; Local Variables NEWed or KILLed in LEXXGP1

 ;     ZTSK

 ; Special Variables set in the Post-Install Routines

 ;    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)

SUB ; Subset file Indexes Aaaa

 N LEXBEG,LEXBEGD,LEXBEGT,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT

 N LEXTMP,LEXTXT S LEXTXT="Subset Indexes"

 S:'$D(LEXQUIT) LEXQUIT="SUB" K ^TMP("LEXSUB",$J)

 S LEXBEG=$$BEG^LEXXGP1 D ASUBB H 1 S LEXEND=$$END^LEXXGP1

 D SAV(LEXBEG,LEXEND,LEXTXT) S LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)

 S LEXBEGD=$$ED^LEXXGP1(LEXBEG),LEXBEGT=$$ET^LEXXGP1(LEXBEG),LEXENDT=$$ET^LEXXGP1(LEXEND)

 S LEXDF=$$DF^LEXXGP1(LEXBEG),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)="SUB" D

 . D:$D(LEXMAIL) XM

 . K ^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J),^TMP("LEXSUB",$J),^TMP("LEXTKN",$J)

 . K ^TMP("LEXXGPDAT",$J),^TMP("LEXXGPTIM",$J),^TMP("LEXXGPRPT",$J)

 . K:'$D(LEXMAIL) ^TMP("LEXXGPMSG",$J)

 . K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME

ASUBB ;   ASUB Word Index Build                        11.5 minutes

 ;     Create the AWRD Index in the ^TMP global

 N LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT,LEXEX

 N LEXEXP,LEXTEXP,LEXIDX,LEXMC,LEXMCEI,LEXMCI,LEXRI,LEXSI,LEXSUB

 N LEXTKC,LEXTKN,LEXTXT,X

 K ^TMP("LEXSUB",$J) S:'$D(LEXQUIT) LEXQUIT="ASUBB"

 S LEXBEG=$$BEG^LEXXGP1,LEXSUB=0,LEXTXT="Build 'ASUB' Word Index"

 I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.21"))

 F  S LEXSUB=$O(^LEX(757.21,LEXSUB)) Q:+LEXSUB'>0  D

 . N X,LEXEX,LEXEXP,LEXIDX,LEXMCI,LEXMCEI,LEXSI,LEXTKN

 . N LEXTKC,LEXNAM,LEXINAM,LEXNOD,LEXRP,LEXTTYP,LEXTEXP S LEXTEXP=0

 . S LEXNOD=$G(^LEX(757.21,LEXSUB,0)),LEXEX=+LEXNOD

 . S LEXNAM=+($P(LEXNOD,"^",2))

 . S LEXNAM=$P($G(^LEXT(757.2,+LEXNAM,0)),"^",2)

 . Q:$L(LEXNAM)'=3  S LEXINAM="A"_LEXNAM

 . 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 LEXTTYP=+($P($G(^LEX(757.01,LEXEX,1)),"^",2))

 . S LEXMCEI=$P($G(^LEX(757,LEXMCI,0)),"^",1) Q:+LEXMCEI'>0

 . F  S LEXTEXP=$O(^LEX(757.01,"AMC",LEXMCI,LEXTEXP)) Q:+LEXTEXP=0  D

 . . N LEXEXP,X,LEXIDX,LEXLOOK,LEXEXPT,LEXRP,LEXDEA,LEXTTYP

 . . S LEXDEA=$$DEA(+LEXTEXP) Q:LEXDEA>0

 . . S LEXTTYP=+($P($G(^LEX(757.01,LEXTEXP,1)),"^",2)) Q:LEXTTYP=8

 . . S (LEXEXP,X)=^LEX(757.01,LEXTEXP,0)

 . . K ^TMP("LEXTKN",$J) S LEXIDX="" D PTX^LEXTOKN

 . . ;     Supplemental Words

 . . I $D(^LEX(757.01,LEXTEXP,5)) D

 . . . N LEXV,LEXEXPT S LEXV=""

 . . . F  S LEXV=$O(^LEX(757.01,LEXTEXP,5,"B",LEXV)) Q:LEXV=""  D

 . . . . N LEXC S LEXC=$O(^TMP("LEXTKN",$J," "),-1)+1

 . . . . S ^TMP("LEXTKN",$J,LEXC,LEXV)=""

 . . . . S ^TMP("LEXTKN",$J,0)=LEXC

 . . ;     Replacement Words

 . . I $D(^LEX(757.05,"AEXP",LEXTEXP)) N LEXRP S LEXRP=0 D

 . . . F  S LEXRP=$O(^LEX(757.05,"AEXP",LEXTEXP,LEXRP)) Q:+LEXRP'>0  D

 . . . . N LEXV,LEXC

 . . . . S LEXV=$P(^LEX(757.05,LEXRP,0),U) Q:'$L(LEXV)

 . . . . S LEXC=$O(^TMP("LEXTKN",$J," "),-1)+1

 . . . . S ^TMP("LEXTKN",$J,LEXC,LEXV)=""

 . . . . S ^TMP("LEXTKN",$J,0)=LEXC

 . . 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)

 . . . . S ^TMP("LEXSUB",$J,LEXINAM,LEXTKN,LEXSUB)=""

 . . K ^TMP("LEXTKN",$J)

 K ^TMP("LEXTKN",$J) H 1 S LEXEND=$$END^LEXXGP1 D SAV(LEXBEG,LEXEND,LEXTXT)

 S LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND),LEXBEGD=$$ED^LEXXGP1(LEXBEG)

 S LEXBEGT=$$ET^LEXXGP1(LEXBEG),LEXENDT=$$ET^LEXXGP1(LEXEND),LEXDF=$$DF^LEXXGP1(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 ASUBR N ZTQUEUED,LEXTEST

 I $G(LEXQUIT)="ASUBB" D

 . D:$D(LEXMAIL) XM

 . K ^TMP("LEXAWRD"),^TMP("LEXSUB"),^TMP("LEXTKN")

 . K ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")

 . K LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME

ASUBR ;   ASUB Word Index Replace                       1.5 minutes

 N LEX1,LEX2,LEX3,LEX4,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXIDS

 N LEXCMD,LEXCOM,LEXCTL,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT

 N LEXLWRD,LEXNOD,LEXRT,LEXRT1,LEXRT2,LEXTK,LEXTMP,LEXTWRD

 N LEXTXT,LEXID S (LEX1,LEX2,LEX3,LEX4)=0 Q:'$D(LEXQUIT)

 S LEXBEG=$$BEG^LEXXGP1,LEXTXT="Replace 'ASUB' Word Index" K LEXIDS

 I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.21"))

 S LEXTMP=" " F  S LEXTMP=$O(^LEX(757.21,LEXTMP)) Q:'$L(LEXTMP)  D

 . S:$E(LEXTMP,1)="A" LEXIDS(LEXTMP)=""

 S LEXTMP=" "

 F  S LEXTMP=$O(^TMP("LEXSUB",$J,LEXTMP)) Q:'$L(LEXTMP)  D

 . S:$E(LEXTMP,1)="A" LEXIDS(LEXTMP)=""

 S LEXID="" F  S LEXID=$O(LEXIDS(LEXID)) Q:'$L(LEXID)  D

 . ;     For Subset Index

 . W:'$D(ZTQUEUED)&($D(LEXTEST)) !,LEXID," " S LEX1=LEX1+1

 . K LEXCHRS S LEXRT1="^LEX(757.21,"""_LEXID_""","

 . S LEXRT2="^TMP(""LEXSUB"","_$J_","""_LEXID_""","

 . 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 words beginning with character

 . . W:'$D(ZTQUEUED)&($D(LEXTEST)) LEXCHR

 . . N LEXLWRD,LEXTWRD,LEXIT

 . . S (LEXLWRD,LEXTWRD)=$C($A(LEXCHR)-1)_"~",LEXIT=0

 . . F  S LEXLWRD=$O(^LEX(757.21,LEXID,LEXLWRD)) D  Q:LEXIT>0

 . . . S:'$L(LEXLWRD) LEXIT=1 S:$E(LEXLWRD,1)'=LEXCHR LEXIT=1

 . . . Q:LEXIT>0  S LEX2=LEX2+1

 . . . ;         Delete words from the Subset

 . . . N LEXNOD,LEXCTL,LEXCMD

 . . . S LEXNOD="^LEX(757.21,"""_LEXID_""","""_LEXTWRD_""")"

 . . . S LEXCTL="^LEX(757.21,"""_LEXID_""","""_LEXTWRD_""","

 . . . F  S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL)  D

 . . . . S LEX3=LEX3+1

 . . . S LEXCMD="K ^LEX(757.21,"""_LEXID_""","""_LEXLWRD_""")"

 . . . X LEXCMD

 . . S LEXTWRD=$C($A(LEXCHR)-1)_"~",LEXIT=0

 . . F  S LEXTWRD=$O(^TMP("LEXSUB",$J,LEXID,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(""LEXSUB"","_$J_","""_LEXID_""","""_LEXTWRD_""")"

 . . . S LEXCTL="^TMP(""LEXSUB"","_$J_","""_LEXID_""","""_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.21,"""_LEXID_""","

 . . . . S LEXCMD=LEXCMD_$P(LEXNOD,",",4,229)_"="""""

 . . . . X LEXCMD S LEX4=LEX4+1

 . . ;       Repeat for all characters

 . ;     Repeat for all Subset Indexes

 H 1 S LEXEND=$$END^LEXXGP1 D SAV(LEXBEG,LEXEND,LEXTXT)

 S LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND),LEXBEGD=$$ED^LEXXGP1(LEXBEG)

 S LEXBEGT=$$ET^LEXXGP1(LEXBEG),LEXENDT=$$ET^LEXXGP1(LEXEND),LEXDF=$$DF^LEXXGP1(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_" Subset"_$S(LEX1>1:"s",1:"")

 . D SAV(LEXBEG,"","",LEXCOM)

 . W:'$D(ZTQUEUED) !,"   ",LEXCOM

 I LEX2>0,$D(LEXFUL) D

 . S LEXCOM=LEX2_" Word"_$S(LEX2>1:"s",1:"")

 . D SAV(LEXBEG,"","",LEXCOM)

 . W:'$D(ZTQUEUED) !,"   ",LEXCOM

 I LEX4>0,$D(LEXFUL) D

 . S LEXCOM=LEX4_" Subset Index Node"_$S(LEX4>1:"s",1:"")

 . D SAV(LEXBEG,"","",LEXCOM)

 . W:'$D(ZTQUEUED) !,"   ",LEXCOM

 N ZTQUEUED,LEXTEST,LEXFUL

 ; MailMan

XM ;   Mail Message

 N LEX1,LEX2,LEXB,LEXC,LEXD,LEXE,LEXJ,LEXMAIL,LEXN

 N LEXPRE,LEXNEW,LEXS,LEXT,LEXX,LEXI,LEXNM,XCNP

 N XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ

 D XMG K ^TMP("LEXXGPMSG",$J) N LEXI S LEXI=0

 F  S LEXI=$O(^TMP("LEXXGPRPT",$J,LEXI)) Q:+LEXI'>0  D

 . N LEXN,LEXT S LEXN=$O(^TMP("LEXXGPMSG",$J," "),-1)+1

 . S LEXT=$G(^TMP("LEXXGPRPT",$J,LEXI))

 . S ^TMP("LEXXGPMSG",$J,+LEXN)=$G(LEXT),^TMP("LEXXGPMSG",$J,0)=LEXN

 D:$O(^TMP("LEXXGPMSG",$J,0))>0 XMS

XMG ;   Get Data for Message

 K ^TMP("LEXXGPRPT",$J)

 N LEXO1,LEXTXT,LEXLN,LEXPDT S LEXPDT="",(LEXLN,LEXO1)=0

 F  S LEXO1=$O(^TMP("LEXXGPDAT",$J,LEXO1)) Q:+LEXO1'>0  D

 . N LEXO2 S LEXO2="" F  S LEXO2=$O(^TMP("LEXXGPDAT",$J,LEXO1,LEXO2)) Q:+LEXO2'>0  D

 . . N LEXN,LEXBEG,LEXBEGD,LEXDF,LEXBEGT,LEXEND,LEXENDD,LEXENDT,LEXTXT

 . . N LEXCOM,LEXHDR,LEXELPT

 . . S LEXNOD=$G(^TMP("LEXXGPDAT",$J,LEXO1,LEXO2)),LEXLN=LEXLN+1

 . . S LEXBEG=$P(LEXNOD,"^",1),LEXD=$P(LEXBEG,".",1),LEXCOM=$P(LEXNOD,"^",8)

 . . I $L(LEXBEG),LEXD?7N,$L(LEXCOM) D  Q

 . . . N LEXN S LEXN=$O(^TMP("LEXXGPRPT",$J," "),-1)+1

 . . . S ^TMP("LEXXGPRPT",$J,+LEXN)="   "_LEXCOM

 . . S LEXDF=$$DF^LEXXGP1(LEXBEG)

 . . S LEXEND=$P(LEXNOD,"^",2)

 . . S LEXBEGD=$P(LEXNOD,"^",3)

 . . S LEXBEGT=$P(LEXNOD,"^",4)

 . . S LEXENDT=$P(LEXNOD,"^",5)

 . . S LEXELPT=$P(LEXNOD,"^",6)

 . . S LEXTXT=$P(LEXNOD,"^",7)

 . . S:LEXBEGD=LEXPDT&($L(LEXDF))&(LEXD'["-") LEXBEGD=LEXDF

 . . S LEXPDT=$G(LEXBEGD)

 . . S LEXTXT=$$FMT^LEXXGP1($G(LEXTXT),LEXBEGD,LEXBEGT,LEXENDT,LEXELPT)

 . . I '$D(^TMP("LEXXGPRPT",$J)) D

 . . . S ^TMP("LEXXGPRPT",$J,0)=1,^TMP("LEXXGPRPT",$J,1)="  "

 . . . N LEXHDR S LEXHDR="Re-Index Repair"

 . . . S LEXHDR=$G(LEXHDR)_$J(" ",(35-$L($G(LEXHDR))))_"Date      "_"   "_"Start   "_"   "_"Finish  "_"   "_"Elapsed "

 . . . S LEXHDR=" "_LEXHDR S ^TMP("LEXXGPRPT",$J,0)=2,^TMP("LEXXGPRPT",$J,2)=LEXHDR

 . . . S LEXHDR="---------------------------------"

 . . . S LEXHDR=$G(LEXHDR)_$J(" ",(35-$L($G(LEXHDR))))_"----------"_"   "_"--------"_"   "_"--------"_"   "_"--------"

 . . . S LEXHDR=" "_LEXHDR S ^TMP("LEXXGPRPT",$J,0)=3,^TMP("LEXXGPRPT",$J,3)=LEXHDR

 . . S LEXN=$O(^TMP("LEXXGPRPT",$J," "),-1)+1

 . . S ^TMP("LEXXGPRPT",$J,0)=LEXN,^TMP("LEXXGPRPT",$J,LEXN)=" "_LEXTXT

 S LEXTXT=$$FMTT^LEXXGP1 I $L(LEXTXT) D

 . N LEXN,LEXHDR

 . S LEXHDR="---------------------------------"

 . S LEXHDR=$G(LEXHDR)_$J(" ",(35-$L($G(LEXHDR))))_"----------"_"   "_"--------"_"   "_"--------"_"   "_"--------"

 . S LEXN=$O(^TMP("LEXXGPRPT",$J," "),-1)+1

 . S ^TMP("LEXXGPRPT",$J,0)=LEXN,^TMP("LEXXGPRPT",$J,LEXN)=" "_LEXHDR

 . S LEXN=$O(^TMP("LEXXGPRPT",$J," "),-1)+1

 . S ^TMP("LEXXGPRPT",$J,0)=LEXN,^TMP("LEXXGPRPT",$J,LEXN)=" "_LEXTXT

XMGS ;   Show Message

 W:$O(^TMP("LEXXGPRPT",$J,0))>0 !

 N LEXC S LEXC=0 F  S LEXC=$O(^TMP("LEXXGPRPT",$J,LEXC)) Q:+LEXC'>0  D

 . N LEXT S LEXT=$G(^TMP("LEXXGPRPT",$J,LEXC)) W:$L(LEXT) !,LEXT

 W:$O(^TMP("LEXXGPRPT",$J,0))>0 !!

XMB ;   Build Message

 K ^TMP("LEXXGPMSG",$J) N LEXI S LEXI=0

 F  S LEXI=$O(^TMP("LEXXGPRPT",$J,LEXI)) Q:+LEXI'>0  D

 . N LEXN,LEXT S LEXN=$O(^TMP("LEXXGPMSG",$J," "),-1)+1

 . S LEXT=$G(^TMP("LEXXGPRPT",$J,LEXI))

 . S ^TMP("LEXXGPMSG",$J,+LEXN)=$G(LEXT),^TMP("LEXXGPMSG",$J,0)=LEXN

XMS ;   Send Message

 N XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMTEXT,XMDUZ,LEXJ,LEXNM

 Q:'$D(^TMP("LEXXGPMSG",$J))

 S XMTEXT="^TMP(""LEXXGPMSG"","_$J_",",XMSUB="Repair Major Word Indexes"

 S LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01) S:$D(LEXHOME) XMY(("G.LEXINS@"_$$XMA))=""

 S XMY(LEXNM)="",XMDUZ=.5 D ^XMD

 I '$D(ZTQUEUED),+($G(XMZ))>0 D

 . W !!," Lexicon Index Repair Message #",($G(XMZ))," sent"

XMSQ ;   Send Message (Quit)

 K ^TMP("LEXXGPMSG",$J),LEXNM

XMA(LEX) ;   Message Address

 N DIC,DTOUT,DUOUT,X,Y S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX

 S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX

 Q "ISC-SLC.DOMAIN.EXT"

 ; Miscellaneous

SAV(LEXBEG,LEXEND,LEXTXT,LEXCOM) ;   Save Dates, Times and Text

 N LEXTMP,LEXBEGD,LEXBEGT,LEXENDD,LEXENDT,LEXP,LEXD,LEXC,LEXN,LEXELP

 S LEXBEG=$G(LEXBEG),LEXCOM=$G(LEXCOM)

 S LEXD=$P(LEXBEG,".",1) Q:LEXD'?7N

 I $L(LEXD),$L(LEXBEG),$L(LEXCOM) D  Q

 . N LEXN S LEXN=$O(^TMP("LEXXGPDAT",$J,LEXD," "),-1)+1

 . S ^TMP("LEXXGPDAT",$J,LEXD,+LEXN)=LEXBEG_"^^^^^^^"_LEXCOM

 S LEXEND=$G(LEXEND),LEXTXT=$G(LEXTXT)

 Q:$P(LEXEND,".",1)'?7N  Q:'$L(LEXTXT)

 S LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND),LEXBEGD=$$ED^LEXXGP1(LEXBEG)

 S LEXBEGT=$$ET^LEXXGP1(LEXBEG),LEXENDT=$$ET^LEXXGP1(LEXEND)

 S LEXBEGD=$$DF^LEXXGP1(LEXBEG),LEXN=$O(^TMP("LEXXGPDAT",$J,LEXD," "),-1)+1

 S LEXTMP=LEXBEG_"^"_LEXEND_"^"_LEXBEGD_"^"_LEXBEGT_"^"_LEXENDT

 S LEXTMP=LEXTMP_"^"_LEXELP_"^"_LEXTXT

 S ^TMP("LEXXGPDAT",$J,LEXD,+LEXN)=LEXTMP

SSF ;   Subsets (Fileman)

 N LEX F LEX="AADM","AASS","AATT","ABDS","ACLF","ACLL","ACLS","ACON","ADEN","ADIS","AENL","AENV","AETH","AEVE","AFND","AFOR" K ^LEX(757.21,LEX)

 F LEX="AGEO","AIMM","AINA","ALIF","AMAB","ANAM","ANAV","ANUR","AOBJ","AOBS","AOCC","AORG","APER","APLS","APRC","APRD" K ^LEX(757.21,LEX)

 F LEX="AQUV","AREC","AREG","AREL","ASCH","ASCT","ASIT","ASOC","ASPC","ASPL","ASTG","ASUB","ATMR","B","C" K ^LEX(757.21,LEX)

 N DIK,ZTQUEUED S ZTQUEUED="" S DIK="^LEX(757.21," D IXALL^DIK

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[HLEXXGP3   14344     printed  Feb 18, 2025@23:36:21                                                                                                                                                                                                    Page 2

LEXXGP3   ;ISL/KER - Global Post-Install (Repair Subsets) ;05/23/2017

 +1       ;;2.0;LEXICON UTILITY;**86,103**;Sep 23, 1996;Build 2

 +2       ;

 +3       ;

 +4       ; Global Variables

 +5       ;    ^TMP("LEXAWRD")     SACC 2.3.2.5.1

 +6       ;    ^TMP("LEXAWRDU")    SACC 2.3.2.5.1

 +7       ;    ^TMP("LEXSUB")      SACC 2.3.2.5.1

 +8       ;    ^TMP("LEXTKN")      SACC 2.3.2.5.1

 +9       ;    ^TMP("LEXXGPDAT")   SACC 2.3.2.5.1

 +10      ;    ^TMP("LEXXGPMSG")   SACC 2.3.2.5.1

 +11      ;    ^TMP("LEXXGPRPT")   SACC 2.3.2.5.1

 +12      ;    ^TMP("LEXXGPTIM")   SACC 2.3.2.5.1

 +13      ;

 +14      ; External References

 +15      ;    $$S^%ZTLOAD         ICR  10063

 +16      ;    ^DIC                ICR  10006

 +17      ;    IXALL^DIK           ICR  10013

 +18      ;    $$GET1^DIQ          ICR   2056

 +19      ;    $$UP^XLFSTR         ICR  10104

 +20      ;    ^XMD                ICR  10070

 +21      ;

 +22      ; Local Variables NEWed or KILLed in LEXXGP1

 +23      ;     ZTSK

 +24      ;

 +25      ; Special Variables set in the Post-Install Routines

 +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.DOMAIN.EXT

 +34      ;              (see entry point POST2)

 +35      ;

 +36       QUIT

SUB       ; Subset file Indexes Aaaa

 +1        NEW LEXBEG,LEXBEGD,LEXBEGT,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT

 +2        NEW LEXTMP,LEXTXT

           SET LEXTXT="Subset Indexes"

 +3        if '$DATA(LEXQUIT)

               SET LEXQUIT="SUB"

           KILL ^TMP("LEXSUB",$JOB)

 +4        SET LEXBEG=$$BEG^LEXXGP1

           DO ASUBB

           HANG 1

           SET LEXEND=$$END^LEXXGP1

 +5        DO SAV(LEXBEG,LEXEND,LEXTXT)

           SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)

 +6        SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)

           SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)

           SET LEXENDT=$$ET^LEXXGP1(LEXEND)

 +7        SET LEXDF=$$DF^LEXXGP1(LEXBEG)

           SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))

 +8        SET LEXTXT=LEXTXT_LEXDF_"   "_LEXBEGT_"   "_LEXENDT_"   "_LEXELP

 +9        SET LEXTXT=" "_LEXTXT

           if '$DATA(ZTQUEUED)

               WRITE !,LEXTXT

 +10       NEW ZTQUEUED,LEXTEST

 +11       IF $GET(LEXQUIT)="SUB"

               Begin DoDot:1

 +12               if $DATA(LEXMAIL)

                       DO XM

 +13               KILL ^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB),^TMP("LEXSUB",$JOB),^TMP("LEXTKN",$JOB)

 +14               KILL ^TMP("LEXXGPDAT",$JOB),^TMP("LEXXGPTIM",$JOB),^TMP("LEXXGPRPT",$JOB)

 +15               if '$DATA(LEXMAIL)

                       KILL ^TMP("LEXXGPMSG",$JOB)

 +16               KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME

               End DoDot:1

 +17       QUIT

ASUBB     ;   ASUB Word Index Build                        11.5 minutes

 +1       ;     Create the AWRD Index in the ^TMP global

 +2        NEW LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT,LEXEX

 +3        NEW LEXEXP,LEXTEXP,LEXIDX,LEXMC,LEXMCEI,LEXMCI,LEXRI,LEXSI,LEXSUB

 +4        NEW LEXTKC,LEXTKN,LEXTXT,X

 +5        KILL ^TMP("LEXSUB",$JOB)

           if '$DATA(LEXQUIT)

               SET LEXQUIT="ASUBB"

 +6        SET LEXBEG=$$BEG^LEXXGP1

           SET LEXSUB=0

           SET LEXTXT="Build 'ASUB' Word Index"

 +7        IF +($GET(ZTSK))>0

               SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.21"))

 +8        FOR

               SET LEXSUB=$ORDER(^LEX(757.21,LEXSUB))

               if +LEXSUB'>0

                   QUIT

               Begin DoDot:1

 +9                NEW X,LEXEX,LEXEXP,LEXIDX,LEXMCI,LEXMCEI,LEXSI,LEXTKN

 +10               NEW LEXTKC,LEXNAM,LEXINAM,LEXNOD,LEXRP,LEXTTYP,LEXTEXP

                   SET LEXTEXP=0

 +11               SET LEXNOD=$GET(^LEX(757.21,LEXSUB,0))

                   SET LEXEX=+LEXNOD

 +12               SET LEXNAM=+($PIECE(LEXNOD,"^",2))

 +13               SET LEXNAM=$PIECE($GET(^LEXT(757.2,+LEXNAM,0)),"^",2)

 +14               if $LENGTH(LEXNAM)'=3

                       QUIT

                   SET LEXINAM="A"_LEXNAM

 +15               SET LEXEXP=$$UP^XLFSTR($GET(^LEX(757.01,LEXEX,0)))

                   if '$LENGTH(LEXEXP)

                       QUIT

 +16               SET LEXMCI=+($PIECE($GET(^LEX(757.01,LEXEX,1)),"^",1))

                   if +LEXMCI'>0

                       QUIT

 +17               SET LEXTTYP=+($PIECE($GET(^LEX(757.01,LEXEX,1)),"^",2))

 +18               SET LEXMCEI=$PIECE($GET(^LEX(757,LEXMCI,0)),"^",1)

                   if +LEXMCEI'>0

                       QUIT

 +19               FOR

                       SET LEXTEXP=$ORDER(^LEX(757.01,"AMC",LEXMCI,LEXTEXP))

                       if +LEXTEXP=0

                           QUIT

                       Begin DoDot:2

 +20                       NEW LEXEXP,X,LEXIDX,LEXLOOK,LEXEXPT,LEXRP,LEXDEA,LEXTTYP

 +21                       SET LEXDEA=$$DEA(+LEXTEXP)

                           if LEXDEA>0

                               QUIT

 +22                       SET LEXTTYP=+($PIECE($GET(^LEX(757.01,LEXTEXP,1)),"^",2))

                           if LEXTTYP=8

                               QUIT

 +23                       SET (LEXEXP,X)=^LEX(757.01,LEXTEXP,0)

 +24                       KILL ^TMP("LEXTKN",$JOB)

                           SET LEXIDX=""

                           DO PTX^LEXTOKN

 +25      ;     Supplemental Words

 +26                       IF $DATA(^LEX(757.01,LEXTEXP,5))

                               Begin DoDot:3

 +27                               NEW LEXV,LEXEXPT

                                   SET LEXV=""

 +28                               FOR

                                       SET LEXV=$ORDER(^LEX(757.01,LEXTEXP,5,"B",LEXV))

                                       if LEXV=""

                                           QUIT

                                       Begin DoDot:4

 +29                                       NEW LEXC

                                           SET LEXC=$ORDER(^TMP("LEXTKN",$JOB," "),-1)+1

 +30                                       SET ^TMP("LEXTKN",$JOB,LEXC,LEXV)=""

 +31                                       SET ^TMP("LEXTKN",$JOB,0)=LEXC

                                       End DoDot:4

                               End DoDot:3

 +32      ;     Replacement Words

 +33                       IF $DATA(^LEX(757.05,"AEXP",LEXTEXP))

                               NEW LEXRP

                               SET LEXRP=0

                               Begin DoDot:3

 +34                               FOR

                                       SET LEXRP=$ORDER(^LEX(757.05,"AEXP",LEXTEXP,LEXRP))

                                       if +LEXRP'>0

                                           QUIT

                                       Begin DoDot:4

 +35                                       NEW LEXV,LEXC

 +36                                       SET LEXV=$PIECE(^LEX(757.05,LEXRP,0),U)

                                           if '$LENGTH(LEXV)

                                               QUIT

 +37                                       SET LEXC=$ORDER(^TMP("LEXTKN",$JOB," "),-1)+1

 +38                                       SET ^TMP("LEXTKN",$JOB,LEXC,LEXV)=""

 +39                                       SET ^TMP("LEXTKN",$JOB,0)=LEXC

                                       End DoDot:4

                               End DoDot:3

 +40                       IF $DATA(^TMP("LEXTKN",$JOB,0))

                               IF ^TMP("LEXTKN",$JOB,0)>0

                                   Begin DoDot:3

 +41                                   SET LEXTKN=""

                                       SET LEXTKC=0

 +42                                   FOR

                                           SET LEXTKC=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC))

                                           if +LEXTKC'>0

                                               QUIT

                                           Begin DoDot:4

 +43                                           SET LEXTKN=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC,""))

                                               if '$LENGTH(LEXTKN)

                                                   QUIT

 +44                                           SET ^TMP("LEXSUB",$JOB,LEXINAM,LEXTKN,LEXSUB)=""

                                           End DoDot:4

                                   End DoDot:3

 +45                       KILL ^TMP("LEXTKN",$JOB)

                       End DoDot:2

               End DoDot:1

 +46       KILL ^TMP("LEXTKN",$JOB)

           HANG 1

           SET LEXEND=$$END^LEXXGP1

           DO SAV(LEXBEG,LEXEND,LEXTXT)

 +47       SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)

           SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)

 +48       SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)

           SET LEXENDT=$$ET^LEXXGP1(LEXEND)

           SET LEXDF=$$DF^LEXXGP1(LEXBEG)

 +49       SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))

 +50       SET LEXTXT=LEXTXT_LEXDF_"   "_LEXBEGT_"   "_LEXENDT_"   "_LEXELP

 +51       SET LEXTXT=" "_LEXTXT

           if '$DATA(ZTQUEUED)

               WRITE !,LEXTXT

 +52       DO ASUBR

           NEW ZTQUEUED,LEXTEST

 +53       IF $GET(LEXQUIT)="ASUBB"

               Begin DoDot:1

 +54               if $DATA(LEXMAIL)

                       DO XM

 +55               KILL ^TMP("LEXAWRD"),^TMP("LEXSUB"),^TMP("LEXTKN")

 +56               KILL ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")

 +57               KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME

               End DoDot:1

 +58       QUIT

ASUBR     ;   ASUB Word Index Replace                       1.5 minutes

 +1        NEW LEX1,LEX2,LEX3,LEX4,LEXBEG,LEXBEGD,LEXBEGT,LEXCHK,LEXCHR,LEXCHRS,LEXIDS

 +2        NEW LEXCMD,LEXCOM,LEXCTL,LEXDF,LEXELP,LEXEND,LEXENDD,LEXENDT

 +3        NEW LEXLWRD,LEXNOD,LEXRT,LEXRT1,LEXRT2,LEXTK,LEXTMP,LEXTWRD

 +4        NEW LEXTXT,LEXID

           SET (LEX1,LEX2,LEX3,LEX4)=0

           if '$DATA(LEXQUIT)

               QUIT

 +5        SET LEXBEG=$$BEG^LEXXGP1

           SET LEXTXT="Replace 'ASUB' Word Index"

           KILL LEXIDS

 +6        IF +($GET(ZTSK))>0

               SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.21"))

 +7        SET LEXTMP=" "

FOR

               SET LEXTMP=$ORDER(^LEX(757.21,LEXTMP))

               if '$LENGTH(LEXTMP)

                   QUIT

               Begin DoDot:1

 +8                if $EXTRACT(LEXTMP,1)="A"

                       SET LEXIDS(LEXTMP)=""

               End DoDot:1

 +9        SET LEXTMP=" "

 +10       FOR

               SET LEXTMP=$ORDER(^TMP("LEXSUB",$JOB,LEXTMP))

               if '$LENGTH(LEXTMP)

                   QUIT

               Begin DoDot:1

 +11               if $EXTRACT(LEXTMP,1)="A"

                       SET LEXIDS(LEXTMP)=""

               End DoDot:1

 +12       SET LEXID=""

FOR

               SET LEXID=$ORDER(LEXIDS(LEXID))

               if '$LENGTH(LEXID)

                   QUIT

               Begin DoDot:1

 +13      ;     For Subset Index

 +14               if '$DATA(ZTQUEUED)&($DATA(LEXTEST))

                       WRITE !,LEXID," "

                   SET LEX1=LEX1+1

 +15               KILL LEXCHRS

                   SET LEXRT1="^LEX(757.21,"""_LEXID_""","

 +16               SET LEXRT2="^TMP(""LEXSUB"","_$JOB_","""_LEXID_""","

 +17               FOR LEXRT=LEXRT1,LEXRT2

                       Begin DoDot:2

 +18                       NEW LEXTK

                           SET LEXTK=""

 +19                       FOR

                               SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))

                               if '$LENGTH(LEXTK)

                                   QUIT

                               Begin DoDot:3

 +20                               NEW LEXCHR

                                   SET LEXCHR=$EXTRACT($TRANSLATE(LEXTK," ",""),1)

 +21                               SET LEXTK=$EXTRACT(LEXTK,1)_"~"

                                   if $LENGTH(LEXCHR)

                                       SET LEXCHRS(LEXCHR)=""

                               End DoDot:3

                       End DoDot:2

 +22               SET LEXCHR=""

FOR

                       SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))

                       if '$LENGTH(LEXCHR)

                           QUIT

                       Begin DoDot:2

 +23      ;       For words beginning with character

 +24                       if '$DATA(ZTQUEUED)&($DATA(LEXTEST))

                               WRITE LEXCHR

 +25                       NEW LEXLWRD,LEXTWRD,LEXIT

 +26                       SET (LEXLWRD,LEXTWRD)=$CHAR($ASCII(LEXCHR)-1)_"~"

                           SET LEXIT=0

 +27                       FOR

                               SET LEXLWRD=$ORDER(^LEX(757.21,LEXID,LEXLWRD))

                               Begin DoDot:3

 +28                               if '$LENGTH(LEXLWRD)

                                       SET LEXIT=1

                                   if $EXTRACT(LEXLWRD,1)'=LEXCHR

                                       SET LEXIT=1

 +29                               if LEXIT>0

                                       QUIT

                                   SET LEX2=LEX2+1

 +30      ;         Delete words from the Subset

 +31                               NEW LEXNOD,LEXCTL,LEXCMD

 +32                               SET LEXNOD="^LEX(757.21,"""_LEXID_""","""_LEXTWRD_""")"

 +33                               SET LEXCTL="^LEX(757.21,"""_LEXID_""","""_LEXTWRD_""","

 +34                               FOR

                                       SET LEXNOD=$QUERY(@LEXNOD)

                                       if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)

                                           QUIT

                                       Begin DoDot:4

 +35                                       SET LEX3=LEX3+1

                                       End DoDot:4

 +36                               SET LEXCMD="K ^LEX(757.21,"""_LEXID_""","""_LEXLWRD_""")"

 +37                               XECUTE LEXCMD

                               End DoDot:3

                               if LEXIT>0

                                   QUIT

 +38                       SET LEXTWRD=$CHAR($ASCII(LEXCHR)-1)_"~"

                           SET LEXIT=0

 +39                       FOR

                               SET LEXTWRD=$ORDER(^TMP("LEXSUB",$JOB,LEXID,LEXTWRD))

                               Begin DoDot:3

 +40                               if '$LENGTH(LEXTWRD)

                                       SET LEXIT=1

                                   if $EXTRACT(LEXTWRD,1)'=LEXCHR

                                       SET LEXIT=1

 +41                               if LEXIT>0

                                       QUIT

                                   NEW LEXNOD,LEXCTL

 +42                               SET LEXNOD="^TMP(""LEXSUB"","_$JOB_","""_LEXID_""","""_LEXTWRD_""")"

 +43                               SET LEXCTL="^TMP(""LEXSUB"","_$JOB_","""_LEXID_""","""_LEXTWRD_""","

 +44                               FOR

                                       SET LEXNOD=$QUERY(@LEXNOD)

                                       if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)

                                           QUIT

                                       Begin DoDot:4

 +45      ;         Copy Index from ^TMP to ^LEX

 +46                                       NEW LEXCMD

                                           SET LEXCMD="S ^LEX(757.21,"""_LEXID_""","

 +47                                       SET LEXCMD=LEXCMD_$PIECE(LEXNOD,",",4,229)_"="""""

 +48                                       XECUTE LEXCMD

                                           SET LEX4=LEX4+1

                                       End DoDot:4

                               End DoDot:3

                               if LEXIT>0

                                   QUIT

 +49      ;       Repeat for all characters

                       End DoDot:2

 +50      ;     Repeat for all Subset Indexes

               End DoDot:1

 +51       HANG 1

           SET LEXEND=$$END^LEXXGP1

           DO SAV(LEXBEG,LEXEND,LEXTXT)

 +52       SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)

           SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)

 +53       SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)

           SET LEXENDT=$$ET^LEXXGP1(LEXEND)

           SET LEXDF=$$DF^LEXXGP1(LEXBEG)

 +54       SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))

 +55       SET LEXTXT=LEXTXT_LEXDF_"   "_LEXBEGT_"   "_LEXENDT_"   "_LEXELP

 +56       SET LEXTXT=" "_LEXTXT

           if '$DATA(ZTQUEUED)

               WRITE !,LEXTXT

 +57       IF LEX1>0

               IF $DATA(LEXFUL)

                   Begin DoDot:1

 +58                   SET LEXCOM=LEX1_" Subset"_$SELECT(LEX1>1:"s",1:"")

 +59                   DO SAV(LEXBEG,"","",LEXCOM)

 +60                   if '$DATA(ZTQUEUED)

                           WRITE !,"   ",LEXCOM

                   End DoDot:1

 +61       IF LEX2>0

               IF $DATA(LEXFUL)

                   Begin DoDot:1

 +62                   SET LEXCOM=LEX2_" Word"_$SELECT(LEX2>1:"s",1:"")

 +63                   DO SAV(LEXBEG,"","",LEXCOM)

 +64                   if '$DATA(ZTQUEUED)

                           WRITE !,"   ",LEXCOM

                   End DoDot:1

 +65       IF LEX4>0

               IF $DATA(LEXFUL)

                   Begin DoDot:1

 +66                   SET LEXCOM=LEX4_" Subset Index Node"_$SELECT(LEX4>1:"s",1:"")

 +67                   DO SAV(LEXBEG,"","",LEXCOM)

 +68                   if '$DATA(ZTQUEUED)

                           WRITE !,"   ",LEXCOM

                   End DoDot:1

 +69       NEW ZTQUEUED,LEXTEST,LEXFUL

 +70       QUIT

 +71      ;

 +72      ; MailMan

XM        ;   Mail Message

 +1        NEW LEX1,LEX2,LEXB,LEXC,LEXD,LEXE,LEXJ,LEXMAIL,LEXN

 +2        NEW LEXPRE,LEXNEW,LEXS,LEXT,LEXX,LEXI,LEXNM,XCNP

 +3        NEW XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ

 +4        DO XMG

           KILL ^TMP("LEXXGPMSG",$JOB)

           NEW LEXI

           SET LEXI=0

 +5        FOR

               SET LEXI=$ORDER(^TMP("LEXXGPRPT",$JOB,LEXI))

               if +LEXI'>0

                   QUIT

               Begin DoDot:1

 +6                NEW LEXN,LEXT

                   SET LEXN=$ORDER(^TMP("LEXXGPMSG",$JOB," "),-1)+1

 +7                SET LEXT=$GET(^TMP("LEXXGPRPT",$JOB,LEXI))

 +8                SET ^TMP("LEXXGPMSG",$JOB,+LEXN)=$GET(LEXT)

                   SET ^TMP("LEXXGPMSG",$JOB,0)=LEXN

               End DoDot:1

 +9        if $ORDER(^TMP("LEXXGPMSG",$JOB,0))>0

               DO XMS

 +10       QUIT

XMG       ;   Get Data for Message

 +1        KILL ^TMP("LEXXGPRPT",$JOB)

 +2        NEW LEXO1,LEXTXT,LEXLN,LEXPDT

           SET LEXPDT=""

           SET (LEXLN,LEXO1)=0

 +3        FOR

               SET LEXO1=$ORDER(^TMP("LEXXGPDAT",$JOB,LEXO1))

               if +LEXO1'>0

                   QUIT

               Begin DoDot:1

 +4                NEW LEXO2

                   SET LEXO2=""

FOR

                       SET LEXO2=$ORDER(^TMP("LEXXGPDAT",$JOB,LEXO1,LEXO2))

                       if +LEXO2'>0

                           QUIT

                       Begin DoDot:2

 +5                        NEW LEXN,LEXBEG,LEXBEGD,LEXDF,LEXBEGT,LEXEND,LEXENDD,LEXENDT,LEXTXT

 +6                        NEW LEXCOM,LEXHDR,LEXELPT

 +7                        SET LEXNOD=$GET(^TMP("LEXXGPDAT",$JOB,LEXO1,LEXO2))

                           SET LEXLN=LEXLN+1

 +8                        SET LEXBEG=$PIECE(LEXNOD,"^",1)

                           SET LEXD=$PIECE(LEXBEG,".",1)

                           SET LEXCOM=$PIECE(LEXNOD,"^",8)

 +9                        IF $LENGTH(LEXBEG)

                               IF LEXD?7N

                                   IF $LENGTH(LEXCOM)

                                       Begin DoDot:3

 +10                                       NEW LEXN

                                           SET LEXN=$ORDER(^TMP("LEXXGPRPT",$JOB," "),-1)+1

 +11                                       SET ^TMP("LEXXGPRPT",$JOB,+LEXN)="   "_LEXCOM

                                       End DoDot:3

                                       QUIT

 +12                       SET LEXDF=$$DF^LEXXGP1(LEXBEG)

 +13                       SET LEXEND=$PIECE(LEXNOD,"^",2)

 +14                       SET LEXBEGD=$PIECE(LEXNOD,"^",3)

 +15                       SET LEXBEGT=$PIECE(LEXNOD,"^",4)

 +16                       SET LEXENDT=$PIECE(LEXNOD,"^",5)

 +17                       SET LEXELPT=$PIECE(LEXNOD,"^",6)

 +18                       SET LEXTXT=$PIECE(LEXNOD,"^",7)

 +19                       if LEXBEGD=LEXPDT&($LENGTH(LEXDF))&(LEXD'["-")

                               SET LEXBEGD=LEXDF

 +20                       SET LEXPDT=$GET(LEXBEGD)

 +21                       SET LEXTXT=$$FMT^LEXXGP1($GET(LEXTXT),LEXBEGD,LEXBEGT,LEXENDT,LEXELPT)

 +22                       IF '$DATA(^TMP("LEXXGPRPT",$JOB))

                               Begin DoDot:3

 +23                               SET ^TMP("LEXXGPRPT",$JOB,0)=1

                                   SET ^TMP("LEXXGPRPT",$JOB,1)="  "

 +24                               NEW LEXHDR

                                   SET LEXHDR="Re-Index Repair"

 +25                               SET LEXHDR=$GET(LEXHDR)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXHDR))))_"Date      "_"   "_"Start   "_"   "_"Finish  "_"   "_"Elapsed "

 +26                               SET LEXHDR=" "_LEXHDR

                                   SET ^TMP("LEXXGPRPT",$JOB,0)=2

                                   SET ^TMP("LEXXGPRPT",$JOB,2)=LEXHDR

 +27                               SET LEXHDR="---------------------------------"

 +28                               SET LEXHDR=$GET(LEXHDR)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXHDR))))_"----------"_"   "_"--------"_"   "_"--------"_"   "_"--------"

 +29                               SET LEXHDR=" "_LEXHDR

                                   SET ^TMP("LEXXGPRPT",$JOB,0)=3

                                   SET ^TMP("LEXXGPRPT",$JOB,3)=LEXHDR

                               End DoDot:3

 +30                       SET LEXN=$ORDER(^TMP("LEXXGPRPT",$JOB," "),-1)+1

 +31                       SET ^TMP("LEXXGPRPT",$JOB,0)=LEXN

                           SET ^TMP("LEXXGPRPT",$JOB,LEXN)=" "_LEXTXT

                       End DoDot:2

               End DoDot:1

 +32       SET LEXTXT=$$FMTT^LEXXGP1

           IF $LENGTH(LEXTXT)

               Begin DoDot:1

 +33               NEW LEXN,LEXHDR

 +34               SET LEXHDR="---------------------------------"

 +35               SET LEXHDR=$GET(LEXHDR)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXHDR))))_"----------"_"   "_"--------"_"   "_"--------"_"   "_"--------"

 +36               SET LEXN=$ORDER(^TMP("LEXXGPRPT",$JOB," "),-1)+1

 +37               SET ^TMP("LEXXGPRPT",$JOB,0)=LEXN

                   SET ^TMP("LEXXGPRPT",$JOB,LEXN)=" "_LEXHDR

 +38               SET LEXN=$ORDER(^TMP("LEXXGPRPT",$JOB," "),-1)+1

 +39               SET ^TMP("LEXXGPRPT",$JOB,0)=LEXN

                   SET ^TMP("LEXXGPRPT",$JOB,LEXN)=" "_LEXTXT

               End DoDot:1

 +40       QUIT

XMGS      ;   Show Message

 +1        if $ORDER(^TMP("LEXXGPRPT",$JOB,0))>0

               WRITE !

 +2        NEW LEXC

           SET LEXC=0

FOR

               SET LEXC=$ORDER(^TMP("LEXXGPRPT",$JOB,LEXC))

               if +LEXC'>0

                   QUIT

               Begin DoDot:1

 +3                NEW LEXT

                   SET LEXT=$GET(^TMP("LEXXGPRPT",$JOB,LEXC))

                   if $LENGTH(LEXT)

                       WRITE !,LEXT

               End DoDot:1

 +4        if $ORDER(^TMP("LEXXGPRPT",$JOB,0))>0

               WRITE !!

 +5        QUIT

XMB       ;   Build Message

 +1        KILL ^TMP("LEXXGPMSG",$JOB)

           NEW LEXI

           SET LEXI=0

 +2        FOR

               SET LEXI=$ORDER(^TMP("LEXXGPRPT",$JOB,LEXI))

               if +LEXI'>0

                   QUIT

               Begin DoDot:1

 +3                NEW LEXN,LEXT

                   SET LEXN=$ORDER(^TMP("LEXXGPMSG",$JOB," "),-1)+1

 +4                SET LEXT=$GET(^TMP("LEXXGPRPT",$JOB,LEXI))

 +5                SET ^TMP("LEXXGPMSG",$JOB,+LEXN)=$GET(LEXT)

                   SET ^TMP("LEXXGPMSG",$JOB,0)=LEXN

               End DoDot:1

 +6        QUIT

XMS       ;   Send Message

 +1        NEW XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMTEXT,XMDUZ,LEXJ,LEXNM

 +2        if '$DATA(^TMP("LEXXGPMSG",$JOB))

               QUIT

 +3        SET XMTEXT="^TMP(""LEXXGPMSG"","_$JOB_","

           SET XMSUB="Repair Major Word Indexes"

 +4        SET LEXNM=$$GET1^DIQ(200,+($GET(DUZ)),.01)

           if $DATA(LEXHOME)

               SET XMY(("G.LEXINS@"_$$XMA))=""

 +5        SET XMY(LEXNM)=""

           SET XMDUZ=.5

           DO ^XMD

 +6        IF '$DATA(ZTQUEUED)

               IF +($GET(XMZ))>0

                   Begin DoDot:1

 +7                    WRITE !!," Lexicon Index Repair Message #",($GET(XMZ))," sent"

                   End DoDot:1

XMSQ      ;   Send Message (Quit)

 +1        KILL ^TMP("LEXXGPMSG",$JOB),LEXNM

 +2        QUIT

XMA(LEX)  ;   Message Address

 +1        NEW DIC,DTOUT,DUOUT,X,Y

           SET DIC="^DIC(4.2,"

           SET DIC(0)="M"

           SET (LEX,X)="FO-SLC.DOMAIN.EXT"

           DO ^DIC

           if +Y>0

               QUIT LEX

 +2        SET DIC="^DIC(4.2,"

           SET DIC(0)="M"

           SET (LEX,X)="ISC-SLC.DOMAIN.EXT"

           DO ^DIC

           if +Y>0

               QUIT LEX

 +3        QUIT "ISC-SLC.DOMAIN.EXT"

 +4       ;

 +5       ; Miscellaneous

SAV(LEXBEG,LEXEND,LEXTXT,LEXCOM) ;   Save Dates, Times and Text

 +1        NEW LEXTMP,LEXBEGD,LEXBEGT,LEXENDD,LEXENDT,LEXP,LEXD,LEXC,LEXN,LEXELP

 +2        SET LEXBEG=$GET(LEXBEG)

           SET LEXCOM=$GET(LEXCOM)

 +3        SET LEXD=$PIECE(LEXBEG,".",1)

           if LEXD'?7N

               QUIT

 +4        IF $LENGTH(LEXD)

               IF $LENGTH(LEXBEG)

                   IF $LENGTH(LEXCOM)

                       Begin DoDot:1

 +5                        NEW LEXN

                           SET LEXN=$ORDER(^TMP("LEXXGPDAT",$JOB,LEXD," "),-1)+1

 +6                        SET ^TMP("LEXXGPDAT",$JOB,LEXD,+LEXN)=LEXBEG_"^^^^^^^"_LEXCOM

                       End DoDot:1

                       QUIT

 +7        SET LEXEND=$GET(LEXEND)

           SET LEXTXT=$GET(LEXTXT)

 +8        if $PIECE(LEXEND,".",1)'?7N

               QUIT

           if '$LENGTH(LEXTXT)

               QUIT

 +9        SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)

           SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)

 +10       SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)

           SET LEXENDT=$$ET^LEXXGP1(LEXEND)

 +11       SET LEXBEGD=$$DF^LEXXGP1(LEXBEG)

           SET LEXN=$ORDER(^TMP("LEXXGPDAT",$JOB,LEXD," "),-1)+1

 +12       SET LEXTMP=LEXBEG_"^"_LEXEND_"^"_LEXBEGD_"^"_LEXBEGT_"^"_LEXENDT

 +13       SET LEXTMP=LEXTMP_"^"_LEXELP_"^"_LEXTXT

 +14       SET ^TMP("LEXXGPDAT",$JOB,LEXD,+LEXN)=LEXTMP

 +15       QUIT

SSF       ;   Subsets (Fileman)

 +1        NEW LEX

           FOR LEX="AADM","AASS","AATT","ABDS","ACLF","ACLL","ACLS","ACON","ADEN","ADIS","AENL","AENV","AETH","AEVE","AFND","AFOR"

               KILL ^LEX(757.21,LEX)

 +2        FOR LEX="AGEO","AIMM","AINA","ALIF","AMAB","ANAM","ANAV","ANUR","AOBJ","AOBS","AOCC","AORG","APER","APLS","APRC","APRD"

               KILL ^LEX(757.21,LEX)

 +3        FOR LEX="AQUV","AREC","AREG","AREL","ASCH","ASCT","ASIT","ASOC","ASPC","ASPL","ASTG","ASUB","ATMR","B","C"

               KILL ^LEX(757.21,LEX)

 +4        NEW DIK,ZTQUEUED

           SET ZTQUEUED=""

           SET DIK="^LEX(757.21,"

           DO IXALL^DIK

 +5        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

LEXXGP3.m