- 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
