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

LEXRXG.m

Go to the documentation of this file. 
  1. LEXRXG ;ISL/KER - Re-Index 757.33 B/C/G ;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.32)        SACC 1.3
  1.  ;    ^LEX(757.33)        SACC 1.3
  1.  ;    ^TMP("LEXRX")       SACC 2.3.2.5.1
  1.  ;               
  1.  ; External References
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;    $$FMADD^XLFDT       ICR  10103
  1.  ;    $$FMDIFF^XLFDT      ICR  10103
  1.  ;    $$FMTE^XLFDT        ICR  10103
  1.  ;    $$NOW^XLFDT         ICR  10103
  1.  ;    FILE^DID            ICR   2052
  1.  ;    IX1^DIK             ICR  10013
  1.  ;    IX2^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. R75733 ; Repair file 757.33
  1.  D RB,RC,RG,R75733^LEXRXG2,R75733^LEXRXG3,SET
  1.  Q
  1. RB ;   Index    ^LEX(757.33,"B",MID,IEN) 
  1.  N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
  1.  S LEXFI="757.33"
  1.  N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""B""") Q:LEXTC=1
  1.  S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.33,LEXIDX="B",LEXIDXT="^LEX(757.33,""B"",MID,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,LEXID S LEXID=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
  1.  . . S LEXOK=0 S:LEXID=LEXSTR LEXOK=1 I 'LEXOK D
  1.  . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
  1.  . . . S:$L(LEXID) ^LEX(LEXFI,LEXIDX,LEXID,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.  H 2 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.33,"C",DEF,SRC,ORD,TAR,IEN)
  1.  N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF
  1.  S LEXFI="757.33"
  1.  N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""C""") Q:LEXTC=1
  1.  S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXDEF="",LEXFI=757.33,LEXIDX="C",LEXIDXT="^LEX(757.33,""C"",EXP,IEN)"
  1.  F  S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF)  D
  1.  . N LEXSRC S LEXSRC="" F  S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC)) Q:'$L(LEXSRC)  D
  1.  . . N LEXORD S LEXORD="" F  S LEXORD=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXORD)) Q:'$L(LEXORD)  D
  1.  . . . N LEXTAR S LEXTAR="" F  S LEXTAR=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXORD,LEXTAR)) Q:'$L(LEXTAR)  D
  1.  . . . . N LEXIEN S LEXIEN="" F  S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXORD,LEXTAR,LEXIEN)) Q:'$L(LEXIEN)  D
  1.  . . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXN3,LEXD,LEXS,LEXO,LEXT S LEXN0=$G(^LEX(757.33,+LEXIEN,0)),LEXN3=$G(^LEX(757.33,+LEXIEN,3))
  1.  . . . . . S LEXD=$P(LEXN0,"^",4),LEXS=$P(LEXN0,"^",2),LEXO=$P(LEXN3,"^",1),LEXT=$P(LEXN0,"^",3)
  1.  . . . . . Q:'$L(LEXD)  Q:'$L(LEXS)  Q:'$L(LEXO)  Q:'$L(LEXT)
  1.  . . . . . I LEXDEF'=LEXD!(LEXSRC'=LEXS)!(LEXORD'=LEXO)!(LEXTAR'=LEXT) D
  1.  . . . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
  1.  . . . . . . K ^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXORD,LEXTAR,LEXIEN)
  1.  . . . . . . S ^LEX(LEXFI,LEXIDX,LEXD,LEXS,LEXO,LEXT,DA)=""
  1.  . . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXSRC,"/",LEXTAR,?58,"  ",DA
  1.  S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . N DA,DIK,X,LEXN0,LEXN3,LEXD,LEXS,LEXO,LEXT S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0)),LEXN3=$G(^LEX(757.33,+LEXIEN,3))
  1.  . S LEXD=$P(LEXN0,"^",4),LEXS=$P(LEXN0,"^",2),LEXO=$P(LEXN3,"^",1),LEXT=$P(LEXN0,"^",3) Q:'$L(LEXD)  Q:'$L(LEXS)  Q:'$L(LEXO)  Q:'$L(LEXT)
  1.  . I '$D(^LEX(LEXFI,LEXIDX,LEXD,LEXS,LEXO,LEXT,DA)) D
  1.  . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXS,"/",LEXT,?58,"  ",DA
  1.  . S ^LEX(LEXFI,LEXIDX,LEXD,LEXS,LEXO,LEXT,DA)=""
  1.  S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
  1.  H 2 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. RG ;   Index    ^LEX(757.33,"G",MAP,EFF,STA,IEN,HIS)
  1.  N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF
  1.  S LEXFI="757.33"
  1.  N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""G""") Q:LEXTC=1
  1.  S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXDEF="",LEXFI=757.33,LEXIDX="G",LEXIDXT="^LEX(757.33,""G"",EXP,IEN)"
  1.  F  S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF)  D
  1.  . N LEXEFF S LEXEFF="" F  S LEXEFF=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXEFF)) Q:'$L(LEXEFF)  D
  1.  . . N LEXSTA S LEXSTA="" F  S LEXSTA=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXEFF,LEXSTA)) Q:'$L(LEXSTA)  D
  1.  . . . N LEXIEN S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXEFF,LEXSTA,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . . . . N LEXHIS S LEXHIS=0 F  S LEXHIS=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXEFF,LEXSTA,LEXIEN,LEXHIS)) Q:+LEXHIS'>0  D
  1.  . . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXHN,LEXD,LEXE,LEXS
  1.  . . . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0)),LEXNH=$G(^LEX(757.33,+LEXIEN,2,+LEXHIS,0))
  1.  . . . . . S LEXD=$P(LEXN0,"^",1),LEXE=$P(LEXNH,"^",1),LEXS=$P(LEXNH,"^",2)
  1.  . . . . . Q:'$L(LEXD)  Q:'$L(LEXE)  Q:'$L(LEXS)
  1.  . . . . . I LEXDEF'=LEXD!(LEXEFF'=LEXE)!(LEXSTA'=LEXS) D
  1.  . . . . . . N DA,LEXED,LEXSD S DA(1)=LEXIEN,DA=LEXHIS S LEXERR=LEXERR+1
  1.  . . . . . . S LEXED=$TR($$FMTE^XLFDT(LEXEFF,"5DZ"),"@"," ")
  1.  . . . . . . S LEXSD=$S(+LEXSTA>0:"Active",1:"Inactive")
  1.  . . . . . . K ^LEX(757.33,"G",LEXDEF,LEXEFF,LEXSTA,DA(1))
  1.  . . . . . . S ^LEX(757.33,"G",LEXD,LEXE,LEXS,DA(1))=""
  1.  . . . . . . S ^LEX(757.33,"G",LEXD,LEXE,LEXS,DA(1),DA)=""
  1.  . . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXED," ",LEXSD,?58,"  ",DA(1),"/",DA
  1.  S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . N LEXHIS S LEXHIS=0 F  S LEXHIS=$O(^LEX(LEXFI,LEXIEN,2,LEXHIS)) Q:+LEXHIS'>0  D
  1.  . . N DA,DIK,X,LEXN0,LEXHN,LEXD,LEXE,LEXS,LEXED,LEXSD
  1.  . . S DA(1)=LEXIEN,DA=LEXHIS
  1.  . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . . S LEXNH=$G(^LEX(757.33,+LEXIEN,2,+LEXHIS,0))
  1.  . . S LEXD=$P(LEXN0,"^",1),LEXE=$P(LEXNH,"^",1),LEXS=$P(LEXNH,"^",2) Q:'$L(LEXD)  Q:'$L(LEXE)  Q:'$L(LEXS)
  1.  . . S LEXED=$TR($$FMTE^XLFDT(LEXE,"5DZ"),"@"," ")
  1.  . . S LEXSD=$S(+LEXS>0:"Active",1:"Inactive")
  1.  . . I $D(^LEX(LEXFI,LEXIDX,LEXD,LEXE,LEXS,DA(1)))<11 D
  1.  . . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXED," ",LEXSD,?58,"  ",DA(1),"/",DA
  1.  . . S ^LEX(LEXFI,LEXIDX,LEXD,LEXE,LEXS,DA(1))=""
  1.  . . S ^LEX(LEXFI,LEXIDX,LEXD,LEXE,LEXS,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.  H 2 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 Subset file 757.33 (Set logic only)
  1.  Q:'$D(LEXSET)  N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
  1.  N LEXOUT,LEXMSG S LEXFI=757.33
  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)) I $D(LEXFIX) D FIX(DA)
  1.  . I $D(^LEX(LEXFI,LEXIEN)) D
  1.  . . S LEXP3=LEXIEN,LEXP4=LEXP4+1
  1.  . . S DA=LEXIEN,DIK=LEXRT D IX1^DIK
  1.  S $P(^LEX(LEXFI,0),"^",3)=LEXP3,$P(^LEX(LEXFI,0),"^",4)=LEXP4
  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 Inactive Mappings 757.33
  1.  N DA,DIK,LEXDEF,LEXEF,LEXEF1,LEXHIS,LEXMAP,LEXN0,LEXNC,LEXNE,LEXNEXT
  1.  N LEXNH,LEXNS,LEXSCODE,LEXSEFF,LEXSIEN,LEXSNOM,LEXSRC,LEXSSAB,LEXSSTA
  1.  N LEXSSYS,LEXST,LEXTCODE,LEXTD,LEXTEFF,LEXTIEN,LEXTNON,LEXTSAB
  1.  N LEXTSTA,LEXTSYS S LEXTD=$$DT^XLFDT,DA=+($G(X)) Q:+DA'>0
  1.  Q:'$D(^LEX(757.33,DA,0))  Q:'$D(^LEX(757.33,DA,2))
  1.  S LEXN0=$G(^LEX(757.33,DA,0))
  1.  S LEXEF=$O(^LEX(757.33,+DA,2,"B",(LEXTD+.001)),-1) Q:LEXEF'?7N
  1.  S LEXEF1=$$FMADD^XLFDT(LEXEF,1) Q:LEXEF1'?7N  Q:LEXEF1'<LEXTD
  1.  S LEXHIS=$O(^LEX(757.33,+DA,2,"B",+LEXEF," "),-1)
  1.  S LEXNH=$G(^LEX(757.33,+DA,2,+LEXHIS,0)) S LEXST=$P(LEXNH,"^",2)
  1.  Q:LEXST'>0  S LEXSCODE=$P(LEXN0,"^",2) S LEXTCODE=$P(LEXN0,"^",3)
  1.  S LEXMAP=$P(LEXN0,"^",4) S LEXDEF=$G(^LEX(757.32,+LEXMAP,2))
  1.  S LEXSSYS=$P(LEXDEF,"^",1),LEXTSYS=$P(LEXDEF,"^",2)
  1.  S LEXSRC=$G(^LEX(757.03,LEXSSYS,0))
  1.  S LEXSSAB=$E(LEXSRC,1,3),LEXSNOM=$P(LEXSRC,"^",2)
  1.  S LEXSRC=$G(^LEX(757.03,LEXTSYS,0))
  1.  S LEXTSAB=$E(LEXSRC,1,3),LEXTNON=$P(LEXSRC,"^",2)
  1.  S LEXSSTA=$$STATCHK^LEXSRC2(LEXSCODE,LEXTD,,LEXSSAB)
  1.  S LEXSIEN=$P(LEXSSTA,"^",2),LEXSEFF=$P(LEXSSTA,"^",3)
  1.  S LEXTSTA=$$STATCHK^LEXSRC2(LEXTCODE,LEXTD,,LEXTSAB)
  1.  S LEXTIEN=$P(LEXTSTA,"^",2),LEXTEFF=$P(LEXSSTA,"^",3)
  1.  Q:+LEXSSTA>0&(+LEXTSTA>0)  S LEXNEXT=$O(^LEX(757.33,+DA,2," "),-1)+1
  1.  S LEXNS=0,LEXNE=LEXEF1,LEXNC=$$NOW^XLFDT I $D(LEXFIX) D
  1.  . N DIK S DIK="^LEX(757.33," D IX2^DIK
  1.  . S ^LEX(757.33,+DA,2,0)="^757.333D^"_LEXNEXT_"^"_LEXNEXT
  1.  . S ^LEX(757.33,+DA,2,+LEXNEXT,0)=LEXNE_"^"_LEXNS_"^"_LEXNC
  1.  . W "."
  1.  . S DIK="^LEX(757.33," D IX1^DIK
  1.  Q
  1. CLR ;   Clear
  1.  K LEXFIX,LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
  1.  Q