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

LEXRXA.m

Go to the documentation of this file.
  1. LEXRXA ;ISL/KER - Re-Index 757 B ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEX(757, SACC 1.3
  1. ; ^LEX(757.001, SACC 1.3
  1. ; ^TMP("LEXRX") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; FILE^DID ICR 2052
  1. ; IX1^DIK ICR 10013
  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. R757 ; Repair file 757
  1. D RB,SET Q
  1. RB ; Index ^LEX(757,"B",EXP,IEN)
  1. W:'$D(ZTQUEUED) ! N DA,DIK,LEXBEG,LEXDIF,LEXTC,LEXELP,LEXEND,LEXERR,LEXFI,LEXFQ,LEXIDX
  1. N LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR,X S LEXFI=757
  1. N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757 ""B""") Q:LEXTC=1
  1. S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXIDX="B",LEXIDXT="^LEX(757,""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
  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,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,X S DA=LEXIEN,X=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:'$L(X)
  1. . I '$D(^LEX(LEXFI,"B",X,DA)) S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing",?58," ",DA
  1. . S ^LEX(LEXFI,"B",X,DA)="" I '$D(^LEX(757.001,DA)) D
  1. . . N LEXFQ,DIK S LEXFQ=+($$FREQ^LEXRXXM(DA)) S ^LEX(757.001,DA,0)=DA_"^"_LEXFQ_"^"_LEXFQ
  1. . . S DIK="^LEX(757.001," 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. SET ; Re-Index Major Concept Map file 757 (Set logic only)
  1. Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
  1. N LEXOUT,LEXMSG S LEXFI=757
  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(757.21," 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