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

LEXRXF.m

Go to the documentation of this file.
  1. LEXRXF ;ISL/KER - Re-Index 757.21 B/C/AA ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**81,80**;Sep 23, 1996;Build 10
  1. ;
  1. ; Global Variables
  1. ; ^LEX( SACC 1.3
  1. ; ^LEX(757) SACC 1.3
  1. ; ^LEX(757.01) SACC 1.3
  1. ; ^LEX(757.011) SACC 1.3
  1. ; ^LEX(757.21) SACC 1.3
  1. ; ^LEXT(757.2) SACC 1.3
  1. ; ^TMP("LEXRX") SACC 2.3.2.5.1
  1. ; ^TMP("LEXRXF") SACC 2.3.2.5.1
  1. ; ^TMP("LEXTKN") SACC 2.3.2.5.1
  1. ; ^TMP("LEXWRD") 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. ; IX1^DIK ICR 10013
  1. ; IX1^DIK ICR 10013
  1. ;
  1. ; Local Variables NEWed or KILLed Elsewhere
  1. ; LEXFIX Fix Index flag NEWed/KILLed by LEXRXXT
  1. ; LEXNAM Task name NEWed/KILLed by LEXRXXT
  1. ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
  1. ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
  1. ; LEXTEST Test variable NEWed/KILLed by Developer
  1. ; ZTQUEUED Task flag NEWed/KILLed by Taskman
  1. ;
  1. Q
  1. EN ; Main Entry Point
  1. R75721 ; Repair file 757.21
  1. K ^TMP("LEXRXF",$J) D RB,RC,RAA,SET K ^TMP("LEXRXF",$J)
  1. Q
  1. RB ; Index ^LEX(757.21,"B",EXP,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.21"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""B""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.21,LEXIDX="B",LEXIDXT="^LEX(757.21,""B"",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 N LEXOK,LEXEX S LEXEX=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
  1. . . S LEXOK=0 S:LEXEX=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXEX) ^LEX(LEXFI,LEXIDX,LEXEX,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,0)),"^",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 ",X,?58," ",DA
  1. . S:$L(X) ^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. RC ; Index ^LEX(757.21,"C",EXP,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.21"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""C""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.21,LEXIDX="C",LEXIDXT="^LEX(757.21,""C"",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 N LEXOK,LEXEX,LEXEXP
  1. . . S LEXEX=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
  1. . . S LEXEXP=$E($$UP^XLFSTR($G(^LEX(757.01,+($G(LEXEX)),0))),1,63)
  1. . . S LEXOK=0 S:LEXEXP=LEXSTR LEXOK=1 I 'LEXOK D
  1. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,"C",LEXSTR,LEXIEN) S:$L(LEXEXP) ^LEX(LEXFI,"C",LEXEXP,LEXIEN)=""
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,$E(LEXSTR,1,28),?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,X,LEXEXP S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1),LEXEXP=$E($$UP^XLFSTR(^LEX(757.01,X,0)),1,63)
  1. . Q:+X'>0 Q:'$L(LEXEXP)
  1. . I '$D(^LEX(LEXFI,LEXIDX,LEXEXP,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",$E(LEXEXP,1,20),?58," ",DA
  1. . S ^LEX(LEXFI,LEXIDX,LEXEXP,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. RAA ; Index ^LEX(757.21,("A"_SUBSET),WORD,IEN)
  1. ; ^LEX(757.21,"ADEN",WORD,IEN)
  1. ; ^LEX(757.21,"AIMM",WORD,IEN)
  1. ; ^LEX(757.21,"ANUR",WORD,IEN)
  1. ; ^LEX(757.21,"ASOC",WORD,IEN)
  1. ; ^LEX(757.21,[etc],WORD,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXEX,LEXEXI,LEXELP,LEXEXP,LEXEXPS,LEXFI,LEXI,LEXID,LEXIDX,LEXIDXT,LEXIEN,LEXJ
  1. N LEXMC,LEXNDS,LEXOK,LEXSIDX,LEXSTR,LEXT,LEXTY,LEXW,LEXDENE,LEXIMME,LEXNURE,LEXSOCE,LEXDENN,LEXIMMN,LEXNURN,LEXSOCN,X
  1. S LEXFI="757.21" K ^TMP("LEXRXF",$J)
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.21 ""AA""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS)=0,LEXSTR="",LEXFI=757.21,LEXIDX=" "
  1. S LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
  1. . Q:LEXIDX="B" Q:LEXIDX="C" Q:LEXIDX?1N.N
  1. . S LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
  1. . N LEXBEG,LEXEND,LEXTIM,LEXERR,LEXNDS,LEXELP
  1. . S LEXERR=$G(^TMP("LEXRXF",$J,LEXIDX,"E"))
  1. . S LEXNDS=$G(^TMP("LEXRXF",$J,LEXIDX,"N"))
  1. . S LEXELP=$G(^TMP("LEXRXF",$J,LEXIDX,"T"))
  1. . S LEXBEG=$$NOW^XLFDT H 2
  1. . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1. . N LEXTNG,LEXTC S LEXFI="757.21",LEXTNG="Repairing"
  1. . I +($G(LEXFI))>0,$D(ZTQUEUED) D Q:LEXTC=1
  1. . . S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Repairing File #757.21 """_LEXIDX_""""))
  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=+($G(LEXNDS))+1,^TMP("LEXRXF",$J,LEXIDX,"N")=LEXNDS
  1. . . . I '$D(^LEX(757.21,LEXIEN,0)) D Q
  1. . . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=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 LEXI,LEXIX K LEXEXPS
  1. . . . S LEXEX=+($G(^LEX(757.21,LEXIEN,0)))
  1. . . . S LEXMC=$P(^LEX(757.01,LEXEX,1),U,1)
  1. . . . S LEXID=$P($G(^LEX(757.21,LEXIEN,0)),U,2)
  1. . . . S LEXID=$P(^LEXT(757.2,LEXID,0),U,2) S:$L(LEXID) LEXID="A"_LEXID Q:'$L(LEXID)
  1. . . . S LEXEXI=0 F S LEXEXI=$O(^LEX(757.01,"AMC",LEXMC,LEXEXI)) Q:+LEXEXI'>0 D
  1. . . . . N LEXTY,LEXT,LEXW,LEXJ,LEXEXP,LEXSIDX S LEXEXP=$G(^LEX(757.01,LEXEXI,0))
  1. . . . . S LEXTY=+($P($G(^LEX(757.01,LEXEXI,1)),U,2)) Q:LEXTY'>0
  1. . . . . S LEXT=+($P($G(^LEX(757.011,LEXTY,0)),"^",2)) Q:LEXT=0
  1. . . . . S LEXSIDX=LEXID K ^TMP("LEXTKN",$J) S X=LEXEXP,LEXIX=LEXIDX,LEXIDX="" D PTX^LEXTOKN S LEXIDX=LEXIX
  1. . . . . I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 D
  1. . . . . . N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0 D
  1. . . . . . . N LEXW S LEXW=$O(^TMP("LEXTKN",$J,LEXI,"")) Q:'$L(LEXW) S LEXEXPS(LEXID,LEXW,LEXIEN)=""
  1. . . . . K ^TMP("LEXTKN",$J)
  1. . . . I $L(LEXIDX),$L(LEXSTR),$L(LEXIEN) D
  1. . . . . I '$D(LEXEXPS(LEXIDX,LEXSTR,LEXIEN)) D
  1. . . . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXIDX,"E")=LEXERR
  1. . . . . . K:'$D(LEXTEST) ^LEX(757.21,LEXIDX,LEXSTR,LEXIEN)
  1. . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
  1. . . . . . N LEXW S LEXW="" F S LEXW=$O(LEXEXPS(LEXIDX,LEXW)) Q:'$L(LEXW) D
  1. . . . . . . N LEXI S LEXI=0 F S LEXI=$O(LEXEXPS(LEXIDX,LEXW,LEXI)) Q:+LEXI'>0 D
  1. . . . . . . . S ^LEX(757.21,LEXID,LEXW,LEXI)=""
  1. . . . K LEXEXPS
  1. . S LEXEND=$$NOW^XLFDT,LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
  1. . S:$E(LEXTIM,1)=" "&($E(LEXTIM,3)=":") LEXTIM=$TR(LEXTIM," ","0")
  1. . S ^TMP("LEXRXF",$J,LEXIDX,"T")=LEXTIM
  1. I '$D(ZTQUEUED) W !,?8,"Check for missing records"
  1. N LEXIEN,LEXNDS,LEXBEG,LEXEND,LEXELP,LEXMIS
  1. S LEXBEG=$$NOW^XLFDT,LEXNDS=0,LEXMIS=0
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,LEXIX,LEXAIX,LEXERR,LEXEXP,LEXMC,LEXTEXP,LEXW S DA=LEXIEN
  1. . S LEXIX=$P($G(^LEX(LEXFI,DA,0)),"^",2),LEXIX=$P($G(^LEXT(757.2,+LEXIX,0)),"^",2)
  1. . S LEXAIX="A"_LEXIX
  1. . S LEXERR=$G(^TMP("LEXRXF",$J,LEXAIX,"E"))
  1. . K ^TMP("LEXWRD",$J)
  1. . S LEXEXP=+(^LEX(757.21,DA,0)),LEXMC=$P(^LEX(757.01,LEXEXP,1),U,1)
  1. . K ^TMP("LEXTKN",$J),^TMP("LEXWRD",$J)
  1. . S LEXNDS=LEXNDS+1
  1. . S LEXTEXP=0 F S LEXTEXP=$O(^LEX(757.01,"AMC",LEXMC,LEXTEXP)) Q:+LEXTEXP=0 D
  1. . . N X,LEXIDX,LEXYPE,LEXT,LEXJ S X=$G(^LEX(757.01,LEXTEXP,0)),LEXIDX="" Q:'$L(X)
  1. . . S LEXYPE=+($P($G(^LEX(757.01,LEXTEXP,1)),U,2)) Q:LEXYPE'>0
  1. . . S LEXT=+($P($G(^LEX(757.011,LEXYPE,0)),"^",2)) Q:LEXT=0
  1. . . D PTX^LEXTOKN I $D(^TMP("LEXTKN",$J,0)),^TMP("LEXTKN",$J,0)>0 F LEXJ=1:1:^TMP("LEXTKN",$J,0) D
  1. . . . N LEXW S LEXW=$O(^TMP("LEXTKN",$J,LEXJ,"")) S:$L(LEXW) ^TMP("LEXWRD",$J,LEXW)=""
  1. . . K ^TMP("LEXTKN",$J) Q
  1. . S LEXW="" F S LEXW=$O(^TMP("LEXWRD",$J,LEXW)) Q:'$L(LEXW) D
  1. . . I '$D(^LEX(LEXFI,LEXAIX,LEXW,DA)) D
  1. . . . S LEXMIS=LEXMIS+0
  1. . . . S LEXERR=+($G(LEXERR))+1,^TMP("LEXRXF",$J,LEXAIX,"E")=LEXERR
  1. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXAIX,?30,"Missing ",$E(LEXW,1,18),?58," ",DA
  1. . . S:$L(LEXW)&(+DA>0)&($L(LEXAIX))&($L(LEXFI)) ^LEX(LEXFI,LEXAIX,LEXW,DA)=""
  1. . K ^TMP("LEXWRD",$J),^TMP("LEXTKN",$J)
  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,"AAAA",LEXNDS,LEXMIS,"^LEX(757.21,""ASUB"",WORD,IEN)",LEXELP)
  1. S LEXIDX=" " F S LEXIDX=$O(^LEX(757.21,LEXIDX)) Q:'$L(LEXIDX) D
  1. . Q:LEXIDX="B" Q:LEXIDX="C"
  1. . N LEXFI,LEXERR,LEXELP,LEXNDS,LEXIDXT S LEXFI=757.21
  1. . S LEXERR=$G(^TMP("LEXRXF",$J,LEXIDX,"E"))
  1. . S LEXNDS=$G(^TMP("LEXRXF",$J,LEXIDX,"N"))
  1. . S LEXELP=$G(^TMP("LEXRXF",$J,LEXIDX,"T"))
  1. . S LEXIDXT="^LEX(757.21,"""_LEXIDX_""",WORD,IEN)"
  1. . S LEXERR=$S(+($G(LEXERR))>0:LEXERR,1:"")
  1. . S LEXNDS=$S(+($G(LEXNDS))>0:LEXNDS,1:"")
  1. . S LEXELP=$S($L($G(LEXELP))>0:LEXELP,1:"")
  1. . D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
  1. K ^TMP("LEXRXF",$J)
  1. Q
  1. ;
  1. ; Miscellaneous
  1. SET ; Re-Index Subset file 757.21 (Set logic only)
  1. Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
  1. N LEXOUT,LEXMSG S LEXFI=757.21
  1. D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
  1. 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))
  1. Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
  1. N LEXIEN,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
  1. F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK S DA=+($G(LEXIEN)) D:$D(LEXFIX) FIX(DA)
  1. . I $D(^LEX(LEXFI,+LEXIEN,0)) D
  1. . . S LEXP3=LEXIEN,LEXP4=LEXP4+1
  1. . . S DA=LEXIEN,DIK=LEXRT D IX1^DIK
  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. FIX(X) ; Fix Deactivated Expressions in 757.21
  1. N DA,DIK,LEXEXP,LEXDFL Q:'$D(LEXFIX) S DA=+($G(X)) Q:+DA'>0 Q:'$D(^LEX(757.21,+DA,0))
  1. S LEXEXP=+$G(^LEX(757.21,+DA,0)) Q:+LEXEXP'>0
  1. S LEXDFL=$P($G(^LEX(757.01,+LEXEXP,1)),"^",5) Q:+LEXDFL'>0
  1. I $D(LEXFIX) S DIK="^LEX(757.21," D ^DIK
  1. Q
  1. CLR ; Clear
  1. N LEXFIX,LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
  1. Q