- LEXRXXS ;ISL/KER - Re-Index Save/Send ;05/23/2017
- ;;2.0;LEXICON UTILITY;**81,80,103**;Sep 23, 1996;Build 2
- ;
- ; Global Variables
- ; ^LEX( SACC 1.3
- ; ^LEXT( SACC 1.3
- ; ^TMP("LEXRX",$J) SACC 2.3.2.5.1
- ;
- ; External References
- ; $$FMDIFF^XLFDT ICR 10103
- ; 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
- I $G(LEXIDX)'["*" 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.DOMAIN.EXT,
- 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)="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"
- FN(X) ; Filename
- Q:$D(^LEX(+($G(X)),0)) $$TITLE($P($G(^LEX(+($G(X)),0)),"^",1))
- Q:$D(^LEXT(+($G(X)),0)) $$TITLE($P($G(^LEXT(+($G(X)),0)),"^",1))
- Q ""
- TITLE(X) ; Mix Case
- N LEXI,LEXCHR,LEXSTR,LEXSPC S LEXSTR=$$LOW^XLFSTR(X),LEXSPC=1 F LEXI=1:1:$L(LEXSTR) D
- . S LEXCHR=$E(LEXSTR,LEXI) I LEXSPC,LEXCHR?1L S $E(LEXSTR,LEXI)=$$UP^XLFSTR(LEXCHR),LEXSPC=0
- . S:LEXCHR=" " LEXSPC=1 S:LEXCHR="/" LEXSPC=1 S:LEXCHR="-" LEXSPC=1
- S X=LEXSTR
- Q X
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXXS 13513 printed Jan 18, 2025@03:10:26 Page 2
- LEXRXXS ;ISL/KER - Re-Index Save/Send ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**81,80,103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX( SACC 1.3
- +5 ; ^LEXT( SACC 1.3
- +6 ; ^TMP("LEXRX",$J) SACC 2.3.2.5.1
- +7 ;
- +8 ; External References
- +9 ; $$FMDIFF^XLFDT ICR 10103
- +10 ; HOME^%ZIS ICR 10086
- +11 ; ^DIC ICR 10006
- +12 ; ^XMD ICR 10070
- +13 ;
- +14 ; Local Variables NEWed or KILLed Elsewhere
- +15 ; LEXAMSO User Selection NEWed/KILLed by LEXRX
- +16 ; LEXSUBJ Msg Subject NEWed/KILLed by LEXRXXT
- +17 ; LEXTITL Msg Title NEWed/KILLed by LEXRXXT
- +18 ; LEXFMT Display format NEWed/KILLed by LEXRXXT2
- +19 ; LEXQ Quiet flag NEWed/KILLed by LEXRXXT2
- +20 ; LEXNAM Task Name NEWed/KILLed by LEXRXXT2
- +21 ; LEXINS Install Flag NEWed/KILLed by Post-Install
- +22 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- +23 ;
- +24 QUIT
- +25 ; 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(LEXIDX)'["*"
- 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.DOMAIN.EXT,
- +1 NEW DIC,DTOUT,DUOUT,X,Y
- +2 SET DIC="^DIC(4.2,"
- SET DIC(0)="M"
- SET (LEX,X)="FO-SLC.DOMAIN.EXT"
- DO ^DIC
- if +Y>0
- QUIT LEX
- +3 SET DIC="^DIC(4.2,"
- SET DIC(0)="M"
- SET (LEX,X)="FO-SLC.DOMAIN.EXT"
- DO ^DIC
- if +Y>0
- QUIT LEX
- +4 SET DIC="^DIC(4.2,"
- SET DIC(0)="M"
- SET (LEX,X)="ISC-SLC.DOMAIN.EXT"
- DO ^DIC
- if +Y>0
- QUIT LEX
- +5 QUIT "ISC-SLC.DOMAIN.EXT"
- FN(X) ; Filename
- +1 if $DATA(^LEX(+($GET(X)),0))
- QUIT $$TITLE($PIECE($GET(^LEX(+($GET(X)),0)),"^",1))
- +2 if $DATA(^LEXT(+($GET(X)),0))
- QUIT $$TITLE($PIECE($GET(^LEXT(+($GET(X)),0)),"^",1))
- +3 QUIT ""
- TITLE(X) ; Mix Case
- +1 NEW LEXI,LEXCHR,LEXSTR,LEXSPC
- SET LEXSTR=$$LOW^XLFSTR(X)
- SET LEXSPC=1
- FOR LEXI=1:1:$LENGTH(LEXSTR)
- Begin DoDot:1
- +2 SET LEXCHR=$EXTRACT(LEXSTR,LEXI)
- IF LEXSPC
- IF LEXCHR?1L
- SET $EXTRACT(LEXSTR,LEXI)=$$UP^XLFSTR(LEXCHR)
- SET LEXSPC=0
- +3 if LEXCHR=" "
- SET LEXSPC=1
- if LEXCHR="/"
- SET LEXSPC=1
- if LEXCHR="-"
- SET LEXSPC=1
- End DoDot:1
- +4 SET X=LEXSTR
- +5 QUIT X
- 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