LEXRXXS ;ISL/KER - Re-Index Save/Send ;04/21/2014
;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEXT( SACC 1.3
; ^TMP("LEXRX") SACC 2.3.2.5.1
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$TITLE^XLFSTR ICR 10104
; HOME^%ZIS ICR 10086
; ^DIC ICR 10006
; ^XMD ICR 10070
;
; Local Variables NEWed or KILLed Elsewhere
; LEXAMSO User Selection NEWed/KILLed by LEXRX
; LEXSUBJ Msg Subject NEWed/KILLed by LEXRXXT
; LEXTITL Msg Title NEWed/KILLed by LEXRXXT
; LEXFMT Display format NEWed/KILLed by LEXRXXT2
; LEXQ Quiet flag NEWed/KILLed by LEXRXXT2
; LEXNAM Task Name NEWed/KILLed by LEXRXXT2
; LEXINS Install Flag NEWed/KILLed by Post-Install
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
Q
; Repair Index Report
REP(LEXFI,LEXFS,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP) ; Build
S LEXFI=$G(LEXFI),LEXFS=$G(LEXFS),LEXIDX=$G(LEXIDX),LEXNDS=+($G(LEXNDS))
S LEXERR=+($G(LEXERR)),LEXIDXT=$G(LEXIDXT),LEXELP=$G(LEXELP) H 1
S:+($G(LEXFI))>0&('$L($G(LEXELP))) LEXELP="00:00:01"
N LEXT,LEXNM,LEXTELP,LEXTERR,LEXTFI,LEXTFS,LEXTIDT,LEXTIDX,LEXTNDS,LEXIDXN
S LEXTFI=+LEXFI Q:+LEXTFI'>0 Q:$P(LEXTFI,".",1)'="757" S LEXNM=$$FN(+LEXFI)
S:'$L(LEXNM) LEXTFI=" "_LEXTFI
S LEXTFS=+($G(LEXFS))
Q:+LEXTFS'>0 Q:$P(LEXTFS,".",1)'="757"
S:'$L(LEXNM) LEXTFS=" "_LEXTFS
S LEXTIDX=$G(LEXIDX) Q:'$L(LEXTIDX)
S LEXTNDS=LEXNDS S:+LEXTNDS'>0 LEXTNDS=""
I +LEXNDS'>0,+LEXFI>0,+LEXFS>0,$L(LEXIDX),LEXIDX'="ALLIX" D Q
. K ^TMP("LEXRX",$J,"D",1,+LEXFI,+LEXFS,LEXIDX)
. D REPS
S LEXTERR=+($G(LEXERR)) S:+LEXTERR'>0 LEXTERR=""
S:+($G(LEXERR))>0 LEXTERR=$J(LEXTERR,7)_" "
S:+($G(LEXERR))'>0 LEXTERR=" ------ "
S:+($G(LEXERR))'>0&(LEXIDX="ALLIX") LEXTERR=" "
S:LEXIDX="ALLIX" LEXTNDS=""
S LEXTNDS=$J(LEXTNDS,8)_" "
S LEXTIDT=$G(LEXIDXT)
S:LEXIDX="ALLIX" LEXIDXT="All Cross-References"
S LEXIDXT=$E(LEXIDXT,1,35)
Q:'$L(LEXTIDT)
S LEXTELP=LEXELP
S LEXTELP=LEXTELP_$J(" ",(9-$L(LEXTELP)))
S LEXTFI=LEXTFI_$J(" ",(9-$L(LEXTFI)))
S LEXTFS=LEXTFS_$J(" ",(9-$L(LEXTFS)))
S:LEXIDX="ALLIX" LEXTIDX="Re-Index"
S LEXTIDX=LEXTIDX_$J(" ",(9-$L(LEXTIDX)))
S:LEXTFI=LEXTFS LEXT=LEXTFI_LEXTIDX_LEXTNDS_LEXTERR_LEXTELP_LEXIDXT
S:LEXTFI'=LEXTFS LEXT=LEXTFS_LEXTIDX_LEXTNDS_LEXTERR_LEXTELP_LEXIDXT
S:+($G(LEXERR)) ^TMP("LEXRX",$J,"ERR")=+($G(^TMP("LEXRX",$J,"ERR")))+($G(LEXERR))
I $L($G(LEXELP)) D
. N LEXT S LEXT=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
. S ^TMP("LEXRX",$J,"T",1,"ELAP")=$$ADDT^LEXRXXM(LEXT,$G(LEXELP))
S LEXIDXN=LEXIDX S:LEXIDX="ALLIX" LEXIDXN="~"
I LEXT["Re-Index"&(LEXT["All Cross-References") D
. S ^TMP("LEXRX",$J,"D",1,+LEXFI,"~",LEXIDXN)=LEXT
I LEXT'["Re-Index"!(LEXT'["All Cross-References") D
. S ^TMP("LEXRX",$J,"D",1,+LEXFI,+LEXFS,LEXIDXN)=LEXT
D REPS
Q
REPS ; Save
K ^TMP("LEXRX",$J,"R",1)
N LEXALL,LEXTFI,LEXTFS,LEXTIX,LEXC,LEXT K LEXALL S LEXC=0,LEXTFI="" F S LEXTFI=$O(^TMP("LEXRX",$J,"D",1,LEXTFI)) Q:'$L(LEXTFI) D
. S LEXTFS="" F S LEXTFS=$O(^TMP("LEXRX",$J,"D",1,LEXTFI,LEXTFS)) Q:'$L(LEXTFS) D
. . K LEXALL S LEXTIX="" F S LEXTIX=$O(^TMP("LEXRX",$J,"D",1,LEXTFI,LEXTFS,LEXTIX)) Q:'$L(LEXTIX) D
. . . S LEXT=$G(^TMP("LEXRX",$J,"D",1,LEXTFI,LEXTFS,LEXTIX)) Q:'$L(LEXT) S LEXC=LEXC+1
. . . I LEXT["Re-Index"&(LEXT["All Cross-References") S LEXALL=LEXT Q
. . . I LEXC=1 D
. . . . S ^TMP("LEXRX",$J,"R",1,1)="Repair Summary (large files only)"
. . . . S:$G(LEXNAM)="LEXRXONE" ^TMP("LEXRX",$J,"R",1,1)="Repair File"
. . . . S ^TMP("LEXRX",$J,"R",1,2)=" "
. . . . S ^TMP("LEXRX",$J,"R",1,3)="File Index Nodes Errors Time Index Format"
. . . . S ^TMP("LEXRX",$J,"R",1,4)="-------- ------ -------- ------- -------- -----------------------------------"
. . . . S ^TMP("LEXRX",$J,"R",1,0)=4,LEXC=5
. . . S ^TMP("LEXRX",$J,"R",1,LEXC)=LEXT,^TMP("LEXRX",$J,"R",1,0)=LEXC
. . I $L($G(LEXALL)) D
. . . N LEXC S LEXC=$O(^TMP("LEXRX",$J,"R",1," "),-1)+1
. . . S ^TMP("LEXRX",$J,"R",1,LEXC)=LEXALL,^TMP("LEXRX",$J,"R",1,0)=LEXC
D RCMP
Q
REPD ; Display
N LEXC W ! S LEXC=0 F S LEXC=$O(^TMP("LEXRX",$J,"R",1,LEXC)) Q:+LEXC'>0 W !,$G(^TMP("LEXRX",$J,"R",1,LEXC))
W !
Q
;
; Re-Index Report
REX(LEXFI,LEXNM,LEXELP,LEXIX) ; Build
K ^TMP("LEXRX",$J,"R",2)
N LEXI,LEXSP,LEXTFI,LEXTNM,LEXTELP,LEXC S $P(LEXSP," ",40)=" ",LEXFI=+($G(LEXFI))
S:+($G(LEXFI))>0&($L($G(LEXNM)))&('$L($G(LEXELP))) LEXELP="00:00:01"
K:+LEXFI>0 ^TMP("LEXRX",$J,"D",2,+LEXFI)
S LEXTFI=+($G(LEXFI)) Q:+LEXTFI'>0 Q:$P(LEXTFI,".",1)'="757"
S LEXTFI=LEXTFI_$J(" ",(8-$L(LEXTFI))) S LEXTNM=$G(LEXNM) S LEXTNM=LEXTNM_$J(" ",(22-$L(LEXTNM)))
S LEXTELP=$G(LEXELP) S LEXTELP=LEXTELP_$J(" ",(10-$L(LEXTELP)))
S LEXT=LEXTFI_LEXTNM_LEXTELP_$G(LEXIX(1))
I $L($G(LEXELP)) D
. S ^TMP("LEXRX",$J,"T",2,"ELAP")=$$ADDT^LEXRXXM($G(^TMP("LEXRX",$J,"T",2,"ELAP")),$G(LEXELP))
S ^TMP("LEXRX",$J,"D",2,LEXFI,1)=LEXT
S LEXC=1 I $O(LEXIX(1))>0 D
. S LEXI=1 F S LEXI=$O(LEXIX(LEXI)) Q:+LEXI'>0 D
. . N LEX S LEX=$G(LEXIX(LEXI)) Q:'$L(LEX)
. . S LEXT=LEXSP_LEX,LEXC=LEXC+1
. . W !,LEXT S ^TMP("LEXRX",$J,"D",2,+LEXFI,LEXC)=LEXT
D REXS
Q
REXS ; Save
K ^TMP("LEXRX",$J,"R",2)
N LEXFIT,LEXI,LEXC,LEXT,LEXE S LEXC=0,LEXFIT="" F S LEXFIT=$O(^TMP("LEXRX",$J,"D",2,LEXFIT)) Q:'$L(LEXFIT) D
. S LEXI=0 F S LEXI=$O(^TMP("LEXRX",$J,"D",2,LEXFIT,LEXI)) Q:+LEXI'>0 D
. . S LEXT=$G(^TMP("LEXRX",$J,"D",2,LEXFIT,LEXI)) Q:'$L(LEXT) S LEXC=LEXC+1 I LEXC=1 D
. . . S ^TMP("LEXRX",$J,"R",2,1)="Re-Index Summary (small files only)"
. . . S:$G(LEXNAM)="LEXRXONE" ^TMP("LEXRX",$J,"R",2,1)="Re-Index File"
. . . S ^TMP("LEXRX",$J,"R",2,2)=" "
. . . S ^TMP("LEXRX",$J,"R",2,3)="File File Name Time Cross-References"
. . . S ^TMP("LEXRX",$J,"R",2,4)="------- --------------------- -------- -------------------------------------"
. . . S ^TMP("LEXRX",$J,"R",2,0)=4,LEXC=5
. . S ^TMP("LEXRX",$J,"R",2,LEXC)=LEXT,^TMP("LEXRX",$J,"R",2,0)=LEXC
D RCMP
Q
REXD ; Display
N LEXC W ! S LEXC=0 F S LEXC=$O(^TMP("LEXRX",$J,"R",2,LEXC)) Q:+LEXC'>0 W !,$G(^TMP("LEXRX",$J,"R",2,LEXC))
W !
Q
;
; Compile Report (Repair/Re-Index)
RCMP ; Compile
K ^TMP("LEXRX",$J,"R",3)
N LEXI,LEXC,LEXE,LEXN1,LEXN2,LEXTT,LEXT1,LEXT2,LEXLEN
S LEXLEN=33 S:$G(LEXFMT)=2!($G(LEXFMT)=0) LEXLEN=30
S (LEXI,LEXC)=0 F S LEXI=$O(^TMP("LEXRX",$J,"R",1,LEXI)) Q:+LEXI'>0 D
. N LEXT S LEXC=LEXC+1,LEXT=$G(^TMP("LEXRX",$J,"R",1,LEXI)),^TMP("LEXRX",$J,"R",3,LEXC)=LEXT
I $O(^TMP("LEXRX",$J,"R",1,0))>0,$O(^TMP("LEXRX",$J,"R",2,0))>0 D
. S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1,^TMP("LEXRX",$J,"R",3,LEXC)=" "
S LEXI=0 F S LEXI=$O(^TMP("LEXRX",$J,"R",2,LEXI)) Q:+LEXI'>0 D
. N LEXT S LEXC=LEXC+1,LEXT=$G(^TMP("LEXRX",$J,"R",2,LEXI)),^TMP("LEXRX",$J,"R",3,LEXC)=LEXT
S LEXTT=$$TOT^LEXRXXM
S LEXT1=$G(^TMP("LEXRX",$J,"T",1,"ELAP")),LEXT2=$G(^TMP("LEXRX",$J,"T",2,"ELAP"))
S LEXN1=+($P(LEXT1,":",1))+($P(LEXT1,":",2))+($P(LEXT1,":",3))
S LEXN2=+($P(LEXT2,":",1))+($P(LEXT2,":",2))+($P(LEXT2,":",3))
S:LEXN1'>0&($G(LEXAMSO)="O")&(+($G(LEXFI))>0) LEXTT=$$ADD^LEXRXXM(LEXT1,1)
S:LEXN2'>0&($G(LEXAMSO)="O")&(+($G(LEXFI))>0) LEXTT=$$ADD^LEXRXXM(LEXT2,1)
S:LEXN1>0&(LEXN2'>0) LEXTT=$$ADD^LEXRXXM(LEXT1,1)
S:LEXN1'>0&(LEXN2>0) LEXTT=$$ADD^LEXRXXM(LEXT2,1)
S:LEXN1>0&(LEXN2>0) LEXTT=$$ADDT^LEXRXXM(LEXT1,LEXT2)
S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1,^TMP("LEXRX",$J,"R",3,LEXC)=" "
I $G(LEXFMT)=3 D
. Q S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1,^TMP("LEXRX",$J,"R",3,LEXC)=" Elapsed Time"
. I +($G(LEXN1))>0 D
. . N LEXT S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1,LEXT=" Repair Large Files:",LEXT=LEXT_$J(" ",(LEXLEN-$L(LEXT)))
. . S ^TMP("LEXRX",$J,"R",3,LEXC)=LEXT_$G(LEXT1)
. I +($G(LEXN2))>0 D
. . N LEXT S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1
. . S LEXT=" Re-Index Small Files:",LEXT=LEXT_$J(" ",(LEXLEN-$L(LEXT)))
. . S ^TMP("LEXRX",$J,"R",3,LEXC)=LEXT_$G(LEXT2)
. I +LEXN1>0!(LEXN2>0) D
. . N LEXT S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1,LEXT=" Total All Files:",LEXT=LEXT_$J(" ",(LEXLEN-$L(LEXT)))
. . S ^TMP("LEXRX",$J,"R",3,LEXC)=LEXT_$G(LEXTT)
I $G(LEXFMT)=1 D
. Q N LEXE,LEXT S LEXT=" Repair Large Files:"
. S:$G(LEXAMSO)="O"&(+($G(LEXFI))>0) LEXT=" Repair File "_+($G(LEXFI))_":"
. S LEXT=LEXT_$J(" ",(LEXLEN-$L(LEXT)))
. S LEXE=$$ADD^LEXRXXM($G(LEXT1),1) I +($G(LEXN1))>0!(LEXAMSO="O") D
. . S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1
. . S ^TMP("LEXRX",$J,"R",3,LEXC)=LEXT_$G(LEXE)
I $G(LEXFMT)=2 D
. Q N LEXE,LEXT S LEXT=" Re-Index Small Files:"
. S:$G(LEXAMSO)="O"&(+($G(LEXFI))>0) LEXT=" Re-Index File "_+($G(LEXFI))_":"
. S:$G(LEXTITL)["Kill" LEXT=" Kill/Re-Index All Files:"
. S LEXT=LEXT_$J(" ",(LEXLEN-$L(LEXT)))
. N LEXE S LEXE=$$ADD^LEXRXXM(LEXT2,1) I +LEXN2>0!($G(LEXAMSO)="O") D
. . S LEXC=$O(^TMP("LEXRX",$J,"R",3," "),-1)+1
. . S ^TMP("LEXRX",$J,"R",3,LEXC)=LEXT_$G(LEXE)
Q
RCMD ; Display
N LEXC W ! S LEXC=0 F S LEXC=$O(^TMP("LEXRX",$J,"R",3,LEXC)) Q:+LEXC'>0 W !,$G(^TMP("LEXRX",$J,"R",3,LEXC))
W !
Q
;
SEND ; Task MAILMAN to Send Message
G:$D(LEXQ) MAILQ N LEX,LEXC,LEXI,LEXS,LEXT
K ^TMP("LEXRX",$J,"MSG")
S LEXC=1,LEXI=0 F S LEXI=$O(^TMP("LEXRX",$J,"R",3,LEXI)) Q:+LEXI'>0 D
. S LEXT=$E($G(^TMP("LEXRX",$J,"R",3,LEXI)),1,79)
. I LEXT[" (large files only)"!(LEXT[" (small files only)") D Q
. . S LEXC=LEXC+1,^TMP("LEXRX",$J,"MSG",LEXC,0)=LEXT
. S LEXC=LEXC+1,^TMP("LEXRX",$J,"MSG",LEXC,0)=LEXT
D ERR,SUM S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)
I +LEXC>1 S ^TMP("LEXRX",$J,"MSG",1,0)=" ",^TMP("LEXRX",$J,"MSG",(LEXC+1),0)=" "
S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1),^TMP("LEXRX",$J,"MSG",0)=+LEXC
S LEXS="Lexicon Index Repair/Re-Index Report" S:$L($G(LEXSUBJ)) LEXS=$G(LEXSUBJ)
D PRG,MAIL,HOME^%ZIS
Q
MAIL ; MAILMAN
N DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
G:'$D(^TMP("LEXRX",$J,"MSG")) MAILQ G:+($G(^TMP("LEXRX",$J,"MSG",0)))=0 MAILQ
K XMZ N DIFROM S XMSUB="Lexicon Cross-Reference Repair/Re-Index"
S:$L($G(LEXSUBJ)) XMSUB=$G(LEXSUBJ)
K XMY S:+($G(DUZ))>0 XMY(+($G(DUZ)))=""
I $D(LEXINS) D
. K XMY N LEXADR S LEXADR=$$ADR Q:'$L(LEXADR)
. S LEXADR="G.LEXINS@"_LEXADR S XMY(LEXADR)=""
G:'$D(XMY) MAILQ
S XMTEXT="^TMP(""LEXRX"",$J,""MSG"",",XMDUZ=.5 D ^XMD
I '$D(ZTQUEUED),+($G(XMZ))>0,'$D(LEXINS) D
. W !!," Lexicon Cross-Reference Repair/Re-Index message (#",+($G(XMZ)),") sent"
MAILQ ; End of MAILMAN
K ^TMP("LEXRX",$J) K DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
Q
;
; Miscellaneous
SUM ; Timing Summary
I $O(^TMP("LEXRX",$J,"MSG",0))>0 D
. N LEXBEG,LEXEND,LEXELP,LEXC
. S LEXBEG=+($G(^TMP("LEXRX",$J,"P",1))) Q:$P(LEXBEG,".",1)'?7N
. S LEXEND=+($G(^TMP("LEXRX",$J,"P",2))) Q:$P(LEXEND,".",1)'?7N
. Q:LEXBEG=LEXEND S LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3) Q:$L(LEXELP,":")'=3
. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
. S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)
. S LEXT=$$TM^LEXRXXM($G(^TMP("LEXRX",$J,"MSG",LEXC,0)))
. I $L(LEXT) D
. . S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)+1
. . S ^TMP("LEXRX",$J,"MSG",LEXC,0)=" "
. S LEXT="Re-Index Started: "_$$ED^LEXRXXM(LEXBEG)
. S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)+1
. S ^TMP("LEXRX",$J,"MSG",LEXC,0)=LEXT
. S LEXT="Re-Index Finished: "_$$ED^LEXRXXM(LEXEND)
. S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)+1
. S ^TMP("LEXRX",$J,"MSG",LEXC,0)=LEXT
. S LEXT="Elapsed Time: "_LEXELP
. S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)+1
. S ^TMP("LEXRX",$J,"MSG",LEXC,0)=LEXT
Q
ERR ; Error Summary
I $O(^TMP("LEXRX",$J,"MSG",0))>0 D
. N LEXE,LEXT,LEXC
. S LEXE=+($G(^TMP("LEXRX",$J,"ERR"))) Q:LEXE'>0
. S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)
. S LEXT=$$TM^LEXRXXM($G(^TMP("LEXRX",$J,"MSG",LEXC,0)))
. I $L(LEXT) D
. . S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)+1
. . S ^TMP("LEXRX",$J,"MSG",LEXC,0)=" "
. S LEXT="Errors Repaired: "
. S LEXT=LEXT_LEXE
. S LEXC=$O(^TMP("LEXRX",$J,"MSG"," "),-1)+1
. S ^TMP("LEXRX",$J,"MSG",LEXC,0)=LEXT
Q
ADR(LEX) ; Mailing Address -G.LEXINS@FO-SLC.MED.VA.GOV,
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)="FO-SLC.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"
FN(X) ; Filename
Q:$D(^LEX(+($G(X)),0)) $$TITLE^XLFSTR($P($G(^LEX(+($G(X)),0)),"^",1))
Q:$D(^LEXT(+($G(X)),0)) $$TITLE^XLFSTR($P($G(^LEXT(+($G(X)),0)),"^",1))
Q ""
PRG ; Purge ^TMP("LEXRX"
N LEX S LEX="" F S LEX=$O(^TMP("LEXRX",$J,LEX)) Q:'$L(LEX) K:LEX'="MSG" ^TMP("LEXRX",$J,LEX)
Q
ST ; Show ^TMP
N LEXNN,LEXNC S LEXNN="^TMP(""LEXRX"","_$J_")",LEXNC="^TMP(""LEXRX"","_$J_","
W !! F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) W !,LEXNN,"=",@LEXNN
W !!
Q
CLR ; Clear
K LEXAMSO,LEXFMT,LEXQ,LEXSUBJ,LEXTITL,LEXINS,ZTQUEUED,LEXNAM
Q
LEXRXXS ;ISL/KER - Re-Index Save/Send ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^LEX( SACC 1.3
+5 ; ^LEXT( SACC 1.3
+6 ; ^TMP("LEXRX") SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; $$FMDIFF^XLFDT ICR 10103
+10 ; $$TITLE^XLFSTR ICR 10104
+11 ; HOME^%ZIS ICR 10086
+12 ; ^DIC ICR 10006
+13 ; ^XMD ICR 10070
+14 ;
+15 ; Local Variables NEWed or KILLed Elsewhere
+16 ; LEXAMSO User Selection NEWed/KILLed by LEXRX
+17 ; LEXSUBJ Msg Subject NEWed/KILLed by LEXRXXT
+18 ; LEXTITL Msg Title NEWed/KILLed by LEXRXXT
+19 ; LEXFMT Display format NEWed/KILLed by LEXRXXT2
+20 ; LEXQ Quiet flag NEWed/KILLed by LEXRXXT2
+21 ; LEXNAM Task Name NEWed/KILLed by LEXRXXT2
+22 ; LEXINS Install Flag NEWed/KILLed by Post-Install
+23 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+24 ;
+25 QUIT
+26 ; Repair Index Report
REP(LEXFI,LEXFS,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP) ; Build
+1 SET LEXFI=$GET(LEXFI)
SET LEXFS=$GET(LEXFS)
SET LEXIDX=$GET(LEXIDX)
SET LEXNDS=+($GET(LEXNDS))
+2 SET LEXERR=+($GET(LEXERR))
SET LEXIDXT=$GET(LEXIDXT)
SET LEXELP=$GET(LEXELP)
HANG 1
+3 IF +($GET(LEXFI))>0&('$LENGTH($GET(LEXELP)))
SET LEXELP="00:00:01"
+4 NEW LEXT,LEXNM,LEXTELP,LEXTERR,LEXTFI,LEXTFS,LEXTIDT,LEXTIDX,LEXTNDS,LEXIDXN
+5 SET LEXTFI=+LEXFI
IF +LEXTFI'>0
QUIT
IF $PIECE(LEXTFI,".",1)'="757"
QUIT
SET LEXNM=$$FN(+LEXFI)
+6 IF '$LENGTH(LEXNM)
SET LEXTFI=" "_LEXTFI
+7 SET LEXTFS=+($GET(LEXFS))
+8 IF +LEXTFS'>0
QUIT
IF $PIECE(LEXTFS,".",1)'="757"
QUIT
+9 IF '$LENGTH(LEXNM)
SET LEXTFS=" "_LEXTFS
+10 SET LEXTIDX=$GET(LEXIDX)
IF '$LENGTH(LEXTIDX)
QUIT
+11 SET LEXTNDS=LEXNDS
IF +LEXTNDS'>0
SET LEXTNDS=""
+12 IF +LEXNDS'>0
IF +LEXFI>0
IF +LEXFS>0
IF $LENGTH(LEXIDX)
IF LEXIDX'="ALLIX"
Begin DoDot:1
+13 KILL ^TMP("LEXRX",$JOB,"D",1,+LEXFI,+LEXFS,LEXIDX)
+14 DO REPS
End DoDot:1
QUIT
+15 SET LEXTERR=+($GET(LEXERR))
IF +LEXTERR'>0
SET LEXTERR=""
+16 IF +($GET(LEXERR))>0
SET LEXTERR=$JUSTIFY(LEXTERR,7)_" "
+17 IF +($GET(LEXERR))'>0
SET LEXTERR=" ------ "
+18 IF +($GET(LEXERR))'>0&(LEXIDX="ALLIX")
SET LEXTERR=" "
+19 IF LEXIDX="ALLIX"
SET LEXTNDS=""
+20 SET LEXTNDS=$JUSTIFY(LEXTNDS,8)_" "
+21 SET LEXTIDT=$GET(LEXIDXT)
+22 IF LEXIDX="ALLIX"
SET LEXIDXT="All Cross-References"
+23 SET LEXIDXT=$EXTRACT(LEXIDXT,1,35)
+24 IF '$LENGTH(LEXTIDT)
QUIT
+25 SET LEXTELP=LEXELP
+26 SET LEXTELP=LEXTELP_$JUSTIFY(" ",(9-$LENGTH(LEXTELP)))
+27 SET LEXTFI=LEXTFI_$JUSTIFY(" ",(9-$LENGTH(LEXTFI)))
+28 SET LEXTFS=LEXTFS_$JUSTIFY(" ",(9-$LENGTH(LEXTFS)))
+29 IF LEXIDX="ALLIX"
SET LEXTIDX="Re-Index"
+30 SET LEXTIDX=LEXTIDX_$JUSTIFY(" ",(9-$LENGTH(LEXTIDX)))
+31 IF LEXTFI=LEXTFS
SET LEXT=LEXTFI_LEXTIDX_LEXTNDS_LEXTERR_LEXTELP_LEXIDXT
+32 IF LEXTFI'=LEXTFS
SET LEXT=LEXTFS_LEXTIDX_LEXTNDS_LEXTERR_LEXTELP_LEXIDXT
+33 IF +($GET(LEXERR))
SET ^TMP("LEXRX",$JOB,"ERR")=+($GET(^TMP("LEXRX",$JOB,"ERR")))+($GET(LEXERR))
+34 IF $LENGTH($GET(LEXELP))
Begin DoDot:1
+35 NEW LEXT
SET LEXT=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
+36 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=$$ADDT^LEXRXXM(LEXT,$GET(LEXELP))
End DoDot:1
+37 SET LEXIDXN=LEXIDX
IF LEXIDX="ALLIX"
SET LEXIDXN="~"
+38 IF LEXT["Re-Index"&(LEXT["All Cross-References")
Begin DoDot:1
+39 SET ^TMP("LEXRX",$JOB,"D",1,+LEXFI,"~",LEXIDXN)=LEXT
End DoDot:1
+40 IF LEXT'["Re-Index"!(LEXT'["All Cross-References")
Begin DoDot:1
+41 SET ^TMP("LEXRX",$JOB,"D",1,+LEXFI,+LEXFS,LEXIDXN)=LEXT
End DoDot:1
+42 DO REPS
+43 QUIT
REPS ; Save
+1 KILL ^TMP("LEXRX",$JOB,"R",1)
+2 NEW LEXALL,LEXTFI,LEXTFS,LEXTIX,LEXC,LEXT
KILL LEXALL
SET LEXC=0
SET LEXTFI=""
FOR
SET LEXTFI=$ORDER(^TMP("LEXRX",$JOB,"D",1,LEXTFI))
IF '$LENGTH(LEXTFI)
QUIT
Begin DoDot:1
+3 SET LEXTFS=""
FOR
SET LEXTFS=$ORDER(^TMP("LEXRX",$JOB,"D",1,LEXTFI,LEXTFS))
IF '$LENGTH(LEXTFS)
QUIT
Begin DoDot:2
+4 KILL LEXALL
SET LEXTIX=""
FOR
SET LEXTIX=$ORDER(^TMP("LEXRX",$JOB,"D",1,LEXTFI,LEXTFS,LEXTIX))
IF '$LENGTH(LEXTIX)
QUIT
Begin DoDot:3
+5 SET LEXT=$GET(^TMP("LEXRX",$JOB,"D",1,LEXTFI,LEXTFS,LEXTIX))
IF '$LENGTH(LEXT)
QUIT
SET LEXC=LEXC+1
+6 IF LEXT["Re-Index"&(LEXT["All Cross-References")
SET LEXALL=LEXT
QUIT
+7 IF LEXC=1
Begin DoDot:4
+8 SET ^TMP("LEXRX",$JOB,"R",1,1)="Repair Summary (large files only)"
+9 IF $GET(LEXNAM)="LEXRXONE"
SET ^TMP("LEXRX",$JOB,"R",1,1)="Repair File"
+10 SET ^TMP("LEXRX",$JOB,"R",1,2)=" "
+11 SET ^TMP("LEXRX",$JOB,"R",1,3)="File Index Nodes Errors Time Index Format"
+12 SET ^TMP("LEXRX",$JOB,"R",1,4)="-------- ------ -------- ------- -------- -----------------------------------"
+13 SET ^TMP("LEXRX",$JOB,"R",1,0)=4
SET LEXC=5
End DoDot:4
+14 SET ^TMP("LEXRX",$JOB,"R",1,LEXC)=LEXT
SET ^TMP("LEXRX",$JOB,"R",1,0)=LEXC
End DoDot:3
+15 IF $LENGTH($GET(LEXALL))
Begin DoDot:3
+16 NEW LEXC
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",1," "),-1)+1
+17 SET ^TMP("LEXRX",$JOB,"R",1,LEXC)=LEXALL
SET ^TMP("LEXRX",$JOB,"R",1,0)=LEXC
End DoDot:3
End DoDot:2
End DoDot:1
+18 DO RCMP
+19 QUIT
REPD ; Display
+1 NEW LEXC
WRITE !
SET LEXC=0
FOR
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",1,LEXC))
IF +LEXC'>0
QUIT
WRITE !,$GET(^TMP("LEXRX",$JOB,"R",1,LEXC))
+2 WRITE !
+3 QUIT
+4 ;
+5 ; Re-Index Report
REX(LEXFI,LEXNM,LEXELP,LEXIX) ; Build
+1 KILL ^TMP("LEXRX",$JOB,"R",2)
+2 NEW LEXI,LEXSP,LEXTFI,LEXTNM,LEXTELP,LEXC
SET $PIECE(LEXSP," ",40)=" "
SET LEXFI=+($GET(LEXFI))
+3 IF +($GET(LEXFI))>0&($LENGTH($GET(LEXNM)))&('$LENGTH($GET(LEXELP)))
SET LEXELP="00:00:01"
+4 IF +LEXFI>0
KILL ^TMP("LEXRX",$JOB,"D",2,+LEXFI)
+5 SET LEXTFI=+($GET(LEXFI))
IF +LEXTFI'>0
QUIT
IF $PIECE(LEXTFI,".",1)'="757"
QUIT
+6 SET LEXTFI=LEXTFI_$JUSTIFY(" ",(8-$LENGTH(LEXTFI)))
SET LEXTNM=$GET(LEXNM)
SET LEXTNM=LEXTNM_$JUSTIFY(" ",(22-$LENGTH(LEXTNM)))
+7 SET LEXTELP=$GET(LEXELP)
SET LEXTELP=LEXTELP_$JUSTIFY(" ",(10-$LENGTH(LEXTELP)))
+8 SET LEXT=LEXTFI_LEXTNM_LEXTELP_$GET(LEXIX(1))
+9 IF $LENGTH($GET(LEXELP))
Begin DoDot:1
+10 SET ^TMP("LEXRX",$JOB,"T",2,"ELAP")=$$ADDT^LEXRXXM($GET(^TMP("LEXRX",$JOB,"T",2,"ELAP")),$GET(LEXELP))
End DoDot:1
+11 SET ^TMP("LEXRX",$JOB,"D",2,LEXFI,1)=LEXT
+12 SET LEXC=1
IF $ORDER(LEXIX(1))>0
Begin DoDot:1
+13 SET LEXI=1
FOR
SET LEXI=$ORDER(LEXIX(LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:2
+14 NEW LEX
SET LEX=$GET(LEXIX(LEXI))
IF '$LENGTH(LEX)
QUIT
+15 SET LEXT=LEXSP_LEX
SET LEXC=LEXC+1
+16 WRITE !,LEXT
SET ^TMP("LEXRX",$JOB,"D",2,+LEXFI,LEXC)=LEXT
End DoDot:2
End DoDot:1
+17 DO REXS
+18 QUIT
REXS ; Save
+1 KILL ^TMP("LEXRX",$JOB,"R",2)
+2 NEW LEXFIT,LEXI,LEXC,LEXT,LEXE
SET LEXC=0
SET LEXFIT=""
FOR
SET LEXFIT=$ORDER(^TMP("LEXRX",$JOB,"D",2,LEXFIT))
IF '$LENGTH(LEXFIT)
QUIT
Begin DoDot:1
+3 SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXRX",$JOB,"D",2,LEXFIT,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:2
+4 SET LEXT=$GET(^TMP("LEXRX",$JOB,"D",2,LEXFIT,LEXI))
IF '$LENGTH(LEXT)
QUIT
SET LEXC=LEXC+1
IF LEXC=1
Begin DoDot:3
+5 SET ^TMP("LEXRX",$JOB,"R",2,1)="Re-Index Summary (small files only)"
+6 IF $GET(LEXNAM)="LEXRXONE"
SET ^TMP("LEXRX",$JOB,"R",2,1)="Re-Index File"
+7 SET ^TMP("LEXRX",$JOB,"R",2,2)=" "
+8 SET ^TMP("LEXRX",$JOB,"R",2,3)="File File Name Time Cross-References"
+9 SET ^TMP("LEXRX",$JOB,"R",2,4)="------- --------------------- -------- -------------------------------------"
+10 SET ^TMP("LEXRX",$JOB,"R",2,0)=4
SET LEXC=5
End DoDot:3
+11 SET ^TMP("LEXRX",$JOB,"R",2,LEXC)=LEXT
SET ^TMP("LEXRX",$JOB,"R",2,0)=LEXC
End DoDot:2
End DoDot:1
+12 DO RCMP
+13 QUIT
REXD ; Display
+1 NEW LEXC
WRITE !
SET LEXC=0
FOR
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",2,LEXC))
IF +LEXC'>0
QUIT
WRITE !,$GET(^TMP("LEXRX",$JOB,"R",2,LEXC))
+2 WRITE !
+3 QUIT
+4 ;
+5 ; Compile Report (Repair/Re-Index)
RCMP ; Compile
+1 KILL ^TMP("LEXRX",$JOB,"R",3)
+2 NEW LEXI,LEXC,LEXE,LEXN1,LEXN2,LEXTT,LEXT1,LEXT2,LEXLEN
+3 SET LEXLEN=33
IF $GET(LEXFMT)=2!($GET(LEXFMT)=0)
SET LEXLEN=30
+4 SET (LEXI,LEXC)=0
FOR
SET LEXI=$ORDER(^TMP("LEXRX",$JOB,"R",1,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:1
+5 NEW LEXT
SET LEXC=LEXC+1
SET LEXT=$GET(^TMP("LEXRX",$JOB,"R",1,LEXI))
SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT
End DoDot:1
+6 IF $ORDER(^TMP("LEXRX",$JOB,"R",1,0))>0
IF $ORDER(^TMP("LEXRX",$JOB,"R",2,0))>0
Begin DoDot:1
+7 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=" "
End DoDot:1
+8 SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXRX",$JOB,"R",2,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:1
+9 NEW LEXT
SET LEXC=LEXC+1
SET LEXT=$GET(^TMP("LEXRX",$JOB,"R",2,LEXI))
SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT
End DoDot:1
+10 SET LEXTT=$$TOT^LEXRXXM
+11 SET LEXT1=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
SET LEXT2=$GET(^TMP("LEXRX",$JOB,"T",2,"ELAP"))
+12 SET LEXN1=+($PIECE(LEXT1,":",1))+($PIECE(LEXT1,":",2))+($PIECE(LEXT1,":",3))
+13 SET LEXN2=+($PIECE(LEXT2,":",1))+($PIECE(LEXT2,":",2))+($PIECE(LEXT2,":",3))
+14 IF LEXN1'>0&($GET(LEXAMSO)="O")&(+($GET(LEXFI))>0)
SET LEXTT=$$ADD^LEXRXXM(LEXT1,1)
+15 IF LEXN2'>0&($GET(LEXAMSO)="O")&(+($GET(LEXFI))>0)
SET LEXTT=$$ADD^LEXRXXM(LEXT2,1)
+16 IF LEXN1>0&(LEXN2'>0)
SET LEXTT=$$ADD^LEXRXXM(LEXT1,1)
+17 IF LEXN1'>0&(LEXN2>0)
SET LEXTT=$$ADD^LEXRXXM(LEXT2,1)
+18 IF LEXN1>0&(LEXN2>0)
SET LEXTT=$$ADDT^LEXRXXM(LEXT1,LEXT2)
+19 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=" "
+20 IF $GET(LEXFMT)=3
Begin DoDot:1
+21 QUIT
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=" Elapsed Time"
+22 IF +($GET(LEXN1))>0
Begin DoDot:2
+23 NEW LEXT
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
SET LEXT=" Repair Large Files:"
SET LEXT=LEXT_$JUSTIFY(" ",(LEXLEN-$LENGTH(LEXT)))
+24 SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT_$GET(LEXT1)
End DoDot:2
+25 IF +($GET(LEXN2))>0
Begin DoDot:2
+26 NEW LEXT
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
+27 SET LEXT=" Re-Index Small Files:"
SET LEXT=LEXT_$JUSTIFY(" ",(LEXLEN-$LENGTH(LEXT)))
+28 SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT_$GET(LEXT2)
End DoDot:2
+29 IF +LEXN1>0!(LEXN2>0)
Begin DoDot:2
+30 NEW LEXT
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
SET LEXT=" Total All Files:"
SET LEXT=LEXT_$JUSTIFY(" ",(LEXLEN-$LENGTH(LEXT)))
+31 SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT_$GET(LEXTT)
End DoDot:2
End DoDot:1
+32 IF $GET(LEXFMT)=1
Begin DoDot:1
+33 QUIT
NEW LEXE,LEXT
SET LEXT=" Repair Large Files:"
+34 IF $GET(LEXAMSO)="O"&(+($GET(LEXFI))>0)
SET LEXT=" Repair File "_+($GET(LEXFI))_":"
+35 SET LEXT=LEXT_$JUSTIFY(" ",(LEXLEN-$LENGTH(LEXT)))
+36 SET LEXE=$$ADD^LEXRXXM($GET(LEXT1),1)
IF +($GET(LEXN1))>0!(LEXAMSO="O")
Begin DoDot:2
+37 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
+38 SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT_$GET(LEXE)
End DoDot:2
End DoDot:1
+39 IF $GET(LEXFMT)=2
Begin DoDot:1
+40 QUIT
NEW LEXE,LEXT
SET LEXT=" Re-Index Small Files:"
+41 IF $GET(LEXAMSO)="O"&(+($GET(LEXFI))>0)
SET LEXT=" Re-Index File "_+($GET(LEXFI))_":"
+42 IF $GET(LEXTITL)["Kill"
SET LEXT=" Kill/Re-Index All Files:"
+43 SET LEXT=LEXT_$JUSTIFY(" ",(LEXLEN-$LENGTH(LEXT)))
+44 NEW LEXE
SET LEXE=$$ADD^LEXRXXM(LEXT2,1)
IF +LEXN2>0!($GET(LEXAMSO)="O")
Begin DoDot:2
+45 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3," "),-1)+1
+46 SET ^TMP("LEXRX",$JOB,"R",3,LEXC)=LEXT_$GET(LEXE)
End DoDot:2
End DoDot:1
+47 QUIT
RCMD ; Display
+1 NEW LEXC
WRITE !
SET LEXC=0
FOR
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"R",3,LEXC))
IF +LEXC'>0
QUIT
WRITE !,$GET(^TMP("LEXRX",$JOB,"R",3,LEXC))
+2 WRITE !
+3 QUIT
+4 ;
SEND ; Task MAILMAN to Send Message
+1 IF $DATA(LEXQ)
GOTO MAILQ
NEW LEX,LEXC,LEXI,LEXS,LEXT
+2 KILL ^TMP("LEXRX",$JOB,"MSG")
+3 SET LEXC=1
SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXRX",$JOB,"R",3,LEXI))
IF +LEXI'>0
QUIT
Begin DoDot:1
+4 SET LEXT=$EXTRACT($GET(^TMP("LEXRX",$JOB,"R",3,LEXI)),1,79)
+5 IF LEXT[" (large files only)"!(LEXT[" (small files only)")
Begin DoDot:2
+6 SET LEXC=LEXC+1
SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=LEXT
End DoDot:2
QUIT
+7 SET LEXC=LEXC+1
SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=LEXT
End DoDot:1
+8 DO ERR
DO SUM
SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)
+9 IF +LEXC>1
SET ^TMP("LEXRX",$JOB,"MSG",1,0)=" "
SET ^TMP("LEXRX",$JOB,"MSG",(LEXC+1),0)=" "
+10 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)
SET ^TMP("LEXRX",$JOB,"MSG",0)=+LEXC
+11 SET LEXS="Lexicon Index Repair/Re-Index Report"
IF $LENGTH($GET(LEXSUBJ))
SET LEXS=$GET(LEXSUBJ)
+12 DO PRG
DO MAIL
DO HOME^%ZIS
+13 QUIT
MAIL ; MAILMAN
+1 NEW DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+2 IF '$DATA(^TMP("LEXRX",$JOB,"MSG"))
GOTO MAILQ
IF +($GET(^TMP("LEXRX",$JOB,"MSG",0)))=0
GOTO MAILQ
+3 KILL XMZ
NEW DIFROM
SET XMSUB="Lexicon Cross-Reference Repair/Re-Index"
+4 IF $LENGTH($GET(LEXSUBJ))
SET XMSUB=$GET(LEXSUBJ)
+5 KILL XMY
IF +($GET(DUZ))>0
SET XMY(+($GET(DUZ)))=""
+6 IF $DATA(LEXINS)
Begin DoDot:1
+7 KILL XMY
NEW LEXADR
SET LEXADR=$$ADR
IF '$LENGTH(LEXADR)
QUIT
+8 SET LEXADR="G.LEXINS@"_LEXADR
SET XMY(LEXADR)=""
End DoDot:1
+9 IF '$DATA(XMY)
GOTO MAILQ
+10 SET XMTEXT="^TMP(""LEXRX"",$J,""MSG"","
SET XMDUZ=.5
DO ^XMD
+11 IF '$DATA(ZTQUEUED)
IF +($GET(XMZ))>0
IF '$DATA(LEXINS)
Begin DoDot:1
+12 WRITE !!," Lexicon Cross-Reference Repair/Re-Index message (#",+($GET(XMZ)),") sent"
End DoDot:1
MAILQ ; End of MAILMAN
+1 KILL ^TMP("LEXRX",$JOB)
KILL DIFROM,XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+2 QUIT
+3 ;
+4 ; Miscellaneous
SUM ; Timing Summary
+1 IF $ORDER(^TMP("LEXRX",$JOB,"MSG",0))>0
Begin DoDot:1
+2 NEW LEXBEG,LEXEND,LEXELP,LEXC
+3 SET LEXBEG=+($GET(^TMP("LEXRX",$JOB,"P",1)))
IF $PIECE(LEXBEG,".",1)'?7N
QUIT
+4 SET LEXEND=+($GET(^TMP("LEXRX",$JOB,"P",2)))
IF $PIECE(LEXEND,".",1)'?7N
QUIT
+5 IF LEXBEG=LEXEND
QUIT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
IF $LENGTH(LEXELP,"
QUIT
+6 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+7 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)
+8 SET LEXT=$$TM^LEXRXXM($GET(^TMP("LEXRX",$JOB,"MSG",LEXC,0)))
+9 IF $LENGTH(LEXT)
Begin DoDot:2
+10 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)+1
+11 SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=" "
End DoDot:2
+12 SET LEXT="Re-Index Started: "_$$ED^LEXRXXM(LEXBEG)
+13 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)+1
+14 SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=LEXT
+15 SET LEXT="Re-Index Finished: "_$$ED^LEXRXXM(LEXEND)
+16 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)+1
+17 SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=LEXT
+18 SET LEXT="Elapsed Time: "_LEXELP
+19 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)+1
+20 SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=LEXT
End DoDot:1
+21 QUIT
ERR ; Error Summary
+1 IF $ORDER(^TMP("LEXRX",$JOB,"MSG",0))>0
Begin DoDot:1
+2 NEW LEXE,LEXT,LEXC
+3 SET LEXE=+($GET(^TMP("LEXRX",$JOB,"ERR")))
IF LEXE'>0
QUIT
+4 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)
+5 SET LEXT=$$TM^LEXRXXM($GET(^TMP("LEXRX",$JOB,"MSG",LEXC,0)))
+6 IF $LENGTH(LEXT)
Begin DoDot:2
+7 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)+1
+8 SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=" "
End DoDot:2
+9 SET LEXT="Errors Repaired: "
+10 SET LEXT=LEXT_LEXE
+11 SET LEXC=$ORDER(^TMP("LEXRX",$JOB,"MSG"," "),-1)+1
+12 SET ^TMP("LEXRX",$JOB,"MSG",LEXC,0)=LEXT
End DoDot:1
+13 QUIT
ADR(LEX) ; Mailing Address -G.LEXINS@FO-SLC.MED.VA.GOV,
+1 NEW DIC,DTOUT,DUOUT,X,Y
+2 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.MED.VA.GOV"
DO ^DIC
IF +Y>0
QUIT LEX
+3 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.VA.GOV"
DO ^DIC
IF +Y>0
QUIT LEX
+4 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="ISC-SLC.MED.VA.GOV"
DO ^DIC
IF +Y>0
QUIT LEX
+5 QUIT "ISC-SLC.VA.GOV"
FN(X) ; Filename
+1 IF $DATA(^LEX(+($GET(X)),0))
QUIT $$TITLE^XLFSTR($PIECE($GET(^LEX(+($GET(X)),0)),"^",1))
+2 IF $DATA(^LEXT(+($GET(X)),0))
QUIT $$TITLE^XLFSTR($PIECE($GET(^LEXT(+($GET(X)),0)),"^",1))
+3 QUIT ""
PRG ; Purge ^TMP("LEXRX"
+1 NEW LEX
SET LEX=""
FOR
SET LEX=$ORDER(^TMP("LEXRX",$JOB,LEX))
IF '$LENGTH(LEX)
QUIT
IF LEX'="MSG"
KILL ^TMP("LEXRX",$JOB,LEX)
+2 QUIT
ST ; Show ^TMP
+1 NEW LEXNN,LEXNC
SET LEXNN="^TMP(""LEXRX"","_$JOB_")"
SET LEXNC="^TMP(""LEXRX"","_$JOB_","
+2 WRITE !!
FOR
SET LEXNN=$QUERY(@LEXNN)
IF '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
WRITE !,LEXNN,"=",@LEXNN
+3 WRITE !!
+4 QUIT
CLR ; Clear
+1 KILL LEXAMSO,LEXFMT,LEXQ,LEXSUBJ,LEXTITL,LEXINS,ZTQUEUED,LEXNAM
+2 QUIT
