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

LEXRXC2.m

Go to the documentation of this file.
  1. LEXRXC2 ;ISL/KER - Re-Index 757.01 AMC/APAR ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**81,86,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX( SACC 1.3
  1. ; ^LEX(757.01, SACC 1.3
  1. ; ^LEX(757.04, SACC 1.3
  1. ; ^LEX(757.05, SACC 1.3
  1. ;
  1. ; External References
  1. ; ^DIK ICR 10013
  1. ; IX1^DIK ICR 10013
  1. ; $$FMDIFF^XLFDT ICR 10103
  1. ; $$NOW^XLFDT ICR 10103
  1. ; $$UP^XLFSTR ICR 10104
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; LEXNAM Task name NEWed/KILLed by LEXRXXT
  1. ; LEXTEST Test variable NEWed/KILLed by Developer
  1. ; ZTQUEUED Task flag NEWed/KILLed by Taskman
  1. ;
  1. Q
  1. ; NOTES:
  1. ;
  1. ; The AMC cross-references is used to create the AWRD
  1. ; cross-reference, hence the AMC cross-reference must
  1. ; be repaired/re-indexed before AWRD.
  1. ;
  1. EN ; Main Entry Point
  1. R75701 ; Repair file 757.01
  1. D RAMC,RAPAR
  1. Q
  1. RAMC ; Index ^LEX(757.01,"AMC",MC,IEN)
  1. S:$D(ZTQUEUED) ZTREQ="@" N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""AMC""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="AMC",LEXIDXT="^LEX(757.01,""AMC"",MC,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
  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,LEXMC S LEXMC=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",1))
  1. . . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:+LEXMC>0 ^LEX(LEXFI,LEXIDX,+LEXMC,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=+($G(^LEX(LEXFI,DA,1))) Q:'$L(X)
  1. . I '$D(^LEX(LEXFI,LEXIDX,X,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
  1. . S:$L(X) ^LEX(LEXFI,LEXIDX,X,DA)=""
  1. . S ^LEX(LEXFI,LEXIDX,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 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. RAPAR ; Index ^LEX(757.01,"APAR",MC,IEN)
  1. S:$D(ZTQUEUED) ZTREQ="@" Q N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXPAR,LEXPR,LEXSTR
  1. S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""APAR""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="APAR",LEXIDXT="^LEX(757.01,""APAR"",PARENT,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 N LEXOK,LEXPR S LEXPR=+($P($G(^LEX(LEXFI,LEXIEN,1)),"^",9))
  1. . . S LEXOK=0 S:LEXPR=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:+LEXPR>0 ^LEX(LEXFI,LEXIDX,+LEXPR,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,LEXPAR S DA=LEXIEN S LEXPAR=$P($G(^LEX(757.01,DA,1)),"^",9) Q:'$L(LEXPAR)
  1. . I '$D(^LEX(757.01,LEXIDX,$E(LEXPAR,1,30),DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
  1. . S:$L(LEXPAR) ^LEX(757.01,LEXIDX,$E(LEXPAR,1,30),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. RAWRD ; Index ^LEX(757.01,"AWRD",WORD,MC,EXP)
  1. S:$D(ZTQUEUED) ZTREQ="@" N DA,DIK,LEXBEG,LEXDIF,LEXE,LEXELP,LEXEND,LEXERR,LEXEXCL,LEXEXP,LEXFI,LEXHI,LEXI,LEXIDX,LEXIDXT,LEXL,LEXLO,LEXM
  1. N LEXMCE,LEXNDS,LEXS,LEXS1,LEXS2,LEXS3,LEXS4,LEXSTR,LEXT,LEXTC,LEXTK,LEXTKN,LEXTNG,LEXW,LEXWDS,X
  1. S LEXFI="757.01"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""AWRD""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.01,LEXIDX="AWRD",LEXIDXT="^LEX(757.01,""AWRD"",WORD,MC,EXP)"
  1. S LEXTKN="" F S LEXTKN=$O(^LEX(LEXFI,LEXIDX,LEXTKN)) Q:'$L(LEXTKN) D
  1. . S LEXEXCL=0 I $O(^LEX(757.04,"B",LEXTKN,0))>0 D
  1. . . S LEXEXCL=$P($G(^LEX(757.04,+($O(^LEX(757.04,"B",LEXTKN,0))),0)),"^",2),LEXEXCL=$S(LEXEXCL="B":1,LEXEXCL="I":1,1:0)
  1. . S LEXS1="" F S LEXS1=$O(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1)) Q:'$L(LEXS1) D
  1. . . S LEXS2="" F S LEXS2=$O(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2)) Q:'$L(LEXS2) D
  1. . . . ; Supplemental ^LEX(757.01,"AWRD",WORD,IEN,MC,SUP)
  1. . . . ; Duplicates
  1. . . . N LEXLO,LEXHI F D Q:+($G(LEXHI))'>+($G(LEXLO))
  1. . . . . N DA,DIK S LEXLO=$O(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2,"")),LEXHI=$O(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2," "),-1) Q:(+LEXLO+LEXHI)'>0
  1. . . . . I LEXLO>0,LEXHI>0,LEXHI>LEXLO S DA(1)=LEXS1,DA=LEXHI S DIK="^LEX(757.01,"_DA(1)_",5," D:$D(@(DIK_DA_",0)")) ^DIK
  1. . . . I $D(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2))=10!($D(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2))=11) D
  1. . . . . N LEXS3 S LEXS3="" F S LEXS3=$O(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2,LEXS3)) Q:'$L(LEXS3) D
  1. . . . . . N LEXEXP,LEXMCE,LEXSTR S LEXNDS=+($G(LEXNDS))+1
  1. . . . . . S LEXEXP=LEXS1,LEXMCE=+($$MCE^LEXRXXM(LEXEXP))
  1. . . . . . S LEXSTR=$P($G(^LEX(LEXFI,+LEXEXP,5,+LEXS3,0)),"^",1)
  1. . . . . . ; Redundant
  1. . . . . . I $D(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2))=11 D
  1. . . . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"1",?8,LEXFI,?19,LEXIDX,?30,LEXTKN,?58," ",LEXS1,"/",LEXS2,"/",LEXS3
  1. . . . . . . I '$D(LEXTEST) D
  1. . . . . . . . N DA,DIK,LEXI,LEXIDX,LEXT,LEXWDS
  1. . . . . . . . S LEXT=$P($G(^LEX(757.01,+LEXEXP,0)),"^",1),LEXI=0 D WORDS^LEXRXXP(LEXT,.LEXWDS) S LEXIDX="AWRD"
  1. . . . . . . . Q:'$D(LEXWDS(LEXTKN)) S DA(1)=LEXEXP,DA=LEXS3,DIK="^LEX(757.01,"_DA(1)_",5," I $D(@(DIK_DA_",0)")) D
  1. . . . . . . . . D ^DIK K ^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2,LEXS3)
  1. . . . . . ; Verify
  1. . . . . . N LEXS D SUP^LEXRXXP(LEXEXP,.LEXS) I '$D(LEXS("S",LEXTKN,LEXS1,LEXS2,LEXS3)) D
  1. . . . . . . Q:+LEXS3'>0 S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"2",?8,LEXFI,?19,LEXIDX,?30,LEXTKN,?58," ",LEXS1,"/",LEXS2,"/",LEXS3
  1. . . . . . . I '$D(LEXTEST) K ^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2,LEXS3)
  1. . . . ; Linked ^LEX(757.01,"AWRD",WORD,IEN,"LINKED")
  1. . . . I $D(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2))=1,LEXS2="LINKED" D Q
  1. . . . . N LEXEXP,LEXL S LEXEXP=LEXS1,LEXNDS=+($G(LEXNDS))+1 D LINK^LEXRXXP(LEXEXP,.LEXL)
  1. . . . . Q:$D(LEXL("R",LEXTKN,+LEXEXP,"LINKED"))!($D(LEXL("L",LEXTKN,+LEXEXP,"LINKED")))
  1. . . . . I '$D(LEXL("R",LEXTKN,+LEXEXP,"LINKED"))&($D(LEXL("L",LEXTKN,+LEXEXP,"LINKED"))) D
  1. . . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"3",?8,LEXFI,?19,LEXIDX,?30,LEXTKN,?58," ",LEXS1,"/",LEXS2
  1. . . . . . I '$D(LEXTEST) K ^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2)
  1. . . . ; Words ^LEX(757.01,"AWRD",WORD,MC,IEN)
  1. . . . I $D(^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2))=1,+LEXS2>0,$D(^LEX(757.01,+LEXS2,0)) D Q
  1. . . . . N LEXW,LEXIDX D AWRD^LEXRXXP(+LEXS2,.LEXW,1) S LEXIDX="AWRD" S LEXNDS=+($G(LEXNDS))+1
  1. . . . . I '$D(LEXW("W",LEXTKN,LEXS1,LEXS2)) D Q
  1. . . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"4",?8,LEXFI,?19,LEXIDX,?30,LEXTKN,?58," ",LEXS2
  1. . . . . . I '$D(LEXTEST) K ^LEX(LEXFI,LEXIDX,LEXTKN,LEXS1,LEXS2)
  1. S LEXEXP=0 F S LEXEXP=$O(^LEX(LEXFI,LEXEXP)) Q:+LEXEXP'>0 D
  1. . N DA,DIK,LEXS,LEXS1,LEXS1,LEXS3,LEXS4,X S DA=$G(LEXEXP),X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
  1. . I $L(X),$D(^LEX(LEXFI,+($G(DA)),0)),$D(^LEX(LEXFI,+($G(DA)),1)) D
  1. . . N LEXW,LEXTK,LEXM,LEXE S ^LEX(LEXFI,"B",$$UP^XLFSTR($E(X,1,63)),DA)=""
  1. . . D AWRD^LEXRXXP(+DA,.LEXW,1) S LEXTK="" F S LEXTK=$O(LEXW("W",LEXTK)) Q:'$L(LEXTK) D
  1. . . . S LEXM=0 F S LEXM=$O(LEXW("W",LEXTK,LEXM)) Q:+LEXM'>0 D
  1. . . . . S LEXE=0 F S LEXE=$O(LEXW("W",LEXTK,LEXM,LEXE)) Q:+LEXE'>0 D
  1. . . . . . Q:$D(^LEX(757.01,"AWRD",LEXTK,LEXM))
  1. . . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"5",?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXTK,1,18),?58," ",LEXM,"/",LEXE
  1. . . . . . S ^LEX(757.01,"AWRD",LEXTK,LEXM,LEXE)=""
  1. . K LEXS D SUP^LEXRXXP(LEXEXP,.LEXS)
  1. . S LEXS1="" F S LEXS1=$O(LEXS("S",LEXS1)) Q:'$L(LEXS1) S LEXS2="" F S LEXS2=$O(LEXS("S",LEXS1,LEXS2)) Q:'$L(LEXS2) D
  1. . . S LEXS3="" F S LEXS3=$O(LEXS("S",LEXS1,LEXS2,LEXS3)) Q:'$L(LEXS3) S LEXS4="" F S LEXS4=$O(LEXS("S",LEXS1,LEXS2,LEXS3,LEXS4)) Q:'$L(LEXS4) D
  1. . . . I '$D(^LEX(757.01,"AWRD",LEXS1,LEXS2,LEXS3,LEXS4)) D
  1. . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"6",?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXS1,1,18),?58," ",LEXS2,"/",LEXS3,"/",LEXS4
  1. . . . . S ^LEX(757.01,"AWRD",LEXS1,LEXS2,LEXS3,LEXS4)=""
  1. . K LEXS D LINK^LEXRXXP(LEXEXP,.LEXS)
  1. . S LEXS1="" F S LEXS1=$O(LEXS("L",LEXS1)) Q:'$L(LEXS1) S LEXS2="" F S LEXS2=$O(LEXS("L",LEXS1,LEXS2)) Q:'$L(LEXS2) D
  1. . . S LEXS3="" F S LEXS3=$O(LEXS("L",LEXS1,LEXS2,LEXS3)) Q:'$L(LEXS3) D
  1. . . . I '$D(^LEX(757.01,"AWRD",LEXS1,LEXS2,LEXS3)) D
  1. . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"7",?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXS1,1,18),?58," ",LEXS2,"/",LEXS3
  1. . . . . S ^LEX(757.01,"AWRD",LEXS1,LEXS2,LEXS3)=""
  1. . S LEXS1="" F S LEXS1=$O(LEXS("R",LEXS1)) Q:'$L(LEXS1) S LEXS2="" F S LEXS2=$O(LEXS("R",LEXS1,LEXS2)) Q:'$L(LEXS2) D
  1. . . S LEXS3="" F S LEXS3=$O(LEXS("R",LEXS1,LEXS2,LEXS3)) Q:'$L(LEXS3) D
  1. . . . I '$D(^LEX(757.01,"AWRD",LEXS1,LEXS2)) D
  1. . . . . Q:$D(^LEX(757.04,"ACTION",LEXS1,"B"))!($D(^LEX(757.04,"ACTION",LEXS1,"I")))
  1. . . . . S LEXERR=+($G(LEXERR))+1 I '$D(ZTQUEUED) W !,"8",?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXS1,1,18),?58," ",LEXS2,"/",LEXS3
  1. . . . . S ^LEX(757.01,"AWRD",LEXS1,LEXS2,LEXS3)=""
  1. . K LEXS S LEXS=0 F S LEXS=$O(^LEX(LEXFI,LEXEXP,5,LEXS)) Q:+LEXS'>0 D
  1. . . N DA,DIK S DA(1)=LEXEXP,DA=LEXS,DIK="^LEX(757.01,"_DA(1)_",5," D IX1^DIK
  1. S LEXEXP=0 F S LEXEXP=$O(^LEX(757.05,LEXEXP)) Q:+LEXEXP'>0 D
  1. . N DA,DIK S DA=LEXEXP,DIK="^LEX(757.05," D IX1^DIK
  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. CLR ; Clear
  1. K LEXNAM,LEXTEST,ZTQUEUED
  1. Q