LEXXGP2 ;ISL/KER - Global Post-Install (Repair Subsets) ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^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
;
; 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 Elsewhere
;
; LEXMAIL Set and Killed by the developer, used to
; report the timing of the task and
; send to the user by MailMan message
;
; LEXHOME Set and Killed by the developer in the
; post-install, used to send the timing
; message to G.LEXINS@FO-SLC.MED.VA.GOV
; (see entry point POST2)
;
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"),^TMP("LEXSUB"),^TMP("LEXTKN")
. K ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
. K:'$D(LEXMAIL) ^TMP("LEXXGPMSG")
. 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,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 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
. . Q:$P($G(^LEX(757.01,+LEXTEXP,1)),"^",5)>0
. . 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") 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") 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,XMY,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) K XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,LEXNM
Q
XMA(LEX) ; Message Address
N DIC,DTOUT,DUOUT,X,Y S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.MED.VA.GOV" D ^DIC Q:+Y>0 LEX
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.MED.VA.GOV" D ^DIC Q:+Y>0 LEX
Q "ISC-SLC.VA.GOV"
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
; 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
LEXXGP2 ;ISL/KER - Global Post-Install (Repair Subsets) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXSUB") SACC 2.3.2.5.1
+5 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+6 ; ^TMP("LEXXGPDAT") SACC 2.3.2.5.1
+7 ; ^TMP("LEXXGPMSG") SACC 2.3.2.5.1
+8 ; ^TMP("LEXXGPRPT") SACC 2.3.2.5.1
+9 ;
+10 ; External References
+11 ; $$S^%ZTLOAD ICR 10063
+12 ; ^DIC ICR 10006
+13 ; IXALL^DIK ICR 10013
+14 ; $$GET1^DIQ ICR 2056
+15 ; $$UP^XLFSTR ICR 10104
+16 ; ^XMD ICR 10070
+17 ;
+18 ; Local Variables NEWed or KILLed Elsewhere
+19 ;
+20 ; LEXMAIL Set and Killed by the developer, used to
+21 ; report the timing of the task and
+22 ; send to the user by MailMan message
+23 ;
+24 ; LEXHOME Set and Killed by the developer in the
+25 ; post-install, used to send the timing
+26 ; message to G.LEXINS@FO-SLC.MED.VA.GOV
+27 ; (see entry point POST2)
+28 ;
+29 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"),^TMP("LEXSUB"),^TMP("LEXTKN")
+14 KILL ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
+15 IF '$DATA(LEXMAIL)
KILL ^TMP("LEXXGPMSG")
+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,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 LEXMCEI=$PIECE($GET(^LEX(757,LEXMCI,0)),"^",1)
IF +LEXMCEI'>0
QUIT
+18 FOR
SET LEXTEXP=$ORDER(^LEX(757.01,"AMC",LEXMCI,LEXTEXP))
IF +LEXTEXP=0
QUIT
Begin DoDot:2
+19 NEW LEXEXP,X,LEXIDX,LEXLOOK,LEXEXPT,LEXRP
+20 IF $PIECE($GET(^LEX(757.01,+LEXTEXP,1)),"^",5)>0
QUIT
+21 SET (LEXEXP,X)=^LEX(757.01,LEXTEXP,0)
+22 KILL ^TMP("LEXTKN",$JOB)
SET LEXIDX=""
DO PTX^LEXTOKN
+23 ; Supplemental Words
+24 IF $DATA(^LEX(757.01,LEXTEXP,5))
Begin DoDot:3
+25 NEW LEXV,LEXEXPT
SET LEXV=""
+26 FOR
SET LEXV=$ORDER(^LEX(757.01,LEXTEXP,5,"B",LEXV))
IF LEXV=""
QUIT
Begin DoDot:4
+27 NEW LEXC
SET LEXC=$ORDER(^TMP("LEXTKN",$JOB," "),-1)+1
+28 SET ^TMP("LEXTKN",$JOB,LEXC,LEXV)=""
+29 SET ^TMP("LEXTKN",$JOB,0)=LEXC
End DoDot:4
End DoDot:3
+30 ; Replacement Words
+31 IF $DATA(^LEX(757.05,"AEXP",LEXTEXP))
NEW LEXRP
SET LEXRP=0
Begin DoDot:3
+32 FOR
SET LEXRP=$ORDER(^LEX(757.05,"AEXP",LEXTEXP,LEXRP))
IF +LEXRP'>0
QUIT
Begin DoDot:4
+33 NEW LEXV,LEXC
+34 SET LEXV=$PIECE(^LEX(757.05,LEXRP,0),U)
IF '$LENGTH(LEXV)
QUIT
+35 SET LEXC=$ORDER(^TMP("LEXTKN",$JOB," "),-1)+1
+36 SET ^TMP("LEXTKN",$JOB,LEXC,LEXV)=""
+37 SET ^TMP("LEXTKN",$JOB,0)=LEXC
End DoDot:4
End DoDot:3
+38 IF $DATA(^TMP("LEXTKN",$JOB,0))
IF ^TMP("LEXTKN",$JOB,0)>0
Begin DoDot:3
+39 SET LEXTKN=""
SET LEXTKC=0
+40 FOR
SET LEXTKC=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC))
IF +LEXTKC'>0
QUIT
Begin DoDot:4
+41 SET LEXTKN=$ORDER(^TMP("LEXTKN",$JOB,LEXTKC,""))
IF '$LENGTH(LEXTKN)
QUIT
+42 SET ^TMP("LEXSUB",$JOB,LEXINAM,LEXTKN,LEXSUB)=""
End DoDot:4
End DoDot:3
+43 KILL ^TMP("LEXTKN",$JOB)
End DoDot:2
End DoDot:1
+44 KILL ^TMP("LEXTKN",$JOB)
HANG 1
SET LEXEND=$$END^LEXXGP1
DO SAV(LEXBEG,LEXEND,LEXTXT)
+45 SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)
SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)
+46 SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)
SET LEXENDT=$$ET^LEXXGP1(LEXEND)
SET LEXDF=$$DF^LEXXGP1(LEXBEG)
+47 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+48 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+49 SET LEXTXT=" "_LEXTXT
IF '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+50 DO ASUBR
NEW ZTQUEUED,LEXTEST
+51 IF $GET(LEXQUIT)="ASUBB"
Begin DoDot:1
+52 IF $DATA(LEXMAIL)
DO XM
+53 KILL ^TMP("LEXAWRD"),^TMP("LEXSUB"),^TMP("LEXTKN")
+54 KILL ^TMP("LEXXGPDAT"),^TMP("LEXXGPTIM"),^TMP("LEXXGPRPT")
+55 KILL LEXQUIT,ZTQUEUED,LEXMAIL,LEXHOME
End DoDot:1
+56 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")
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")
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,XMY,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)
KILL XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,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.MED.VA.GOV"
DO ^DIC
IF +Y>0
QUIT LEX
+2 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="ISC-SLC.MED.VA.GOV"
DO ^DIC
IF +Y>0
QUIT LEX
+3 QUIT "ISC-SLC.VA.GOV"
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
+6 ; 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
