LEXRXC ;ISL/KER - Re-Index 757.01 B/ADC/ADTERM ;04/21/2014
;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEX(757.01) SACC 1.3
; ^TMP("LEXRX") SACC 2.3.2.5.1
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
; FILE^DID ICR 2052
; IX1^DIK ICR 10013
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
; LEXTEST Test variable NEWed/KILLed by Developer
; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
Q
; NOTES:
;
; The Major Concept Map file #757 is used to re-index
; the Expression file #757.01. hence file #757 must be
; repaired/re-indexed before file 757.01.
;
EN ; Main Entry Point
R75701 ; Repair file 757.01
D MC,RB,RADC,RADTERM,R75701^LEXRXC2,R75701^LEXRXC3,SET Q
RB ; Index ^LEX(757.01,"B",TXT,IEN)
; ^LEX(757.01,IEN,4,"B",NEG,IEN2)
; ^LEX(757.01,IEN,5,"B",WORD,IEN2)
W:'$D(ZTQUEUED) ! N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDNT,LEXIDST,LEXIEN,LEXMC,LEXNDS,LEXNDSN,LEXNDSS,LEXNER,LEXOK,LEXS,LEXSER,LEXSTR
S LEXFI="757.01"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""B""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXNDSN,LEXNDSS,LEXERR,LEXSER,LEXNER)=0,LEXSTR="",LEXFI="757.01",LEXIDX="B"
S LEXIDXT="^LEX(757.01,""B"",TXT,IEN)",LEXIDNT="^LEX(757.01,IEN,4,""B"",NEG,IEN2)",LEXIDST="^LEX(757.01,IEN,5,""B"",WORD,IEN2)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
. . N LEXOK,LEXEXP S LEXEXP=$$UP^XLFSTR($G(^LEX(LEXFI,LEXIEN,0)))
. . S LEXOK=0 S:$E(LEXEXP,1,63)=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1
. . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXEXP) ^LEX(LEXFI,LEXIDX,$E(LEXEXP,1,63),LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN
. . I $D(^LEX(LEXFI,LEXIEN,4)) D
. . . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. . . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)) Q:+LEXS'>0 D
. . . . . S LEXNDSN=LEXNDSN+1 N LEXOK,LEXMC S LEXMC=$G(^LEX(LEXFI,LEXIEN,4,LEXS,0))
. . . . . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
. . . . . . S LEXNER=LEXNER+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
. . . . . . S:$L(LEXMC) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXMC,LEXS)=""
. . . . . . I '$D(ZTQUEUED) W !,?10,757.17,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN,"/",LEXS
. . . S LEXSTR=0 F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,4,LEXSTR)) Q:+LEXSTR'>0 D
. . . . N DA,X S X=$P($G(^LEX(LEXFI,LEXIEN,4,LEXSTR,0)),"^",1),DA(1)=LEXIEN,DA=LEXSTR
. . . . I $L(X) I '$D(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)) D Q
. . . . . S LEXNER=LEXNER+1,^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
. . . . . I '$D(ZTQUEUED) W !,?10,757.17,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
. . I $D(^LEX(LEXFI,LEXIEN,5)) D
. . . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. . . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR,LEXS)) Q:+LEXS'>0 D
. . . . . S LEXNDSS=LEXNDSS+1 N LEXOK,LEXMC S LEXMC=$G(^LEX(LEXFI,LEXIEN,5,LEXS,0))
. . . . . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
. . . . . . S LEXSER=LEXSER+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR,LEXS) S:$L(LEXMC) ^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXMC,LEXS)=""
. . . . . . I '$D(ZTQUEUED) W !,?10,757.18,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN,"/",LEXS
. . . S LEXSTR=0 F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,5,LEXSTR)) Q:+LEXSTR'>0 D
. . . . N DA,X S X=$P($G(^LEX(LEXFI,LEXIEN,5,LEXSTR,0)),"^",1),DA(1)=LEXIEN,DA=LEXSTR
. . . . I $L(X) I '$D(^LEX(LEXFI,DA(1),5,LEXIDX,X,DA)) D Q
. . . . . S LEXSER=LEXSER+1,^LEX(LEXFI,DA(1),5,LEXIDX,X,DA)=""
. . . . . I '$D(ZTQUEUED) W !,?10,757.18,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,X S DA=LEXIEN,X=$$UP^XLFSTR($G(^LEX(LEXFI,LEXIEN,0))) Q:'$L(X)
. I '$D(^LEX(LEXFI,"B",$E(X,1,63),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
. S:$L(X) ^LEX(LEXFI,"B",$E(X,1,63),DA)=""
. N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXS)) Q:+LEXS'>0 D
. . N DA,DIK,X S DA(1)=LEXIEN,DA=LEXS,X=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),"^",1) Q:'$L(X)
. . I '$D(^LEX(LEXFI,DA(1),4,"B",X,DA)) D
. . . S LEXNER=LEXNER+1 I '$D(ZTQUEUED) W !,?10,757.17,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
. . S:$L(X) ^LEX(LEXFI,DA(1),4,"B",X,DA)=""
. S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,5,LEXS)) Q:+LEXS'>0 D
. . N DA,DIK,X S DA(1)=LEXIEN,DA=LEXS,X=$P($G(^LEX(LEXFI,DA(1),5,DA,0)),"^",1) Q:'$L(X)
. . I '$D(^LEX(LEXFI,DA(1),5,"B",X,DA)) D
. . . S LEXSER=LEXSER+1 I '$D(ZTQUEUED) W !,?10,757.18,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
. . S:$L(X) ^LEX(LEXFI,DA(1),5,"B",X,DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
S LEXNER=$S(+LEXNER>0:LEXNER,1:"") I '$D(ZTQUEUED) W !,$J(LEXNER,5),?10,757.17,?19,LEXIDX,?30,LEXIDNT
S LEXSER=$S(+LEXSER>0:LEXSER,1:"") I '$D(ZTQUEUED) W !,$J(LEXSER,5),?10,757.18,?19,LEXIDX,?30,LEXIDST
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
D REP^LEXRXXS(LEXFI,757.17,LEXIDX,LEXNDSN,LEXNER,LEXIDNT)
D REP^LEXRXXS(LEXFI,757.18,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
Q
RADC ; Index ^LEX(757.01,"ADC",1,IEN)
W:'$D(ZTQUEUED) ! N DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSTR
S LEXFI="757.01"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""ADC""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="ADC",LEXIDXT="^LEX(757.01,""ADC"",1,IEN)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
. . N LEXOK,LEXDF S LEXDF=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",5))
. . S LEXOK=0 S:LEXDF=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXDF) ^LEX(LEXFI,LEXIDX,LEXDF,LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,+DA,1)),"^",5)
. I +X'>0,$D(^LEX(LEXFI,"ADC",+X,+DA)) D Q
. . S LEXERR=LEXERR+1
. . K:'$D(LEXTEST) ^LEX(LEXFI,"ADC",+X,+DA),^LEX(LEXFI,"ADC",1,+DA)
. . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (0)",?58," ",DA
. I +X>0,'$D(^LEX(LEXFI,"ADC",+X,+DA)) D Q
. . Q:+X'=1 S LEXERR=LEXERR+1
. . S:'$D(LEXTEST) ^LEX(LEXFI,"ADC",+X,+DA)=""
. . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
. S:+X>0 ^LEX(LEXFI,"ADC",+X,+DA)=""
. I +X>0,+X'=1 D Q
. . S LEXERR=LEXERR+1
. . K:'$D(LEXTEST) ^LEX(LEXFI,"ADC",+X,+DA)
. . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (>1)",?58," ",DA
. K:'$D(LEXTEST)&(+X'=1) ^LEX(LEXFI,"ADC",+X,+DA),^LEX(LEXFI,"ADC",1,+DA)
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
Q
RADTERM ; Index ^LEX(757.01,"ADTERM",DT,IEN)
N DA,DIK,LEXBEG,LEXDE,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSTR
S LEXFI="757.01"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""ADTERM""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="ADTERM",LEXIDXT="^LEX(757.01,""ADTERM"",EXP,IEN)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
. . N LEXOK,LEXDF,LEXDE S LEXDF=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",5))
. . S LEXDE=$E($P($G(^LEX(LEXFI,LEXIEN,0)),U,1),1,63)
. . S LEXOK=0 S:LEXDE=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1
. . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:+LEXDF>0&($L(LEXDE)) ^LEX(LEXFI,LEXIDX,LEXDE,LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,20),$S($L(LEXSTR)>20:"...",1:""),?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXDF,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
. S LEXDF=+($P($G(^LEX(LEXFI,DA,1)),"^",5))
. I +LEXDF>0,'$D(^LEX(LEXFI,LEXIDX,$E(X,1,63),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
. I +LEXDF'>0,$D(^LEX(LEXFI,LEXIDX,$E(X,1,63),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted)",?58," ",DA
. S:$L(X)&(+LEXDF>0) ^LEX(LEXFI,LEXIDX,$E(X,1,63),DA)=""
. K:$L(X)&(+LEXDF'>0) ^LEX(LEXFI,LEXIDX,$E(X,1,63),DA)
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
Q
;
; Miscellaneous
SET ; Re-Index Expression file 757.01 (Set logic only)
Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
N LEXOUT,LEXMSG S LEXFI=757.01
D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI))
Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
D DL,MC
N LEXIEN,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. S LEXP3=LEXIEN,LEXP4=LEXP4+1
. N DA,DIK S DA=LEXIEN,DIK=LEXRT D IX1^DIK
D RL,SL S $P(^LEX(LEXFI,0),"^",3)=LEXP3,$P(^LEX(LEXFI,0),"^",4)=LEXP4
Q:$D(LEXQ) S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
D REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
Q
DL ; De-Link AWRD
N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(757.05,LEXIEN)) Q:+LEXIEN'>0 D
. N LEXNC,LEXND,LEXNN,LEXWRD S LEXND=$G(^LEX(757.05,+LEXIEN,0)) Q:$P(LEXND,"^",3)'="L" S LEXWRD=$P(LEXND,"^",1)
. S LEXNN="^LEX(757.01,""AWRD"","""_LEXWRD_""")",LEXNC="^LEX(757.01,""AWRD"","""_LEXWRD_""","
. F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) K:LEXNN[",""LINKED"")" @LEXNN
Q
MC ; Major Concept Map File
N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(757,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK S DA=LEXIEN,DIK="^LEX(757," D IX1^DIK
Q
RL ; Re-Link 757.05
N LEXIEN S LEXIEN=" " F S LEXIEN=$O(^LEX(757.05,LEXIEN)) Q:'$L(LEXIEN) K:LEXIEN?1U.U ^LEX(757.05,LEXIEN)
S LEXIEN=0 F S LEXIEN=$O(^LEX(757.05,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK S DA=LEXIEN K ^LEX(757.05,DA,1,"B") S DA=LEXIEN,DIK="^LEX(757.05," D IX1^DIK
Q
SL ; String Length ASL
N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(757.01,"ASL",LEXSTR)) Q:'$L(LEXSTR) D
. N LEXSCT,LEXPSCT S LEXSCT=$$SCT^LEXRXC3(LEXSTR)
. S LEXPSCT=$O(^LEX(757.01,"ASL",LEXSTR,0))
. I +LEXPSCT>0,+LEXSCT'>0 K ^LEX(757.01,"ASL",LEXSTR,+LEXPSCT)
. I +LEXPSCT>0,+LEXSCT>0,+LEXPSCT'=LEXSCT D
. . K ^LEX(757.01,"ASL",LEXSTR,+LEXPSCT) S ^LEX(757.01,"ASL",LEXSTR,+LEXSCT)=""
Q
CLR ; Clear
K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
Q
LEXRXC ;ISL/KER - Re-Index 757.01 B/ADC/ADTERM ;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 ; ^LEX(757.01) SACC 1.3
+6 ; ^TMP("LEXRX") SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; $$FMDIFF^XLFDT ICR 10103
+10 ; $$NOW^XLFDT ICR 10103
+11 ; $$UP^XLFSTR ICR 10104
+12 ; FILE^DID ICR 2052
+13 ; IX1^DIK ICR 10013
+14 ;
+15 ; Local Variables NEWed or KILLed Elsewhere
+16 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+17 ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
+18 ; LEXTEST Test variable NEWed/KILLed by Developer
+19 ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
+20 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+21 ;
+22 QUIT
+23 ; NOTES:
+24 ;
+25 ; The Major Concept Map file #757 is used to re-index
+26 ; the Expression file #757.01. hence file #757 must be
+27 ; repaired/re-indexed before file 757.01.
+28 ;
EN ; Main Entry Point
R75701 ; Repair file 757.01
+1 DO MC
DO RB
DO RADC
DO RADTERM
DO R75701^LEXRXC2
DO R75701^LEXRXC3
DO SET
QUIT
RB ; Index ^LEX(757.01,"B",TXT,IEN)
+1 ; ^LEX(757.01,IEN,4,"B",NEG,IEN2)
+2 ; ^LEX(757.01,IEN,5,"B",WORD,IEN2)
+3 IF '$DATA(ZTQUEUED)
WRITE !
NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDNT,LEXIDST,LEXIEN,LEXMC,LEXNDS,LEXNDSN,LEXNDSS,LEXNER,LEXOK,LEXS,LEXSER,LEXSTR
+4 SET LEXFI="757.01"
+5 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""B""")
IF LEXTC=1
QUIT
+6 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXNDSN,LEXNDSS,LEXERR,LEXSER,LEXNER)=0
SET LEXSTR=""
SET LEXFI="757.01"
SET LEXIDX="B"
+7 SET LEXIDXT="^LEX(757.01,""B"",TXT,IEN)"
SET LEXIDNT="^LEX(757.01,IEN,4,""B"",NEG,IEN2)"
SET LEXIDST="^LEX(757.01,IEN,5,""B"",WORD,IEN2)"
+8 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+9 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:2
+10 SET LEXNDS=LEXNDS+1
IF '$DATA(^LEX(LEXFI,LEXIEN,0))
Begin DoDot:3
+11 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
+12 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
QUIT
+13 NEW LEXOK,LEXEXP
SET LEXEXP=$$UP^XLFSTR($GET(^LEX(LEXFI,LEXIEN,0)))
+14 SET LEXOK=0
IF $EXTRACT(LEXEXP,1,63)=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+15 SET LEXERR=LEXERR+1
+16 IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
IF $LENGTH(LEXEXP)
SET ^LEX(LEXFI,LEXIDX,$EXTRACT(LEXEXP,1,63),LEXIEN)=""
+17 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,$EXTRACT(LEXSTR,1,26),?58," ",LEXIEN
End DoDot:3
+18 IF $DATA(^LEX(LEXFI,LEXIEN,4))
Begin DoDot:3
+19 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:4
+20 NEW LEXS
SET LEXS=0
FOR
SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS))
IF +LEXS'>0
QUIT
Begin DoDot:5
+21 SET LEXNDSN=LEXNDSN+1
NEW LEXOK,LEXMC
SET LEXMC=$GET(^LEX(LEXFI,LEXIEN,4,LEXS,0))
+22 SET LEXOK=0
IF LEXMC=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:6
+23 SET LEXNER=LEXNER+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
+24 IF $LENGTH(LEXMC)
SET ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXMC,LEXS)=""
+25 IF '$DATA(ZTQUEUED)
WRITE !,?10,757.17,?19,LEXIDX,?30,$EXTRACT(LEXSTR,1,26),?58," ",LEXIEN,"/",LEXS
End DoDot:6
End DoDot:5
End DoDot:4
+26 SET LEXSTR=0
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXSTR))
IF +LEXSTR'>0
QUIT
Begin DoDot:4
+27 NEW DA,X
SET X=$PIECE($GET(^LEX(LEXFI,LEXIEN,4,LEXSTR,0)),"^",1)
SET DA(1)=LEXIEN
SET DA=LEXSTR
+28 IF $LENGTH(X)
IF '$DATA(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA))
Begin DoDot:5
+29 SET LEXNER=LEXNER+1
SET ^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
+30 IF '$DATA(ZTQUEUED)
WRITE !,?10,757.17,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
End DoDot:5
QUIT
End DoDot:4
End DoDot:3
+31 IF $DATA(^LEX(LEXFI,LEXIEN,5))
Begin DoDot:3
+32 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:4
+33 NEW LEXS
SET LEXS=0
FOR
SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR,LEXS))
IF +LEXS'>0
QUIT
Begin DoDot:5
+34 SET LEXNDSS=LEXNDSS+1
NEW LEXOK,LEXMC
SET LEXMC=$GET(^LEX(LEXFI,LEXIEN,5,LEXS,0))
+35 SET LEXOK=0
IF LEXMC=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:6
+36 SET LEXSER=LEXSER+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR,LEXS)
IF $LENGTH(LEXMC)
SET ^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXMC,LEXS)=""
+37 IF '$DATA(ZTQUEUED)
WRITE !,?10,757.18,?19,LEXIDX,?30,$EXTRACT(LEXSTR,1,26),?58," ",LEXIEN,"/",LEXS
End DoDot:6
End DoDot:5
End DoDot:4
+38 SET LEXSTR=0
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIEN,5,LEXSTR))
IF +LEXSTR'>0
QUIT
Begin DoDot:4
+39 NEW DA,X
SET X=$PIECE($GET(^LEX(LEXFI,LEXIEN,5,LEXSTR,0)),"^",1)
SET DA(1)=LEXIEN
SET DA=LEXSTR
+40 IF $LENGTH(X)
IF '$DATA(^LEX(LEXFI,DA(1),5,LEXIDX,X,DA))
Begin DoDot:5
+41 SET LEXSER=LEXSER+1
SET ^LEX(LEXFI,DA(1),5,LEXIDX,X,DA)=""
+42 IF '$DATA(ZTQUEUED)
WRITE !,?10,757.18,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
End DoDot:5
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+44 NEW DA,DIK,X
SET DA=LEXIEN
SET X=$$UP^XLFSTR($GET(^LEX(LEXFI,LEXIEN,0)))
IF '$LENGTH(X)
QUIT
+45 IF '$DATA(^LEX(LEXFI,"B",$EXTRACT(X,1,63),DA))
Begin DoDot:2
+46 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
End DoDot:2
+47 IF $LENGTH(X)
SET ^LEX(LEXFI,"B",$EXTRACT(X,1,63),DA)=""
+48 NEW LEXS
SET LEXS=0
FOR
SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,4,LEXS))
IF +LEXS'>0
QUIT
Begin DoDot:2
+49 NEW DA,DIK,X
SET DA(1)=LEXIEN
SET DA=LEXS
SET X=$PIECE($GET(^LEX(LEXFI,DA(1),4,DA,0)),"^",1)
IF '$LENGTH(X)
QUIT
+50 IF '$DATA(^LEX(LEXFI,DA(1),4,"B",X,DA))
Begin DoDot:3
+51 SET LEXNER=LEXNER+1
IF '$DATA(ZTQUEUED)
WRITE !,?10,757.17,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
End DoDot:3
+52 IF $LENGTH(X)
SET ^LEX(LEXFI,DA(1),4,"B",X,DA)=""
End DoDot:2
+53 SET LEXS=0
FOR
SET LEXS=$ORDER(^LEX(LEXFI,LEXIEN,5,LEXS))
IF +LEXS'>0
QUIT
Begin DoDot:2
+54 NEW DA,DIK,X
SET DA(1)=LEXIEN
SET DA=LEXS
SET X=$PIECE($GET(^LEX(LEXFI,DA(1),5,DA,0)),"^",1)
IF '$LENGTH(X)
QUIT
+55 IF '$DATA(^LEX(LEXFI,DA(1),5,"B",X,DA))
Begin DoDot:3
+56 SET LEXSER=LEXSER+1
IF '$DATA(ZTQUEUED)
WRITE !,?10,757.18,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
End DoDot:3
+57 IF $LENGTH(X)
SET ^LEX(LEXFI,DA(1),5,"B",X,DA)=""
End DoDot:2
End DoDot:1
+58 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+59 SET LEXNER=$SELECT(+LEXNER>0:LEXNER,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXNER,5),?10,757.17,?19,LEXIDX,?30,LEXIDNT
+60 SET LEXSER=$SELECT(+LEXSER>0:LEXSER,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXSER,5),?10,757.18,?19,LEXIDX,?30,LEXIDST
+61 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+62 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+63 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+64 DO REP^LEXRXXS(LEXFI,757.17,LEXIDX,LEXNDSN,LEXNER,LEXIDNT)
+65 DO REP^LEXRXXS(LEXFI,757.18,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
+66 QUIT
RADC ; Index ^LEX(757.01,"ADC",1,IEN)
+1 IF '$DATA(ZTQUEUED)
WRITE !
NEW DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSTR
+2 SET LEXFI="757.01"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""ADC""")
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.01
SET LEXIDX="ADC"
SET LEXIDXT="^LEX(757.01,""ADC"",1,IEN)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:2
+7 SET LEXNDS=LEXNDS+1
IF '$DATA(^LEX(LEXFI,LEXIEN,0))
Begin DoDot:3
+8 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
+9 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
QUIT
+10 NEW LEXOK,LEXDF
SET LEXDF=+($PIECE($GET(^LEX(LEXFI,LEXIEN,1)),"^",5))
+11 SET LEXOK=0
IF LEXDF=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+12 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
IF $LENGTH(LEXDF)
SET ^LEX(LEXFI,LEXIDX,LEXDF,LEXIEN)=""
+13 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+15 NEW DA,DIK,X
SET DA=LEXIEN
SET X=$PIECE($GET(^LEX(LEXFI,+DA,1)),"^",5)
+16 IF +X'>0
IF $DATA(^LEX(LEXFI,"ADC",+X,+DA))
Begin DoDot:2
+17 SET LEXERR=LEXERR+1
+18 IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,"ADC",+X,+DA),^LEX(LEXFI,"ADC",1,+DA)
+19 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (0)",?58," ",DA
End DoDot:2
QUIT
+20 IF +X>0
IF '$DATA(^LEX(LEXFI,"ADC",+X,+DA))
Begin DoDot:2
+21 IF +X'=1
QUIT
SET LEXERR=LEXERR+1
+22 IF '$DATA(LEXTEST)
SET ^LEX(LEXFI,"ADC",+X,+DA)=""
+23 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
End DoDot:2
QUIT
+24 IF +X>0
SET ^LEX(LEXFI,"ADC",+X,+DA)=""
+25 IF +X>0
IF +X'=1
Begin DoDot:2
+26 SET LEXERR=LEXERR+1
+27 IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,"ADC",+X,+DA)
+28 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (>1)",?58," ",DA
End DoDot:2
QUIT
+29 IF '$DATA(LEXTEST)&(+X'=1)
KILL ^LEX(LEXFI,"ADC",+X,+DA),^LEX(LEXFI,"ADC",1,+DA)
End DoDot:1
+30 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+31 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+32 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+33 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+34 QUIT
RADTERM ; Index ^LEX(757.01,"ADTERM",DT,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDE,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSTR
+2 SET LEXFI="757.01"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""ADTERM""")
IF LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.01
SET LEXIDX="ADTERM"
SET LEXIDXT="^LEX(757.01,""ADTERM"",EXP,IEN)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:2
+7 SET LEXNDS=LEXNDS+1
IF '$DATA(^LEX(LEXFI,LEXIEN,0))
Begin DoDot:3
+8 SET LEXERR=LEXERR+1
IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
+9 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
QUIT
+10 NEW LEXOK,LEXDF,LEXDE
SET LEXDF=+($PIECE($GET(^LEX(LEXFI,LEXIEN,1)),"^",5))
+11 SET LEXDE=$EXTRACT($PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,1),1,63)
+12 SET LEXOK=0
IF LEXDE=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+13 SET LEXERR=LEXERR+1
+14 IF '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
IF +LEXDF>0&($LENGTH(LEXDE))
SET ^LEX(LEXFI,LEXIDX,LEXDE,LEXIEN)=""
+15 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,$EXTRACT(LEXSTR,1,20),$SELECT($LENGTH(LEXSTR)>20:"...",1:""),?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+17 NEW DA,DIK,LEXDF,X
SET DA=LEXIEN
SET X=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",1)
IF '$LENGTH(X)
QUIT
+18 SET LEXDF=+($PIECE($GET(^LEX(LEXFI,DA,1)),"^",5))
+19 IF +LEXDF>0
IF '$DATA(^LEX(LEXFI,LEXIDX,$EXTRACT(X,1,63),DA))
Begin DoDot:2
+20 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
End DoDot:2
+21 IF +LEXDF'>0
IF $DATA(^LEX(LEXFI,LEXIDX,$EXTRACT(X,1,63),DA))
Begin DoDot:2
+22 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted)",?58," ",DA
End DoDot:2
+23 IF $LENGTH(X)&(+LEXDF>0)
SET ^LEX(LEXFI,LEXIDX,$EXTRACT(X,1,63),DA)=""
+24 IF $LENGTH(X)&(+LEXDF'>0)
KILL ^LEX(LEXFI,LEXIDX,$EXTRACT(X,1,63),DA)
End DoDot:1
+25 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+26 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+27 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+28 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+29 QUIT
+30 ;
+31 ; Miscellaneous
SET ; Re-Index Expression file 757.01 (Set logic only)
+1 IF '$DATA(LEXSET)
QUIT
NEW LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
+2 NEW LEXOUT,LEXMSG
SET LEXFI=757.01
+3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
+4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
IF LEXRT'["^LEX"
QUIT
+5 SET LEXPRE=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
+6 SET LEXBEG=$$NOW^XLFDT
SET LEXNM=$$FN^LEXRXXM(LEXFI)
+7 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
+8 IF LEXTC=1
QUIT
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing",!
+9 DO DL
DO MC
+10 NEW LEXIEN,LEXP3,LEXP4
SET (LEXP3,LEXP4,LEXIEN)=0
+11 FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+12 SET LEXP3=LEXIEN
SET LEXP4=LEXP4+1
+13 NEW DA,DIK
SET DA=LEXIEN
SET DIK=LEXRT
DO IX1^DIK
End DoDot:1
+14 DO RL
DO SL
SET $PIECE(^LEX(LEXFI,0),"^",3)=LEXP3
SET $PIECE(^LEX(LEXFI,0),"^",4)=LEXP4
+15 IF $DATA(LEXQ)
QUIT
SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+16 IF $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+17 DO REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
+18 SET LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
+19 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=LEXELP
+20 QUIT
DL ; De-Link AWRD
+1 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(757.05,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+2 NEW LEXNC,LEXND,LEXNN,LEXWRD
SET LEXND=$GET(^LEX(757.05,+LEXIEN,0))
IF $PIECE(LEXND,"^",3)'="L"
QUIT
SET LEXWRD=$PIECE(LEXND,"^",1)
+3 SET LEXNN="^LEX(757.01,""AWRD"","""_LEXWRD_""")"
SET LEXNC="^LEX(757.01,""AWRD"","""_LEXWRD_""","
+4 FOR
SET LEXNN=$QUERY(@LEXNN)
IF '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
QUIT
IF LEXNN[",""LINKED"")"
KILL @LEXNN
End DoDot:1
+5 QUIT
MC ; Major Concept Map File
+1 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(757,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+2 NEW DA,DIK
SET DA=LEXIEN
SET DIK="^LEX(757,"
DO IX1^DIK
End DoDot:1
+3 QUIT
RL ; Re-Link 757.05
+1 NEW LEXIEN
SET LEXIEN=" "
FOR
SET LEXIEN=$ORDER(^LEX(757.05,LEXIEN))
IF '$LENGTH(LEXIEN)
QUIT
IF LEXIEN?1U.U
KILL ^LEX(757.05,LEXIEN)
+2 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(757.05,LEXIEN))
IF +LEXIEN'>0
QUIT
Begin DoDot:1
+3 NEW DA,DIK
SET DA=LEXIEN
KILL ^LEX(757.05,DA,1,"B")
SET DA=LEXIEN
SET DIK="^LEX(757.05,"
DO IX1^DIK
End DoDot:1
+4 QUIT
SL ; String Length ASL
+1 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(757.01,"ASL",LEXSTR))
IF '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+2 NEW LEXSCT,LEXPSCT
SET LEXSCT=$$SCT^LEXRXC3(LEXSTR)
+3 SET LEXPSCT=$ORDER(^LEX(757.01,"ASL",LEXSTR,0))
+4 IF +LEXPSCT>0
IF +LEXSCT'>0
KILL ^LEX(757.01,"ASL",LEXSTR,+LEXPSCT)
+5 IF +LEXPSCT>0
IF +LEXSCT>0
IF +LEXPSCT'=LEXSCT
Begin DoDot:2
+6 KILL ^LEX(757.01,"ASL",LEXSTR,+LEXPSCT)
SET ^LEX(757.01,"ASL",LEXSTR,+LEXSCT)=""
End DoDot:2
End DoDot:1
+7 QUIT
CLR ; Clear
+1 KILL LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
+2 QUIT
