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)
;
Q
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
Q
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
Q
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
Q
;
; 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
Q
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
Q
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 !!
Q
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
Q
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
Q
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
Q
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
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[HLEXXGP3 14344 printed Apr 09, 2024@21:14:38 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
