Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXRXC

LEXRXC.m

Go to the documentation of this file.
  1. LEXRXC ;ISL/KER - Re-Index 757.01 B/ADC/ADTERM ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**81,80,86,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX( SACC 1.3
  1. ; ^LEX(757.01) SACC 1.3
  1. ; ^TMP("LEXRX") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$FMDIFF^XLFDT ICR 10103
  1. ; $$NOW^XLFDT ICR 10103
  1. ; $$UP^XLFSTR ICR 10104
  1. ; FILE^DID ICR 2052
  1. ; IXALL^DIK ICR 10013
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; LEXNAM Task name NEWed/KILLed by LEXRXXT
  1. ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
  1. ; LEXTEST Test variable NEWed/KILLed by Developer
  1. ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
  1. ; ZTQUEUED Task flag NEWed/KILLed by Taskman
  1. ;
  1. Q
  1. ; NOTES:
  1. ;
  1. ; The Major Concept Map file #757 is used to re-index
  1. ; the Expression file #757.01. hence file #757 must be
  1. ; repaired/re-indexed before file 757.01.
  1. ;
  1. EN ; Main Entry Point
  1. R75701 ; Repair file 757.01
  1. D MC,RB,RADC,RADTERM,RAH,R75701^LEXRXC2,R75701^LEXRXC3
  1. D:+($G(^TMP("LEXRX",$J,"ERR",757.01)))>0 SET
  1. Q
  1. RB ; Index ^LEX(757.01,"B",TXT,IEN)
  1. ; ^LEX(757.01,IEN,4,"B",NEG,IEN2)
  1. ; ^LEX(757.01,IEN,5,"B",WORD,IEN2)
  1. S:$D(ZTQUEUED) ZTREQ="@" W:'$D(ZTQUEUED) ! N DA,DIK,LEXBEG,LEXDIF,LEXDF,LEXELP,LEXEND,LEXERR,LEXEXP,LEXFI,LEXIDX,LEXIDXT,LEXIDNT,LEXIDST
  1. N LEXIEN,LEXMC,LEXNDS,LEXNDSN,LEXNDSS,LEXNER,LEXOK,LEXS,LEXSER,LEXSTR S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""B""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXNDSN,LEXNDSS,LEXERR,LEXSER,LEXNER)=0,LEXSTR="",LEXFI="757.01",LEXIDX="B"
  1. 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)"
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. . . N LEXOK,LEXEXP,LEXDF S LEXEXP=$$UP^XLFSTR($G(^LEX(LEXFI,LEXIEN,0)))
  1. . . S LEXDF=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",5))
  1. . . I $E(LEXEXP,1,63)'=LEXSTR,+LEXDF'>0 D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1. . . . Q:'$L(LEXEXP) S:LEXDF'>0 ^LEX(LEXFI,LEXIDX,$E(LEXEXP,1,63),LEXIEN)=""
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN
  1. . . I +LEXDF>0 D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN," (-)"
  1. . . I $D(^LEX(LEXFI,LEXIEN,4)) D
  1. . . . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . . . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)) Q:+LEXS'>0 D
  1. . . . . . S LEXNDSN=LEXNDSN+1 N LEXOK,LEXMC S LEXMC=$G(^LEX(LEXFI,LEXIEN,4,LEXS,0))
  1. . . . . . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . . . . S LEXNER=LEXNER+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXSTR,LEXS)
  1. . . . . . . S:$L(LEXMC) ^LEX(LEXFI,LEXIEN,4,LEXIDX,LEXMC,LEXS)=""
  1. . . . . . . I '$D(ZTQUEUED) W !,?10,757.17,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN,"/",LEXS
  1. . . . S LEXSTR=0 F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,4,LEXSTR)) Q:+LEXSTR'>0 D
  1. . . . . N DA,X S X=$P($G(^LEX(LEXFI,LEXIEN,4,LEXSTR,0)),"^",1),DA(1)=LEXIEN,DA=LEXSTR
  1. . . . . I $L(X) I '$D(^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)) D Q
  1. . . . . . S LEXNER=LEXNER+1,^LEX(LEXFI,DA(1),4,LEXIDX,X,DA)=""
  1. . . . . . I '$D(ZTQUEUED) W !,?10,757.17,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
  1. . . I $D(^LEX(LEXFI,LEXIEN,5)) D
  1. . . . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . . . . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR,LEXS)) Q:+LEXS'>0 D
  1. . . . . . S LEXNDSS=LEXNDSS+1 N LEXOK,LEXMC S LEXMC=$G(^LEX(LEXFI,LEXIEN,5,LEXS,0))
  1. . . . . . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . . . . S LEXSER=LEXSER+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXSTR,LEXS) S:$L(LEXMC) ^LEX(LEXFI,LEXIEN,5,LEXIDX,LEXMC,LEXS)=""
  1. . . . . . . I '$D(ZTQUEUED) W !,?10,757.18,?19,LEXIDX,?30,$E(LEXSTR,1,26),?58," ",LEXIEN,"/",LEXS
  1. . . . S LEXSTR=0 F S LEXSTR=$O(^LEX(LEXFI,LEXIEN,5,LEXSTR)) Q:+LEXSTR'>0 D
  1. . . . . N DA,X S X=$P($G(^LEX(LEXFI,LEXIEN,5,LEXSTR,0)),"^",1),DA(1)=LEXIEN,DA=LEXSTR
  1. . . . . I $L(X) I '$D(^LEX(LEXFI,DA(1),5,LEXIDX,X,DA)) D Q
  1. . . . . . S LEXSER=LEXSER+1,^LEX(LEXFI,DA(1),5,LEXIDX,X,DA)=""
  1. . . . . . I '$D(ZTQUEUED) W !,?10,757.18,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,X,LEXDF S DA=LEXIEN,X=$$UP^XLFSTR($G(^LEX(LEXFI,LEXIEN,0))) Q:'$L(X)
  1. . S LEXDF=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",5))
  1. . I '$D(^LEX(LEXFI,"B",$E(X,1,63),DA))&(LEXDF'>0) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
  1. . S:$L(X)&(LEXDF'>0) ^LEX(LEXFI,"B",$E(X,1,63),DA)=""
  1. . N LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,4,LEXS)) Q:+LEXS'>0 D
  1. . . N DA,DIK,X S DA(1)=LEXIEN,DA=LEXS,X=$P($G(^LEX(LEXFI,DA(1),4,DA,0)),"^",1) Q:'$L(X)
  1. . . I '$D(^LEX(LEXFI,DA(1),4,"B",X,DA)) D
  1. . . . S LEXNER=LEXNER+1 I '$D(ZTQUEUED) W !,?10,757.17,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
  1. . . S:$L(X) ^LEX(LEXFI,DA(1),4,"B",X,DA)=""
  1. . S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXIEN,5,LEXS)) Q:+LEXS'>0 D
  1. . . N DA,DIK,X S DA(1)=LEXIEN,DA=LEXS,X=$P($G(^LEX(LEXFI,DA(1),5,DA,0)),"^",1) Q:'$L(X)
  1. . . I '$D(^LEX(LEXFI,DA(1),5,"B",X,DA)) D
  1. . . . S LEXSER=LEXSER+1 I '$D(ZTQUEUED) W !,?10,757.18,?19,LEXIDX,?30,"Missing",?58," ",DA(1),"/",DA
  1. . . S:$L(X) ^LEX(LEXFI,DA(1),5,"B",X,DA)=""
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. S LEXNER=$S(+LEXNER>0:LEXNER,1:"") I '$D(ZTQUEUED) W !,$J(LEXNER,5),?10,757.17,?19,LEXIDX,?30,LEXIDNT
  1. S LEXSER=$S(+LEXSER>0:LEXSER,1:"") I '$D(ZTQUEUED) W !,$J(LEXSER,5),?10,757.18,?19,LEXIDX,?30,LEXIDST
  1. S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. D REP^LEXRXXS(LEXFI,757.17,LEXIDX,LEXNDSN,LEXNER,LEXIDNT)
  1. D REP^LEXRXXS(LEXFI,757.18,LEXIDX,LEXNDSS,LEXSER,LEXIDST)
  1. Q
  1. RADC ; Index ^LEX(757.01,"ADC",1,IEN)
  1. S:$D(ZTQUEUED) ZTREQ="@" W:'$D(ZTQUEUED) ! N DA,DIK,LEXBEG,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""ADC""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="ADC",LEXIDXT="^LEX(757.01,""ADC"",1,IEN)"
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. . . N LEXOK,LEXDF S LEXDF=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",5))
  1. . . S LEXOK=0 S:LEXDF=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXDF) ^LEX(LEXFI,LEXIDX,LEXDF,LEXIEN)=""
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,+DA,1)),"^",5)
  1. . I +X'>0,$D(^LEX(LEXFI,"ADC",+X,+DA)) D Q
  1. . . S LEXERR=LEXERR+1
  1. . . K:'$D(LEXTEST) ^LEX(LEXFI,"ADC",+X,+DA),^LEX(LEXFI,"ADC",1,+DA)
  1. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (0)",?58," ",DA
  1. . I +X>0,'$D(^LEX(LEXFI,"ADC",+X,+DA)) D Q
  1. . . Q:+X'=1 S LEXERR=LEXERR+1
  1. . . S:'$D(LEXTEST) ^LEX(LEXFI,"ADC",+X,+DA)=""
  1. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
  1. . S:+X>0 ^LEX(LEXFI,"ADC",+X,+DA)=""
  1. . I +X>0,+X'=1 D Q
  1. . . S LEXERR=LEXERR+1
  1. . . K:'$D(LEXTEST) ^LEX(LEXFI,"ADC",+X,+DA)
  1. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (>1)",?58," ",DA
  1. . K:'$D(LEXTEST)&(+X'=1) ^LEX(LEXFI,"ADC",+X,+DA),^LEX(LEXFI,"ADC",1,+DA)
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. Q
  1. RADTERM ; Index ^LEX(757.01,"ADTERM",DT,IEN)
  1. S:$D(ZTQUEUED) ZTREQ="@" N DA,DIK,LEXBEG,LEXDE,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""ADTERM""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="ADTERM",LEXIDXT="^LEX(757.01,""ADTERM"",EXP,IEN)"
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXIEN,0)) D Q
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. . . N LEXOK,LEXDF,LEXDE S LEXDF=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",5))
  1. . . S LEXDE=$$UP^XLFSTR($E($P($G(^LEX(LEXFI,LEXIEN,0)),U,1),1,63))
  1. . . I LEXDE'=LEXSTR,+LEXDF>0 D
  1. . . . S LEXERR=LEXERR+1
  1. . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S ^LEX(LEXFI,LEXIDX,LEXDE,LEXIEN)=""
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,20),$S($L(LEXSTR)>20:"...",1:""),?58," ",LEXIEN
  1. . . I +LEXDF'>0 D
  1. . . . S LEXERR=LEXERR+1
  1. . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,20),$S($L(LEXSTR)>20:"...",1:""),?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,LEXDF,X,UX S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
  1. . S UX=$$UP^XLFSTR(X) S LEXDF=+($P($G(^LEX(LEXFI,DA,1)),"^",5))
  1. . I +LEXDF>0,'$D(^LEX(LEXFI,LEXIDX,$E(X,1,63),DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
  1. . I +LEXDF'>0,$D(^LEX(LEXFI,LEXIDX,$E(X,1,63),DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted)",?58," ",DA
  1. . S:+LEXDF>0 ^LEX(LEXFI,LEXIDX,$E(UX,1,63),DA)=""
  1. . K:+LEXDF'>0 ^LEX(LEXFI,LEXIDX,$E(X,1,63),DA),^LEX(LEXFI,LEXIDX,$E(UX,1,63),DA)
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. Q
  1. RAH ; Index ^LEX(757.01,"AH",HA,IEN,IEN2)
  1. S:$D(ZTQUEUED) ZTREQ="@" N DA,DIK,LEXBEG,LEXDE,LEXDF,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXEX,LEXEX2,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""AH""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="AH",LEXIDXT="^LEX(757.01,""AH"",HA,IEN,IEN2)"
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXEX S LEXEX=0 F S LEXEX=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEX)) Q:+LEXEX'>0 D
  1. . . N LEXEX2 S LEXEX2=0 F S LEXEX2=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEX,LEXEX2)) Q:+LEXEX2'>0 D
  1. . . . N LEXND,LEXHA S LEXND=$G(^LEX(LEXFI,LEXEX,7,LEXEX2,0)),LEXHA=$P(LEXND,"^",3)
  1. . . . S LEXNDS=LEXNDS+1 I '$D(^LEX(LEXFI,LEXEX,7,LEXEX2,0)) D Q
  1. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEX,LEXEX2)
  1. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXEX
  1. . . . I $L(LEXHA),LEXSTR'=LEXHA D
  1. . . . . S LEXERR=LEXERR+1
  1. . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEX,LEXEX2) S ^LEX(LEXFI,LEXIDX,LEXHA,LEXEX,LEXEX2)=""
  1. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,20),$S($L(LEXSTR)>20:"...",1:""),?58," ",LEXEX
  1. S LEXEX=0 F S LEXEX=$O(^LEX(LEXFI,LEXEX)) Q:+LEXEX'>0 D
  1. . N LEXEX2 S LEXEX2=0 F S LEXEX2=$O(^LEX(LEXFI,LEXEX,7,LEXEX2)) Q:+LEXEX2'>0 D
  1. . . N DA,DIK,LEXND,LEXHA,X S DA(1)=LEXEX,DA=LEXEX2,LEXND=$G(^LEX(LEXFI,DA(1),7,DA,0))
  1. . . S (X,LEXHA)=$P(LEXND,"^",3) Q:'$L(LEXHA)
  1. . . I '$D(^LEX(LEXFI,LEXIDX,X,DA(1),DA)) D
  1. . . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA(1)
  1. . . S:$L(X) ^LEX(LEXFI,LEXIDX,X,DA(1),DA)=""
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. Q
  1. ;
  1. ; Miscellaneous
  1. SET ; Re-Index (some indexes in file 757.01, set logic only)
  1. S:$D(ZTQUEUED) ZTREQ="@" Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT,LEXIEN,LEXP3,LEXP4
  1. N LEXOUT,LEXMSG,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S LEXFI=757.01
  1. D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG") S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
  1. S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
  1. S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
  1. S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1 I 1 D
  1. . N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S ZTRTN="SETIX^LEXRXC" S ZTDESC="Set 757.01 Indexes"
  1. . S ZTSAVE("LEXRT")="",ZTSAVE("LEXFI")="",ZTIO="",ZTDTH=$H D ^%ZTLOAD
  1. Q:$D(LEXQ) S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
  1. D REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
  1. S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
  1. S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
  1. Q
  1. SETIX ; Set Indexes (Set logic only)
  1. S:$D(ZTQUEUED) ZTREQ="@" W:'$D(ZTQUEUED) !,?8,"Re-Indexing",! N DIK,LEXP3,LEXP4,LEXIEN
  1. S DIK="^LEX(757.01,",DIK(1)=".01^B" D ENALL^DIK S DIK="^LEX(757.01,",DIK(1)="1^AMC" D ENALL^DIK
  1. S DIK="^LEX(757.01,",DIK(1)="9^ADC^ADTERM" D ENALL^DIK S DIK="^LEX(757.01,",DIK(1)="13^APAR" D ENALL^DIK
  1. F S LEXIEN=$O(^LEX(757.01,LEXIEN)) Q:+LEXIEN'>0 S LEXP3=LEXIEN,LEXP4=LEXP4+1
  1. S $P(^LEX(757.01,0),"^",3)=LEXP3,$P(^LEX(757.01,0),"^",4)=LEXP4
  1. Q
  1. DL ; De-Link AWRD
  1. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(757.05,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N LEXNC,LEXND,LEXNN,LEXWRD S LEXND=$G(^LEX(757.05,+LEXIEN,0)) Q:$P(LEXND,"^",3)'="L" S LEXWRD=$P(LEXND,"^",1)
  1. . S LEXNN="^LEX(757.01,""AWRD"","""_LEXWRD_""")",LEXNC="^LEX(757.01,""AWRD"","""_LEXWRD_""","
  1. . F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) K:LEXNN[",""LINKED"")" @LEXNN
  1. Q
  1. MC ; Major Concept Map File
  1. N DIK S DIK="^LEX(757," D IXALL^DIK
  1. Q
  1. RL ; Re-Link 757.05
  1. N LEX,DIK S LEX=" " F S LEX=$O(^LEX(757.05,LEX)) Q:'$L(LEX) K:LEX?1U.U ^LEX(757.05,LEX)
  1. S DIK="^LEX(757.05," D IXALL^DIK
  1. Q
  1. SL ; String Length ASL
  1. N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(757.01,"ASL",LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXSCT,LEXPSCT S LEXSCT=$$SCT^LEXRXC3(LEXSTR)
  1. . S LEXPSCT=$O(^LEX(757.01,"ASL",LEXSTR,0))
  1. . I +LEXPSCT>0,+LEXSCT'>0 K ^LEX(757.01,"ASL",LEXSTR,+LEXPSCT)
  1. . I +LEXPSCT>0,+LEXSCT>0,+LEXPSCT'=LEXSCT D
  1. . . K ^LEX(757.01,"ASL",LEXSTR,+LEXPSCT) S ^LEX(757.01,"ASL",LEXSTR,+LEXSCT)=""
  1. Q
  1. CLR ; Clear
  1. K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
  1. Q