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

LEXRXE.m

Go to the documentation of this file.
  1. LEXRXE ;ISL/KER - Re-Index 757.1 B/AMCC/AMCT/ASTT ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**81,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757) SACC 1.3
  1. ; ^LEX(757.1) SACC 1.3
  1. ; ^LEX(757.11) SACC 1.3
  1. ; ^LEX(757.12) SACC 1.3
  1. ; ^TMP("LEXRX",$J) SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; FILE^DID ICR 2052
  1. ; IXALL^DIK ICR 10013
  1. ; $$FMDIFF^XLFDT ICR 10103
  1. ; $$NOW^XLFDT ICR 10103
  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. ; 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. R7571 ; Repair file 757.1
  1. D RB,RAMCC,RAMCT,RASTT,SET
  1. Q
  1. RB ; Index ^LEX(757.1,"B",MC,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1. S LEXFI="757.1"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""B""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI="757.1",LEXIDX="B",LEXIDXT="^LEX(757.1,""B"",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 N LEXOK,LEXMC S LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",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:$L(LEXMC) ^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,LEXMC S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:+LEXMC'>0 Q:'$D(^LEX(757,+LEXMC,0))
  1. . I '$D(^LEX(LEXFI,LEXIDX,LEXMC,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,?58," ",DA
  1. . S:$L(LEXMC) ^LEX(LEXFI,LEXIDX,LEXMC,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. RAMCC ; Index ^LEX(757.1,"AMCC",MC,SC,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
  1. S LEXFI="757.1"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""AMCC""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR=0,LEXFI=757.1,LEXIDX="AMCC",LEXIDXT="^LEX(757.1,""AMCC"",MC,SC,IEN) "
  1. S LEXMAJ=0 F S LEXMAJ=$O(^LEX(LEXFI,LEXIDX,LEXMAJ)) Q:+LEXMAJ'>0 D
  1. . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR)) Q:'$L(LEXSTR) D
  1. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC,LEXSC S LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,1)
  1. . . . S LEXSC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,2),LEXSC=$P($G(^LEX(757.11,+LEXSC,0)),U,1)
  1. . . . S LEXOK=1 S:LEXMC'=LEXMAJ LEXOK=0 S:LEXSTR'=LEXSC LEXOK=0 I 'LEXOK D
  1. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)
  1. . . . . S:$L(LEXSC)&(+LEXMC>0) ^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,LEXIEN)=""
  1. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXMC,"/",LEXSTR,?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,LEXMC,LEXSC,DIK S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),U,1) Q:+LEXMC'>0
  1. . S LEXSC=$P($G(^LEX(LEXFI,DA,0)),U,2),LEXSC=$E($P($G(^LEX(757.11,+LEXSC,0)),U,1),1,3) Q:$L(LEXSC)'=3
  1. . I '$D(^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,"/",LEXSC,?58," ",DA
  1. . S:$L(LEXMC)&($L(LEXSC)) ^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,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. RAMCT ; Index ^LEX(757.1,"AMCT",MC,ST,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
  1. S LEXFI="757.1"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""AMCT""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR=0,LEXFI=757.1,LEXIDX="AMCT",LEXIDXT="^LEX(757.1,""AMCT"",MC,ST,IEN)"
  1. S LEXMAJ=0 F S LEXMAJ=$O(^LEX(LEXFI,LEXIDX,LEXMAJ)) Q:+LEXMAJ'>0 D
  1. . N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR)) Q:'$L(LEXSTR) D
  1. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC,LEXST S LEXOK=1,LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,1)
  1. . . . S LEXST=$P($G(^LEX(LEXFI,LEXIEN,0)),U,3) S:LEXMC'=LEXMAJ LEXOK=0 S:LEXSTR'=LEXST LEXOK=0 I 'LEXOK D
  1. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)
  1. . . . . S:$L(LEXST)&(+LEXMC>0) ^LEX(LEXFI,LEXIDX,LEXMC,LEXST,LEXIEN)=""
  1. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXMC,"/",LEXSTR,?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,LEXMC,LEXTY S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),U,1) Q:+LEXMC'>0
  1. . S LEXTY=$P($G(^LEX(LEXFI,DA,0)),U,3) Q:'$L(LEXTY)
  1. . I '$D(^LEX(LEXFI,LEXIDX,LEXMC,LEXTY,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,"/",LEXTY,?58," ",DA
  1. . S:$L(LEXMC)&($L(LEXTY)) ^LEX(LEXFI,LEXIDX,LEXMC,LEXTY,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. RASTT ; Index ^LEX(757.1,"ASTT",ST,MC,IEN)
  1. N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
  1. S LEXFI="757.1"
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""ASTT""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR=0,LEXFI=757.1,LEXIDX="ASTT",LEXIDXT="^LEX(757.1,""ASTT"",ST,MC,IEN)"
  1. N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXMAJ S LEXMAJ=0 F S LEXMAJ=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ)) Q:+LEXMAJ'>0 D
  1. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC,LEXST S LEXOK=1,LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,1)
  1. . . . S LEXST=$P($G(^LEX(LEXFI,LEXIEN,0)),U,3) S:LEXMC'=LEXMAJ LEXOK=0 S:LEXSTR'=LEXST LEXOK=0 I 'LEXOK D
  1. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ,LEXIEN)
  1. . . . . S:$L(LEXST)&(+LEXMC>0) ^LEX(LEXFI,LEXIDX,LEXST,LEXMC,LEXIEN)=""
  1. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,"/",LEXMC,?58," ",LEXIEN
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . N DA,DIK,LEXMC,LEXTY S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),U,1) Q:+LEXMC'>0
  1. . S LEXTY=$P($G(^LEX(LEXFI,DA,0)),U,3) Q:'$L(LEXTY)
  1. . I '$D(^LEX(LEXFI,LEXIDX,LEXTY,LEXMC,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTY,"/",LEXMC,?58," ",DA
  1. . S:$L(LEXTY)&($L(LEXMC)) ^LEX(LEXFI,LEXIDX,LEXTY,LEXMC,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 Semantic Map file 757.1 (Set logic only)
  1. Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
  1. N LEXOUT,LEXMSG S LEXFI=757.1
  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 S LEXP3=LEXIEN,LEXP4=LEXP4+1
  1. S:LEXP3>0 $P(^LEX(LEXFI,0),"^",3)=LEXP3 S:LEXP4>0 $P(^LEX(LEXFI,0),"^",4)=LEXP4
  1. I +($G(LEXP4))>0 D
  1. . N ZTQUEUED,DIK S ZTQUEUED=$G(ZTQUEUED) S DIK="^LEX("_LEXFI_"," D IXALL^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. CLR ; Clear
  1. K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
  1. Q