LEXXGI4 ;ISL/KER - Global Import (Repair at Site) ;04/21/2014
;;2.0;LEXICON UTILITY;**51,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^TMP("LEXXGI4ASL") SACC 2.3.2.5.1
; ^TMP("LEXXGI4TIM") SACC 2.3.2.5.1
; ^TMP("LEXXGI4MSG") SACC 2.3.2.5.1
;
; External References
; HOME^%ZIS ICR 10086
; ^%ZTLOAD ICR 10063
; ^DIC ICR 10006
; ^DIK ICR 10013
; ENALL^DIK ICR 10013
; IX1^DIK ICR 10013
; IXALL^DIK ICR 10013
; $$GET1^DIQ ICR 2056
; $$FMDIFF^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
; ^XMD ICR 10070
; MES^XPDUTL ICR 10141
;
; Local Variables NEWed or KILLed Elsewhere
;
; LEXLOUD NEWed, SET and KILLed in the Post-Install
; routine LEX20nnP. If set, the entry
; points ASL, AWRD, SSWRD and SUB will write
; to the screen using MES^XPDUTL.
;
; LEXXM Set and Killed by the developer, used to
; report the timing of the task in the
; global array ^TMP("LEXXGI4TIM",$J) and
; sent 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
POST ; Entry Point from Post-Install
N LEXXM,LEXHOME K @("^TMP(""LEXXGI4TIM"","_$J_")")
S LEXXM="" D AWRD^LEXXGI4
Q
POST2 ; Entry Point from Post-Install (home)
N LEXXM,LEXHOME K @("^TMP(""LEXXGI4TIM"","_$J_")")
S LEXHOME="",LEXXM="" D AWRD^LEXXGI4
Q
AWRD ; Repair Word Index AWRD in Expression file #757.01
N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ S ZTRTN="AWRDT^LEXXGI4"
S ZTDESC="Repair the AWRD index in file #757.01"
S LEXJ=+($G(LEXJ)) S:LEXJ'>0 LEXJ=$J S ZTSAVE("LEXJ")=""
I $D(LEXXM) S LEXXM=1,ZTSAVE("LEXXM")=""
S:$D(LEXHOME) ZTSAVE("LEXHOME")=""
S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS I $D(LEXLOUD) D
. S LEXT=" Repair the AWRD index in file #757.01 tasked"
. S:+($G(ZTSK))>0 LEXT=LEXT_" (#"_+($G(ZTSK))_")" D MES^XPDUTL(LEXT)
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
AWRDT ; Repair Word Index AWRD in Expression file #757.01 (task)
; Subset Indexes Axxx
N DA,DIK,LEXBT1,LEXSB,LEXJ1 S LEXSB="WRD" S:$D(LEXXM) LEXXM=1
S (LEXJ1,LEXJ)=+($G(LEXJ)) S:LEXJ'>0 (LEXJ1,LEXJ)=$J
D:$D(LEXXM) KIL(LEXJ1)
S LEXBT1=$$BEG("WRD",LEXJ1)
H 2 D SSWRD^LEXXGI4
; Supplemental Words AWRD Index
H 2 D SUPWRD^LEXXGI4
; Main Word AWRD Index
H 2 D AWRDI
; Replacement Words
H 2 D REP
; Update String Lengths
H 2 D:'$D(LEXXM) ASL^LEXXGI4 I $D(LEXXM) D
. N LEXJ S LEXJ=LEXJ1 D ASLT^LEXXGI4
H 1 D END(LEXBT1,"WRD",LEXJ1) D:$D(LEXXM) XM(LEXJ1),KIL(LEXJ1)
S:$D(ZTQUEUED) ZTREQ="@"
Q
AWRDI ; Repair Word Index AWRD
N DIK S DIK="^LEX(757.01,",DIK(1)="2^AWRD" D ENALL^DIK
Q
AWRDTIME ; Repair Word Index AWRD (timing)
N LEXB,LEXE,LEXT S LEXB=$$NOW^XLFDT D AWRDI^LEXXGI4 S LEXE=$$NOW^XLFDT
S LEXT=$TR($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
W !," Repair Word Index AWRD",!
W !," Start: ",$TR($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
W !," Finish: ",$TR($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
W !," Time: ",LEXT
Q
;
REP ; Replacement Words
N DA,DIK,LEXBT2,LEXJ2
S LEXJ2=+($G(LEXJ)) S:LEXJ2'>0 LEXJ2=$G(LEXJ1) S:LEXJ2'>0 LEXJ2=$J
S:$D(LEXXM) LEXXM=1 S LEXBT2=$$BEG("REP",LEXJ2)
S DIK="^LEX(757.05," D IXALL^DIK H 1 D END(LEXBT2,"REP",LEXJ2)
S:$D(ZTQUEUED) ZTREQ="@"
Q
;
SUPWRD ; Repair Supplemental Word Index AWRD in file #757.01
N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ S ZTRTN="SUPWRDT^LEXXGI4"
S ZTDESC="Repair the Supplemental Word Index in file #757.01"
S LEXJ=+($G(LEXJ)) S:LEXJ'>0 LEXJ=$G(LEXJ1) S:LEXJ'>0 LEXJ=$J S ZTSAVE("LEXJ")=""
I $D(LEXXM) S LEXXM=1,ZTSAVE("LEXXM")=""
S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS I $D(LEXLOUD) D
. S LEXT=" Repair the Supplemental Word Index in file #757.01 tasked"
. S:+($G(ZTSK))>0 LEXT=LEXT_" (#"_+($G(ZTSK))_")" D MES^XPDUTL(LEXT)
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
SUPWRDT ; Repair Supplemental Word Index AWRD in file #757.01 (task)
N DA,DIK,LEXBT3,LEXI,LEXJ3
S LEXJ3=+($G(LEXJ)) S:LEXJ3'>0 LEXJ3=$J
S:$D(LEXXM) LEXXM=1 S LEXBT3=$$BEG("SUP",LEXJ3)
S LEXI=0 F S LEXI=$O(^LEX(757.01,LEXI)) Q:+LEXI'>0 D
. Q:$O(^LEX(757.01,LEXI,5,0))'>0
. N LEXII S LEXII=0 F S LEXII=$O(^LEX(757.01,LEXI,5,LEXII)) Q:+LEXII'>0 D
. . N X,DA S X=$G(^LEX(757.01,LEXI,5,LEXII,0)) Q:'$L(X)
. . S DA(1)=LEXI,DA=LEXII D SSUP^LEXNDX6
. Q S DIK(1)=".01^AWORD" D ENALL^DIK
H:+($G(LEXXM))>0 2 D END(LEXBT3,"SUP",LEXJ3)
S:$D(ZTQUEUED) ZTREQ="@"
Q
SUPTIME ; Repair Supplemental Word Index AWRD (timing)
N LEXB,LEXE,LEXT S LEXB=$$NOW^XLFDT D SUPWRDT^LEXXGI4 S LEXE=$$NOW^XLFDT
S LEXT=$TR($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
W !," Repair Supplemental Word Index AWRD",!
W !," Start: ",$TR($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
W !," Finish: ",$TR($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
W !," Time: ",LEXT
Q
;
SSWRD ; Repair Word Index Axxx in Sub-Set file #757.21
N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ S ZTRTN="SSWRDT^LEXXGI4"
S ZTDESC="Repair the Asub in file #757.21"
S LEXJ=+($G(LEXJ)) S:LEXJ'>0 LEXJ=$G(LEXJ1) S:LEXJ'>0 LEXJ=$J S ZTSAVE("LEXJ")=""
I $D(LEXXM) S LEXXM=1,ZTSAVE("LEXXM")=""
S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS I $D(LEXLOUD) D
. S LEXT=" Repair the Asub index in file #757.21 tasked"
. S:+($G(ZTSK))>0 LEXT=LEXT_" (#"_+($G(ZTSK))_")" D MES^XPDUTL(LEXT)
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
SSWRDT ; Repair Word Index Axxx in Sub-Set file #757.21 (task)
N DA,DIK,LEXBT4,LEXJ4
S LEXJ4=+($G(LEXJ)) S:LEXJ4'>0 LEXJ4=$J
S:$D(LEXXM) LEXXM=1 S LEXBT4=$$BEG("SUB",LEXJ4)
N IEN S IEN=0 F S IEN=$O(^LEX(757.21,IEN)) Q:+IEN'>0 D
. N DA,X S DA=IEN,X=$P($G(^LEX(757.21,IEN,0)),"^",2) D:$L(X) SS^LEXNDX2
. Q S X=$P($G(^LEX(757.21,IEN,0)),"^",1) I $L(X),+X>0 D
. . S ^LEX(757.21,"B",$E(X,1,30),DA)=""
. . S ^LEX(757.21,"C",$E($$UP^XLFSTR(^LEX(757.01,X,0)),1,63),DA)=""
H:+($G(LEXXM))>0 2 D END(LEXBT4,"SUB",LEXJ4)
S:$D(ZTQUEUED) ZTREQ="@"
Q
SSTIME ; Repair Word Index Axxx in Sub-Set file #757.21 (timing)
N LEXB,LEXE,LEXT S LEXB=$$NOW^XLFDT D SSWRDT^LEXXGI4 S LEXE=$$NOW^XLFDT
S LEXT=$TR($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
W !," Repair Word Index Axxx in Sub-Set file",!
W !," Start: ",$TR($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
W !," Finish: ",$TR($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
W !," Time: ",LEXT
Q
;
ASL ; Recalculate ASL cross-reference
N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ S ZTRTN="ASLT^LEXXGI4"
S ZTDESC="Recalculate ASL index in Expression file #757.01"
S LEXJ=+($G(LEXJ)) S:LEXJ'>0 LEXJ=$G(LEXJ1) S:LEXJ'>0 LEXJ=$J S ZTSAVE("LEXJ")=""
I $D(LEXXM) S LEXXM=1,ZTSAVE("LEXXM")=""
S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS I $D(LEXLOUD) D
. S LEXT=" Re-index the ASL index of file #757.01 tasked"
. S:+($G(ZTSK))>0 LEXT=LEXT_" (#"_+($G(ZTSK))_")" D MES^XPDUTL(LEXT)
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
ASLT ; Recalculate ASL cross-reference (task)
K ^TMP("LEXXGI4ASL",$J,"ASL") N LEXTK,LEXFIR,LEXFC,LEXBT5,LEXJ5
S LEXJ5=+($G(LEXJ)) S:LEXJ5'>0 LEXJ5=$J S (LEXFIR,LEXFC,LEXTK)=""
S:$D(LEXXM) LEXXM=1 S LEXBT5=$$BEG("ASL",LEXJ5)
F S LEXTK=$O(^LEX(757.01,"AWRD",LEXTK)) Q:'$L(LEXTK) D
. N LEXP,LEXS,LEXC,LEXF,LEXTKN S LEXTKN=LEXTK
. F Q:$E(LEXTKN,1)'=" " S LEXTKN=$E(LEXTKN,2,$L(LEXTKN))
. F Q:$E(LEXTKN,$L(LEXTKN))'=" " S LEXTKN=$E(LEXTKN,1,($L(LEXTKN)-1))
. S LEXF=$E(LEXTKN,1)
. W:'$D(ZTQUEUED)&(LEXFIR'=LEXF)&(LEXFC'[LEXF) LEXF
. S LEXFIR=LEXF S:LEXFC'[LEXF LEXFC=LEXFC_LEXF
. F LEXP=1:1:$L(LEXTKN) S LEXS=$E(LEXTKN,1,LEXP) D
. . Q:'$L($G(LEXS)) Q:$D(^TMP("LEXXGI4ASL",$J,"ASL",LEXS))
. . S LEXC=$$ASLC(LEXS)
. . I LEXC>0 K ^LEX(757.01,"ASL",LEXS) D
. . . K ^LEX(757.01,"ASL",LEXS)
. . . S ^LEX(757.01,"ASL",LEXS,LEXC)=""
. . S ^TMP("LEXXGI4ASL",$J,"ASL",LEXS)=""
K ^TMP("LEXXGI4ASL",$J,"ASL")
H:+($G(LEXXM))>0 2 D END(LEXBT5,"ASL",LEXJ5)
S:$D(ZTQUEUED) ZTREQ="@"
Q
ASLC(X) ; Recalculate ASL cross-reference (String Counter)
N LEXC,LEXTK,LEXTKN,LEXO,LEXT,LEXS,LEXP
S (LEXC,LEXTK)=$$UP^XLFSTR($G(X)),LEXT=0 Q:'$L(LEXTK) 0
S:$L(LEXTK)>1 LEXO=$E(LEXTK,1,($L(LEXTK)-1))_$C(($A($E(LEXTK,$L(LEXTK)))-1))_"~"
S:$L(LEXTK)=1 LEXO=$C(($A(LEXTK)-1))_"~"
F S LEXO=$O(^LEX(757.01,"AWRD",LEXO)) Q:'$L(LEXO) Q:$E(LEXO,1,$L(LEXC))'=LEXC D
. N LEXM S LEXM=0 F S LEXM=$O(^LEX(757.01,"AWRD",LEXO,LEXM)) Q:+LEXM'>0 D
. . N LEXE S LEXE=0 F S LEXE=$O(^LEX(757.01,"AWRD",LEXO,LEXM,LEXE)) Q:+LEXE'>0 D
. . . S LEXT=LEXT+1
S X=LEXT
Q X
ASLTIME ; Recalculate ASL cross-reference (timing)
N LEXB,LEXE,LEXT S LEXB=$$NOW^XLFDT D ASLT^LEXXGI4 S LEXE=$$NOW^XLFDT
S LEXT=$TR($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
W !," Recalculate ASL cross-reference",!
W !," Start: ",$TR($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
W !," Finish: ",$TR($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
W !," Time: ",LEXT
Q
;
SUB ; Repair Subset Cross-References
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,LEXT S ZTRTN="SUBT^LEXXGI4"
S ZTDESC="Re-Index the Subsets file #757.21 (set logic only)"
S LEXJ=+($G(LEXJ)) S:LEXJ'>0 LEXJ=$G(LEXJ1) S:LEXJ'>0 LEXJ=$J S ZTSAVE("LEXJ")=""
I $D(LEXXM) S LEXXM=1,ZTSAVE("LEXXM")=""
S ZTIO="",ZTDTH=$H D ^%ZTLOAD I $D(LEXLOUD) D
. S LEXT=" Re-index file #757.21 tasked"
. S:+($G(ZTSK))>0 LEXT=LEXT_" (#"_+($G(ZTSK))_")" D MES^XPDUTL(LEXT)
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
SUBT ; Repair Subset Cross-References (task)
N LEXP3,LEXP4,LEXIEN,LEXBT6,LEXJ6 S:$D(LEXXM) LEXXM=1
S LEXJ6=+($G(LEXJ)) S:LEXJ6'>0 LEXJ6=$J
S (LEXP3,LEXP4,LEXIEN)=0,LEXBT6=$$BEG("SSS",LEXJ6)
F S LEXIEN=$O(^LEX(757.21,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK S DA=+($G(LEXIEN)) D SUBFIX(DA) Q:'$D(^LEX(757.21,+LEXIEN,0))
. S LEXP3=LEXIEN,LEXP4=LEXP4+1
. S DA=LEXIEN,DIK="^LEX(757.21," D IX1^DIK
S:LEXP3>0 $P(^LEX(757.21,0),"^",3)=LEXP3
S:LEXP4>0 $P(^LEX(757.21,0),"^",4)=LEXP4
H:+($G(LEXXM))>0 2 D END(LEXBT6,"SSS",LEXJ6)
S:$D(ZTQUEUED) ZTREQ="@"
Q
SUBFIX(X) ; Repair Subset Cross-References (Fix 757.21)
N DA,DIK,LEXEXP,LEXDFL S DA=+($G(X))
Q:+DA'>0 Q:'$D(^LEX(757.21,+DA,0))
S LEXEXP=+$G(^LEX(757.21,+DA,0))
S LEXDFL=$P($G(^LEX(757.01,+LEXEXP,1)),"^",5)
Q:+LEXDFL'>0 S DIK="^LEX(757.21," D ^DIK
Q
;
XM(X) ; 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 S:$D(LEXXM) LEXMAIL=""
Q:'$D(LEXMAIL)&$D(ZTQUEUED) S LEX1=9999999,LEX2="",LEXJ=+($G(X))
Q:LEXJ'>0 Q:'$D(^TMP("LEXXGI4TIM",LEXJ))
D XMG I LEX1'=9999999,$P(LEX1,".",1)?7N,$P(LEX2,".",1)?7N D
. Q:$O(^TMP("LEXXGI4TIM",LEXJ,""))=$O(^TMP("LEXXGI4TIM",LEXJ,""),-1)
. N LEXN,LEXD,LEXB,LEXE,LEXT,LEXX
. S LEXN="Total Time",LEXD=$TR($$FMTE^XLFDT(LEX1,"5Z"),"@"," ")
. S LEXB=$P(LEXD," ",2),LEXE=$TR($$FMTE^XLFDT(LEX2,"5Z"),"@"," ")
. S LEXE=$P(LEXE," ",2),LEXT=$$FMDIFF^XLFDT(LEX2,LEX1,3)
. S LEXD=$P($TR($$FMTE^XLFDT(LEX1,"5Z"),"@"," ")," ",1)
. S:$L(LEXT)'>8 LEXT=$TR(LEXT," ","0")
. I $L($G(LEXPRE)),+($G(LEXPRE))>0,LEXD=$G(LEXPRE) S LEXD=" "" "" "
. S LEXX=LEXN,LEXX=LEXX_$J(" ",(33-$L(LEXX)))_LEXD
. S LEXX=LEXX_$J(" ",(45-$L(LEXX)))_LEXB
. S LEXX=LEXX_$J(" ",(55-$L(LEXX)))_LEXE
. S LEXX=LEXX_$J(" ",(65-$L(LEXX)))_LEXT
. D XMB((" "_LEXX),LEXJ)
D:$D(LEXMAIL) XMS(LEXJ)
Q
XMG ; Get Data for Message
N LEXS,LEXC S LEXPRE="",LEXC=0 F LEXS="WRD","SUB","SUP","REP","ASL","SSS" D
. N LEXD,LEXB,LEXE,LEXN,LEXNEW,LEXT,LEXX
. S LEXD=$P($G(^TMP("LEXXGI4TIM",LEXJ,LEXS,"BEG")),"^",1)
. S:+LEXD>0&(+LEXD<LEX1) LEX1=LEXD
. S LEXD=$TR($$FMTE^XLFDT(LEXD,"5Z"),"@"," ")
. S LEXB=$P(LEXD," ",2)
. S (LEXNEW,LEXD)=$P(LEXD," ",1)
. S LEXE=$P($G(^TMP("LEXXGI4TIM",LEXJ,LEXS,"END")),"^",1)
. S:+LEXE>LEX2 LEX2=LEXE
. S LEXE=$TR($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
. S LEXE=$P(LEXE," ",2)
. S LEXT=$G(^TMP("LEXXGI4TIM",LEXJ,LEXS,"TIM"))
. Q:'$L(LEXB)
. S:LEXS="SUB" LEXN="Sub-Sets 757.21 ""Axxx"""
. S:LEXS="SSS" LEXN="Sub-Sets 757.21 ""Axxx"""
. S:LEXS="SUP" LEXN="Supplemental 757.18 ""AWRD"""
. S:LEXS="WRD" LEXN="Expression 757.01 ""AWRD"""
. S:LEXS="REP" LEXN="Replacements 757.05 ""AWRD"""
. S:LEXS="ASL" LEXN="String Length 757.01 ""ASL"""
. S:'$L(LEXE) LEXE=" "
. S:'$L(LEXT) LEXT=" "
. S:LEXD=LEXPRE LEXD=" "" "" "
. S LEXPRE=LEXNEW
. S LEXX=LEXN,LEXX=LEXX_$J(" ",(33-$L(LEXX)))_LEXD
. S LEXX=LEXX_$J(" ",(45-$L(LEXX)))_LEXB
. S LEXX=LEXX_$J(" ",(55-$L(LEXX)))_LEXE
. S LEXX=LEXX_$J(" ",(65-$L(LEXX)))_LEXT
. S LEXC=LEXC+1 I LEXC=1 D
. . D:$D(LEXMAIL) XMB(" ",LEXJ)
. . D XMB(" Repair/Re-Index Index Date Start Finish Elapsed",LEXJ)
. . D XMB(" ----------------------- ------ ---------- -------- -------- --------",LEXJ)
. D XMB((" "_LEXX),LEXJ)
. Q
Q
XMB(X,Y) ; Build Message
N LEXJ S X=$G(X),LEXJ=+($G(Y)) I '$D(LEXMAIL) W:'$D(ZTQUEUED) !,X Q
Q:+LEXJ'>0 N LEXI S LEXI=$O(^TMP("LEXXGI4MSG",LEXJ," "),-1)+1
S ^TMP("LEXXGI4MSG",LEXJ,+LEXI)=$G(X),^TMP("LEXXGI4MSG",LEXJ,0)=LEXI
Q
XMS(X) ; Send Message
N XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,LEXJ,LEXNM
S LEXJ=+($G(X)) Q:+LEXJ'>0 Q:'$D(^TMP("LEXXGI4MSG",LEXJ))
S XMTEXT="^TMP(""LEXXGI4MSG"","_LEXJ_",",XMSUB="Repair Major Word Indexes"
S LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01) I '$L(LEXNM) K ^TMP("LEXXGI4MSG",LEXJ) Q
S:$D(LEXHOME) XMY(("G.LEXINS@"_$$XMA))="" S XMY(LEXNM)="",XMDUZ=.5 D ^XMD
K ^TMP("LEXXGI4MSG",LEXJ) 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"
;
; Miscellaneous
BEG(X,Y) ; Begin Process - Subscript, Job
N SUB,JNM S SUB=$G(X),X=$$NOW^XLFDT,JNM=+($G(Y)) S:JNM'>0 JNM=$J I +($G(LEXXM))>0,$L(SUB) D
. S @("^TMP(""LEXXGI4TIM"","_+($G(JNM))_","""_SUB_""",""BEG"")")=X_"^"_$TR($$FMTE^XLFDT(X,"5Z"),"@"," ")
Q X
END(X,Y,Z) ; End Process - Begin, Subscript, Job
N BEG,ELP,END,ELP,SUB,JNM S BEG=$G(X),SUB=$G(Y),JNM=+($G(Z)) S:JNM'>0 JNM=$J H 2 S END=$$NOW^XLFDT
S ELP="" S:+BEG>0&(+END>0) ELP=$TR($$FMDIFF^XLFDT(END,BEG,3)," ","0") I +($G(LEXXM))>0,$L(SUB),$L(ELP) D
. S @("^TMP(""LEXXGI4TIM"","_+($G(JNM))_","""_SUB_""",""BEG"")")=BEG_"^"_$TR($$FMTE^XLFDT(BEG,"5Z"),"@"," ")
. S @("^TMP(""LEXXGI4TIM"","_+($G(JNM))_","""_SUB_""",""END"")")=END_"^"_$TR($$FMTE^XLFDT(END,"5Z"),"@"," ")
. S @("^TMP(""LEXXGI4TIM"","_+($G(JNM))_","""_SUB_""",""TIM"")")=ELP
Q X
KIL(X) ; Kill ^TMP("LEXXGI4TIM",$J)
N JNM S JNM=$G(X) S:JNM'>0 JNM=$J I +($G(LEXXM))>0 D
. K @("^TMP(""LEXXGI4TIM"","_+($G(JNM))_")")
. K @("^TMP(""LEXXGI4TIM"","_$J_")")
Q
CLR ; Clear Variables
K LEXLOUD,LEXTEST,LEXJ,LEXXM,LEXHOME
Q
LEXXGI4 ;ISL/KER - Global Import (Repair at Site) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**51,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXXGI4ASL") SACC 2.3.2.5.1
+5 ; ^TMP("LEXXGI4TIM") SACC 2.3.2.5.1
+6 ; ^TMP("LEXXGI4MSG") SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; HOME^%ZIS ICR 10086
+10 ; ^%ZTLOAD ICR 10063
+11 ; ^DIC ICR 10006
+12 ; ^DIK ICR 10013
+13 ; ENALL^DIK ICR 10013
+14 ; IX1^DIK ICR 10013
+15 ; IXALL^DIK ICR 10013
+16 ; $$GET1^DIQ ICR 2056
+17 ; $$FMDIFF^XLFDT ICR 10103
+18 ; $$FMTE^XLFDT ICR 10103
+19 ; $$NOW^XLFDT ICR 10103
+20 ; $$UP^XLFSTR ICR 10104
+21 ; ^XMD ICR 10070
+22 ; MES^XPDUTL ICR 10141
+23 ;
+24 ; Local Variables NEWed or KILLed Elsewhere
+25 ;
+26 ; LEXLOUD NEWed, SET and KILLed in the Post-Install
+27 ; routine LEX20nnP. If set, the entry
+28 ; points ASL, AWRD, SSWRD and SUB will write
+29 ; to the screen using MES^XPDUTL.
+30 ;
+31 ; LEXXM Set and Killed by the developer, used to
+32 ; report the timing of the task in the
+33 ; global array ^TMP("LEXXGI4TIM",$J) and
+34 ; sent to the user by MailMan message
+35 ;
+36 ; LEXHOME Set and Killed by the developer in the
+37 ; post-install, used to send the timing
+38 ; message to G.LEXINS@FO-SLC.MED.VA.GOV
+39 ; (see entry point POST2)
+40 ;
+41 QUIT
POST ; Entry Point from Post-Install
+1 NEW LEXXM,LEXHOME
KILL @("^TMP(""LEXXGI4TIM"","_$JOB_")")
+2 SET LEXXM=""
DO AWRD^LEXXGI4
+3 QUIT
POST2 ; Entry Point from Post-Install (home)
+1 NEW LEXXM,LEXHOME
KILL @("^TMP(""LEXXGI4TIM"","_$JOB_")")
+2 SET LEXHOME=""
SET LEXXM=""
DO AWRD^LEXXGI4
+3 QUIT
AWRD ; Repair Word Index AWRD in Expression file #757.01
+1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ
SET ZTRTN="AWRDT^LEXXGI4"
+2 SET ZTDESC="Repair the AWRD index in file #757.01"
+3 SET LEXJ=+($GET(LEXJ))
IF LEXJ'>0
SET LEXJ=$JOB
SET ZTSAVE("LEXJ")=""
+4 IF $DATA(LEXXM)
SET LEXXM=1
SET ZTSAVE("LEXXM")=""
+5 IF $DATA(LEXHOME)
SET ZTSAVE("LEXHOME")=""
+6 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
IF $DATA(LEXLOUD)
Begin DoDot:1
+7 SET LEXT=" Repair the AWRD index in file #757.01 tasked"
+8 IF +($GET(ZTSK))>0
SET LEXT=LEXT_" (#"_+($GET(ZTSK))_")"
DO MES^XPDUTL(LEXT)
End DoDot:1
+9 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+10 QUIT
AWRDT ; Repair Word Index AWRD in Expression file #757.01 (task)
+1 ; Subset Indexes Axxx
+2 NEW DA,DIK,LEXBT1,LEXSB,LEXJ1
SET LEXSB="WRD"
IF $DATA(LEXXM)
SET LEXXM=1
+3 SET (LEXJ1,LEXJ)=+($GET(LEXJ))
IF LEXJ'>0
SET (LEXJ1,LEXJ)=$JOB
+4 IF $DATA(LEXXM)
DO KIL(LEXJ1)
+5 SET LEXBT1=$$BEG("WRD",LEXJ1)
+6 HANG 2
DO SSWRD^LEXXGI4
+7 ; Supplemental Words AWRD Index
+8 HANG 2
DO SUPWRD^LEXXGI4
+9 ; Main Word AWRD Index
+10 HANG 2
DO AWRDI
+11 ; Replacement Words
+12 HANG 2
DO REP
+13 ; Update String Lengths
+14 HANG 2
IF '$DATA(LEXXM)
DO ASL^LEXXGI4
IF $DATA(LEXXM)
Begin DoDot:1
+15 NEW LEXJ
SET LEXJ=LEXJ1
DO ASLT^LEXXGI4
End DoDot:1
+16 HANG 1
DO END(LEXBT1,"WRD",LEXJ1)
IF $DATA(LEXXM)
DO XM(LEXJ1)
DO KIL(LEXJ1)
+17 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+18 QUIT
AWRDI ; Repair Word Index AWRD
+1 NEW DIK
SET DIK="^LEX(757.01,"
SET DIK(1)="2^AWRD"
DO ENALL^DIK
+2 QUIT
AWRDTIME ; Repair Word Index AWRD (timing)
+1 NEW LEXB,LEXE,LEXT
SET LEXB=$$NOW^XLFDT
DO AWRDI^LEXXGI4
SET LEXE=$$NOW^XLFDT
+2 SET LEXT=$TRANSLATE($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
+3 WRITE !," Repair Word Index AWRD",!
+4 WRITE !," Start: ",$TRANSLATE($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
+5 WRITE !," Finish: ",$TRANSLATE($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
+6 WRITE !," Time: ",LEXT
+7 QUIT
+8 ;
REP ; Replacement Words
+1 NEW DA,DIK,LEXBT2,LEXJ2
+2 SET LEXJ2=+($GET(LEXJ))
IF LEXJ2'>0
SET LEXJ2=$GET(LEXJ1)
IF LEXJ2'>0
SET LEXJ2=$JOB
+3 IF $DATA(LEXXM)
SET LEXXM=1
SET LEXBT2=$$BEG("REP",LEXJ2)
+4 SET DIK="^LEX(757.05,"
DO IXALL^DIK
HANG 1
DO END(LEXBT2,"REP",LEXJ2)
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
+7 ;
SUPWRD ; Repair Supplemental Word Index AWRD in file #757.01
+1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ
SET ZTRTN="SUPWRDT^LEXXGI4"
+2 SET ZTDESC="Repair the Supplemental Word Index in file #757.01"
+3 SET LEXJ=+($GET(LEXJ))
IF LEXJ'>0
SET LEXJ=$GET(LEXJ1)
IF LEXJ'>0
SET LEXJ=$JOB
SET ZTSAVE("LEXJ")=""
+4 IF $DATA(LEXXM)
SET LEXXM=1
SET ZTSAVE("LEXXM")=""
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
IF $DATA(LEXLOUD)
Begin DoDot:1
+6 SET LEXT=" Repair the Supplemental Word Index in file #757.01 tasked"
+7 IF +($GET(ZTSK))>0
SET LEXT=LEXT_" (#"_+($GET(ZTSK))_")"
DO MES^XPDUTL(LEXT)
End DoDot:1
+8 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+9 QUIT
SUPWRDT ; Repair Supplemental Word Index AWRD in file #757.01 (task)
+1 NEW DA,DIK,LEXBT3,LEXI,LEXJ3
+2 SET LEXJ3=+($GET(LEXJ))
IF LEXJ3'>0
SET LEXJ3=$JOB
+3 IF $DATA(LEXXM)
SET LEXXM=1
SET LEXBT3=$$BEG("SUP",LEXJ3)
+4 SET LEXI=0
FOR
SET LEXI=$ORDER(^LEX(757.01,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:1
+5 IF $ORDER(^LEX(757.01,LEXI,5,0))'>0
QUIT
+6 NEW LEXII
SET LEXII=0
FOR
SET LEXII=$ORDER(^LEX(757.01,LEXI,5,LEXII))
IF +LEXII'>0
QUIT
Begin DoDot:2
+7 NEW X,DA
SET X=$GET(^LEX(757.01,LEXI,5,LEXII,0))
IF '$LENGTH(X)
QUIT
+8 SET DA(1)=LEXI
SET DA=LEXII
DO SSUP^LEXNDX6
End DoDot:2
+9 QUIT
SET DIK(1)=".01^AWORD"
DO ENALL^DIK
End DoDot:1
+10 IF +($GET(LEXXM))>0
HANG 2
DO END(LEXBT3,"SUP",LEXJ3)
+11 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+12 QUIT
SUPTIME ; Repair Supplemental Word Index AWRD (timing)
+1 NEW LEXB,LEXE,LEXT
SET LEXB=$$NOW^XLFDT
DO SUPWRDT^LEXXGI4
SET LEXE=$$NOW^XLFDT
+2 SET LEXT=$TRANSLATE($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
+3 WRITE !," Repair Supplemental Word Index AWRD",!
+4 WRITE !," Start: ",$TRANSLATE($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
+5 WRITE !," Finish: ",$TRANSLATE($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
+6 WRITE !," Time: ",LEXT
+7 QUIT
+8 ;
SSWRD ; Repair Word Index Axxx in Sub-Set file #757.21
+1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ
SET ZTRTN="SSWRDT^LEXXGI4"
+2 SET ZTDESC="Repair the Asub in file #757.21"
+3 SET LEXJ=+($GET(LEXJ))
IF LEXJ'>0
SET LEXJ=$GET(LEXJ1)
IF LEXJ'>0
SET LEXJ=$JOB
SET ZTSAVE("LEXJ")=""
+4 IF $DATA(LEXXM)
SET LEXXM=1
SET ZTSAVE("LEXXM")=""
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
IF $DATA(LEXLOUD)
Begin DoDot:1
+6 SET LEXT=" Repair the Asub index in file #757.21 tasked"
+7 IF +($GET(ZTSK))>0
SET LEXT=LEXT_" (#"_+($GET(ZTSK))_")"
DO MES^XPDUTL(LEXT)
End DoDot:1
+8 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+9 QUIT
SSWRDT ; Repair Word Index Axxx in Sub-Set file #757.21 (task)
+1 NEW DA,DIK,LEXBT4,LEXJ4
+2 SET LEXJ4=+($GET(LEXJ))
IF LEXJ4'>0
SET LEXJ4=$JOB
+3 IF $DATA(LEXXM)
SET LEXXM=1
SET LEXBT4=$$BEG("SUB",LEXJ4)
+4 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(^LEX(757.21,IEN))
IF +IEN'>0
QUIT
Begin DoDot:1
+5 NEW DA,X
SET DA=IEN
SET X=$PIECE($GET(^LEX(757.21,IEN,0)),"^",2)
IF $LENGTH(X)
DO SS^LEXNDX2
+6 QUIT
SET X=$PIECE($GET(^LEX(757.21,IEN,0)),"^",1)
IF $LENGTH(X)
IF +X>0
Begin DoDot:2
+7 SET ^LEX(757.21,"B",$EXTRACT(X,1,30),DA)=""
+8 SET ^LEX(757.21,"C",$EXTRACT($$UP^XLFSTR(^LEX(757.01,X,0)),1,63),DA)=""
End DoDot:2
End DoDot:1
+9 IF +($GET(LEXXM))>0
HANG 2
DO END(LEXBT4,"SUB",LEXJ4)
+10 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+11 QUIT
SSTIME ; Repair Word Index Axxx in Sub-Set file #757.21 (timing)
+1 NEW LEXB,LEXE,LEXT
SET LEXB=$$NOW^XLFDT
DO SSWRDT^LEXXGI4
SET LEXE=$$NOW^XLFDT
+2 SET LEXT=$TRANSLATE($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
+3 WRITE !," Repair Word Index Axxx in Sub-Set file",!
+4 WRITE !," Start: ",$TRANSLATE($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
+5 WRITE !," Finish: ",$TRANSLATE($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
+6 WRITE !," Time: ",LEXT
+7 QUIT
+8 ;
ASL ; Recalculate ASL cross-reference
+1 NEW Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTQUEUED,ZTREQ
SET ZTRTN="ASLT^LEXXGI4"
+2 SET ZTDESC="Recalculate ASL index in Expression file #757.01"
+3 SET LEXJ=+($GET(LEXJ))
IF LEXJ'>0
SET LEXJ=$GET(LEXJ1)
IF LEXJ'>0
SET LEXJ=$JOB
SET ZTSAVE("LEXJ")=""
+4 IF $DATA(LEXXM)
SET LEXXM=1
SET ZTSAVE("LEXXM")=""
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
IF $DATA(LEXLOUD)
Begin DoDot:1
+6 SET LEXT=" Re-index the ASL index of file #757.01 tasked"
+7 IF +($GET(ZTSK))>0
SET LEXT=LEXT_" (#"_+($GET(ZTSK))_")"
DO MES^XPDUTL(LEXT)
End DoDot:1
+8 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+9 QUIT
ASLT ; Recalculate ASL cross-reference (task)
+1 KILL ^TMP("LEXXGI4ASL",$JOB,"ASL")
NEW LEXTK,LEXFIR,LEXFC,LEXBT5,LEXJ5
+2 SET LEXJ5=+($GET(LEXJ))
IF LEXJ5'>0
SET LEXJ5=$JOB
SET (LEXFIR,LEXFC,LEXTK)=""
+3 IF $DATA(LEXXM)
SET LEXXM=1
SET LEXBT5=$$BEG("ASL",LEXJ5)
+4 FOR
SET LEXTK=$ORDER(^LEX(757.01,"AWRD",LEXTK))
IF '$LENGTH(LEXTK)
QUIT
Begin DoDot:1
+5 NEW LEXP,LEXS,LEXC,LEXF,LEXTKN
SET LEXTKN=LEXTK
+6 FOR
IF $EXTRACT(LEXTKN,1)'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,2,$LENGTH(LEXTKN))
+7 FOR
IF $EXTRACT(LEXTKN,$LENGTH(LEXTKN))'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,1,($LENGTH(LEXTKN)-1))
+8 SET LEXF=$EXTRACT(LEXTKN,1)
+9 IF '$DATA(ZTQUEUED)&(LEXFIR'=LEXF)&(LEXFC'[LEXF)
WRITE LEXF
+10 SET LEXFIR=LEXF
IF LEXFC'[LEXF
SET LEXFC=LEXFC_LEXF
+11 FOR LEXP=1:1:$LENGTH(LEXTKN)
SET LEXS=$EXTRACT(LEXTKN,1,LEXP)
Begin DoDot:2
+12 IF '$LENGTH($GET(LEXS))
QUIT
IF $DATA(^TMP("LEXXGI4ASL",$JOB,"ASL",LEXS))
QUIT
+13 SET LEXC=$$ASLC(LEXS)
+14 IF LEXC>0
KILL ^LEX(757.01,"ASL",LEXS)
Begin DoDot:3
+15 KILL ^LEX(757.01,"ASL",LEXS)
+16 SET ^LEX(757.01,"ASL",LEXS,LEXC)=""
End DoDot:3
+17 SET ^TMP("LEXXGI4ASL",$JOB,"ASL",LEXS)=""
End DoDot:2
End DoDot:1
+18 KILL ^TMP("LEXXGI4ASL",$JOB,"ASL")
+19 IF +($GET(LEXXM))>0
HANG 2
DO END(LEXBT5,"ASL",LEXJ5)
+20 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+21 QUIT
ASLC(X) ; Recalculate ASL cross-reference (String Counter)
+1 NEW LEXC,LEXTK,LEXTKN,LEXO,LEXT,LEXS,LEXP
+2 SET (LEXC,LEXTK)=$$UP^XLFSTR($GET(X))
SET LEXT=0
IF '$LENGTH(LEXTK)
QUIT 0
+3 IF $LENGTH(LEXTK)>1
SET LEXO=$EXTRACT(LEXTK,1,($LENGTH(LEXTK)-1))_$CHAR(($ASCII($EXTRACT(LEXTK,$LENGTH(LEXTK)))-1))_"~"
+4 IF $LENGTH(LEXTK)=1
SET LEXO=$CHAR(($ASCII(LEXTK)-1))_"~"
+5 FOR
SET LEXO=$ORDER(^LEX(757.01,"AWRD",LEXO))
IF '$LENGTH(LEXO)
QUIT
IF $EXTRACT(LEXO,1,$LENGTH(LEXC))'=LEXC
QUIT
Begin DoDot:1
+6 NEW LEXM
SET LEXM=0
FOR
SET LEXM=$ORDER(^LEX(757.01,"AWRD",LEXO,LEXM))
IF +LEXM'>0
QUIT
Begin DoDot:2
+7 NEW LEXE
SET LEXE=0
FOR
SET LEXE=$ORDER(^LEX(757.01,"AWRD",LEXO,LEXM,LEXE))
IF +LEXE'>0
QUIT
Begin DoDot:3
+8 SET LEXT=LEXT+1
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET X=LEXT
+10 QUIT X
ASLTIME ; Recalculate ASL cross-reference (timing)
+1 NEW LEXB,LEXE,LEXT
SET LEXB=$$NOW^XLFDT
DO ASLT^LEXXGI4
SET LEXE=$$NOW^XLFDT
+2 SET LEXT=$TRANSLATE($$FMDIFF^XLFDT(LEXE,LEXB,3)," ","0")
+3 WRITE !," Recalculate ASL cross-reference",!
+4 WRITE !," Start: ",$TRANSLATE($$FMTE^XLFDT(LEXB,"5Z"),"@"," ")
+5 WRITE !," Finish: ",$TRANSLATE($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
+6 WRITE !," Time: ",LEXT
+7 QUIT
+8 ;
SUB ; Repair Subset Cross-References
+1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,LEXT
SET ZTRTN="SUBT^LEXXGI4"
+2 SET ZTDESC="Re-Index the Subsets file #757.21 (set logic only)"
+3 SET LEXJ=+($GET(LEXJ))
IF LEXJ'>0
SET LEXJ=$GET(LEXJ1)
IF LEXJ'>0
SET LEXJ=$JOB
SET ZTSAVE("LEXJ")=""
+4 IF $DATA(LEXXM)
SET LEXXM=1
SET ZTSAVE("LEXXM")=""
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
IF $DATA(LEXLOUD)
Begin DoDot:1
+6 SET LEXT=" Re-index file #757.21 tasked"
+7 IF +($GET(ZTSK))>0
SET LEXT=LEXT_" (#"_+($GET(ZTSK))_")"
DO MES^XPDUTL(LEXT)
End DoDot:1
+8 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+9 QUIT
SUBT ; Repair Subset Cross-References (task)
+1 NEW LEXP3,LEXP4,LEXIEN,LEXBT6,LEXJ6
IF $DATA(LEXXM)
SET LEXXM=1
+2 SET LEXJ6=+($GET(LEXJ))
IF LEXJ6'>0
SET LEXJ6=$JOB
+3 SET (LEXP3,LEXP4,LEXIEN)=0
SET LEXBT6=$$BEG("SSS",LEXJ6)
+4 FOR
SET LEXIEN=$ORDER(^LEX(757.21,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+5 NEW DA,DIK
SET DA=+($GET(LEXIEN))
DO SUBFIX(DA)
IF '$DATA(^LEX(757.21,+LEXIEN,0))
QUIT
+6 SET LEXP3=LEXIEN
SET LEXP4=LEXP4+1
+7 SET DA=LEXIEN
SET DIK="^LEX(757.21,"
DO IX1^DIK
End DoDot:1
+8 IF LEXP3>0
SET $PIECE(^LEX(757.21,0),"^",3)=LEXP3
+9 IF LEXP4>0
SET $PIECE(^LEX(757.21,0),"^",4)=LEXP4
+10 IF +($GET(LEXXM))>0
HANG 2
DO END(LEXBT6,"SSS",LEXJ6)
+11 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+12 QUIT
SUBFIX(X) ; Repair Subset Cross-References (Fix 757.21)
+1 NEW DA,DIK,LEXEXP,LEXDFL
SET DA=+($GET(X))
+2 IF +DA'>0
QUIT
IF '$DATA(^LEX(757.21,+DA,0))
QUIT
+3 SET LEXEXP=+$GET(^LEX(757.21,+DA,0))
+4 SET LEXDFL=$PIECE($GET(^LEX(757.01,+LEXEXP,1)),"^",5)
+5 IF +LEXDFL'>0
QUIT
SET DIK="^LEX(757.21,"
DO ^DIK
+6 QUIT
+7 ;
XM(X) ; 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
IF $DATA(LEXXM)
SET LEXMAIL=""
+4 IF '$DATA(LEXMAIL)&$DATA(ZTQUEUED)
QUIT
SET LEX1=9999999
SET LEX2=""
SET LEXJ=+($GET(X))
+5 IF LEXJ'>0
QUIT
IF '$DATA(^TMP("LEXXGI4TIM",LEXJ))
QUIT
+6 DO XMG
IF LEX1'=9999999
IF $PIECE(LEX1,".",1)?7N
IF $PIECE(LEX2,".",1)?7N
Begin DoDot:1
+7 IF $ORDER(^TMP("LEXXGI4TIM",LEXJ,""))=$ORDER(^TMP("LEXXGI4TIM",LEXJ,""),-1)
QUIT
+8 NEW LEXN,LEXD,LEXB,LEXE,LEXT,LEXX
+9 SET LEXN="Total Time"
SET LEXD=$TRANSLATE($$FMTE^XLFDT(LEX1,"5Z"),"@"," ")
+10 SET LEXB=$PIECE(LEXD," ",2)
SET LEXE=$TRANSLATE($$FMTE^XLFDT(LEX2,"5Z"),"@"," ")
+11 SET LEXE=$PIECE(LEXE," ",2)
SET LEXT=$$FMDIFF^XLFDT(LEX2,LEX1,3)
+12 SET LEXD=$PIECE($TRANSLATE($$FMTE^XLFDT(LEX1,"5Z"),"@"," ")," ",1)
+13 IF $LENGTH(LEXT)'>8
SET LEXT=$TRANSLATE(LEXT," ","0")
+14 IF $LENGTH($GET(LEXPRE))
IF +($GET(LEXPRE))>0
IF LEXD=$GET(LEXPRE)
SET LEXD=" "" "" "
+15 SET LEXX=LEXN
SET LEXX=LEXX_$JUSTIFY(" ",(33-$LENGTH(LEXX)))_LEXD
+16 SET LEXX=LEXX_$JUSTIFY(" ",(45-$LENGTH(LEXX)))_LEXB
+17 SET LEXX=LEXX_$JUSTIFY(" ",(55-$LENGTH(LEXX)))_LEXE
+18 SET LEXX=LEXX_$JUSTIFY(" ",(65-$LENGTH(LEXX)))_LEXT
+19 DO XMB((" "_LEXX),LEXJ)
End DoDot:1
+20 IF $DATA(LEXMAIL)
DO XMS(LEXJ)
+21 QUIT
XMG ; Get Data for Message
+1 NEW LEXS,LEXC
SET LEXPRE=""
SET LEXC=0
FOR LEXS="WRD","SUB","SUP","REP","ASL","SSS"
Begin DoDot:1
+2 NEW LEXD,LEXB,LEXE,LEXN,LEXNEW,LEXT,LEXX
+3 SET LEXD=$PIECE($GET(^TMP("LEXXGI4TIM",LEXJ,LEXS,"BEG")),"^",1)
+4 IF +LEXD>0&(+LEXD<LEX1)
SET LEX1=LEXD
+5 SET LEXD=$TRANSLATE($$FMTE^XLFDT(LEXD,"5Z"),"@"," ")
+6 SET LEXB=$PIECE(LEXD," ",2)
+7 SET (LEXNEW,LEXD)=$PIECE(LEXD," ",1)
+8 SET LEXE=$PIECE($GET(^TMP("LEXXGI4TIM",LEXJ,LEXS,"END")),"^",1)
+9 IF +LEXE>LEX2
SET LEX2=LEXE
+10 SET LEXE=$TRANSLATE($$FMTE^XLFDT(LEXE,"5Z"),"@"," ")
+11 SET LEXE=$PIECE(LEXE," ",2)
+12 SET LEXT=$GET(^TMP("LEXXGI4TIM",LEXJ,LEXS,"TIM"))
+13 IF '$LENGTH(LEXB)
QUIT
+14 IF LEXS="SUB"
SET LEXN="Sub-Sets 757.21 ""Axxx"""
+15 IF LEXS="SSS"
SET LEXN="Sub-Sets 757.21 ""Axxx"""
+16 IF LEXS="SUP"
SET LEXN="Supplemental 757.18 ""AWRD"""
+17 IF LEXS="WRD"
SET LEXN="Expression 757.01 ""AWRD"""
+18 IF LEXS="REP"
SET LEXN="Replacements 757.05 ""AWRD"""
+19 IF LEXS="ASL"
SET LEXN="String Length 757.01 ""ASL"""
+20 IF '$LENGTH(LEXE)
SET LEXE=" "
+21 IF '$LENGTH(LEXT)
SET LEXT=" "
+22 IF LEXD=LEXPRE
SET LEXD=" "" "" "
+23 SET LEXPRE=LEXNEW
+24 SET LEXX=LEXN
SET LEXX=LEXX_$JUSTIFY(" ",(33-$LENGTH(LEXX)))_LEXD
+25 SET LEXX=LEXX_$JUSTIFY(" ",(45-$LENGTH(LEXX)))_LEXB
+26 SET LEXX=LEXX_$JUSTIFY(" ",(55-$LENGTH(LEXX)))_LEXE
+27 SET LEXX=LEXX_$JUSTIFY(" ",(65-$LENGTH(LEXX)))_LEXT
+28 SET LEXC=LEXC+1
IF LEXC=1
Begin DoDot:2
+29 IF $DATA(LEXMAIL)
DO XMB(" ",LEXJ)
+30 DO XMB(" Repair/Re-Index Index Date Start Finish Elapsed",LEXJ)
+31 DO XMB(" ----------------------- ------ ---------- -------- -------- --------",LEXJ)
End DoDot:2
+32 DO XMB((" "_LEXX),LEXJ)
+33 QUIT
End DoDot:1
+34 QUIT
XMB(X,Y) ; Build Message
+1 NEW LEXJ
SET X=$GET(X)
SET LEXJ=+($GET(Y))
IF '$DATA(LEXMAIL)
IF '$DATA(ZTQUEUED)
WRITE !,X
QUIT
+2 IF +LEXJ'>0
QUIT
NEW LEXI
SET LEXI=$ORDER(^TMP("LEXXGI4MSG",LEXJ," "),-1)+1
+3 SET ^TMP("LEXXGI4MSG",LEXJ,+LEXI)=$GET(X)
SET ^TMP("LEXXGI4MSG",LEXJ,0)=LEXI
+4 QUIT
XMS(X) ; Send Message
+1 NEW XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,LEXJ,LEXNM
+2 SET LEXJ=+($GET(X))
IF +LEXJ'>0
QUIT
IF '$DATA(^TMP("LEXXGI4MSG",LEXJ))
QUIT
+3 SET XMTEXT="^TMP(""LEXXGI4MSG"","_LEXJ_","
SET XMSUB="Repair Major Word Indexes"
+4 SET LEXNM=$$GET1^DIQ(200,+($GET(DUZ)),.01)
IF '$LENGTH(LEXNM)
KILL ^TMP("LEXXGI4MSG",LEXJ)
QUIT
+5 IF $DATA(LEXHOME)
SET XMY(("G.LEXINS@"_$$XMA))=""
SET XMY(LEXNM)=""
SET XMDUZ=.5
DO ^XMD
+6 KILL ^TMP("LEXXGI4MSG",LEXJ)
KILL XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,LEXNM
+7 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"
+4 ;
+5 ; Miscellaneous
BEG(X,Y) ; Begin Process - Subscript, Job
+1 NEW SUB,JNM
SET SUB=$GET(X)
SET X=$$NOW^XLFDT
SET JNM=+($GET(Y))
IF JNM'>0
SET JNM=$JOB
IF +($GET(LEXXM))>0
IF $LENGTH(SUB)
Begin DoDot:1
+2 SET @("^TMP(""LEXXGI4TIM"","_+($GET(JNM))_","""_SUB_""",""BEG"")")=X_"^"_$TRANSLATE($$FMTE^XLFDT(X,"5Z"),"@"," ")
End DoDot:1
+3 QUIT X
END(X,Y,Z) ; End Process - Begin, Subscript, Job
+1 NEW BEG,ELP,END,ELP,SUB,JNM
SET BEG=$GET(X)
SET SUB=$GET(Y)
SET JNM=+($GET(Z))
IF JNM'>0
SET JNM=$JOB
HANG 2
SET END=$$NOW^XLFDT
+2 SET ELP=""
IF +BEG>0&(+END>0)
SET ELP=$TRANSLATE($$FMDIFF^XLFDT(END,BEG,3)," ","0")
IF +($GET(LEXXM))>0
IF $LENGTH(SUB)
IF $LENGTH(ELP)
Begin DoDot:1
+3 SET @("^TMP(""LEXXGI4TIM"","_+($GET(JNM))_","""_SUB_""",""BEG"")")=BEG_"^"_$TRANSLATE($$FMTE^XLFDT(BEG,"5Z"),"@"," ")
+4 SET @("^TMP(""LEXXGI4TIM"","_+($GET(JNM))_","""_SUB_""",""END"")")=END_"^"_$TRANSLATE($$FMTE^XLFDT(END,"5Z"),"@"," ")
+5 SET @("^TMP(""LEXXGI4TIM"","_+($GET(JNM))_","""_SUB_""",""TIM"")")=ELP
End DoDot:1
+6 QUIT X
KIL(X) ; Kill ^TMP("LEXXGI4TIM",$J)
+1 NEW JNM
SET JNM=$GET(X)
IF JNM'>0
SET JNM=$JOB
IF +($GET(LEXXM))>0
Begin DoDot:1
+2 KILL @("^TMP(""LEXXGI4TIM"","_+($GET(JNM))_")")
+3 KILL @("^TMP(""LEXXGI4TIM"","_$JOB_")")
End DoDot:1
+4 QUIT
CLR ; Clear Variables
+1 KILL LEXLOUD,LEXTEST,LEXJ,LEXXM,LEXHOME
+2 QUIT
