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

LEXRXG3.m

Go to the documentation of this file. 
  1. LEXRXG3 ;ISL/KER - Re-Index 757.33 ASRC/ATAR ;08/17/2011
  1.  ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 10
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^LEX(               SACC 1.3
  1.  ;    ^LEX(757.33,        SACC 1.3
  1.  ;    ^LEX(757.32,        SACC 1.3
  1.  ;               
  1.  ; External References
  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.  ;     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 RASRC,RATAR
  1.  Q
  1. RASRC ;   Index    ^LEX(757.33,"ASRC",DEF,SRC,TGT,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 ""ASRC""") Q:LEXTC=1
  1.  S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.33,LEXIDX="ASRC",LEXIDXT="^LEX(757.33,""ASRC"",DEF,SRC,TGT,IEN)"
  1.  N LEXDEF S LEXDEF="" 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 LEXTGT S LEXTGT="" F  S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT)) Q:'$L(LEXTGT)  D
  1.  . . . N LEXIEN S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
  1.  . . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . . . . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
  1.  . . . . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
  1.  . . . . Q:'$L(LEXD)  Q:'$L(LEXN)  Q:'$L(LEXS)  Q:'$L(LEXT)
  1.  . . . . I LEXDEF'=LEXN!($TR(LEXSRC," ","")'=LEXS)!($TR(LEXTGT," ","")'=LEXT) D
  1.  . . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
  1.  . . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN)
  1.  . . . . . S:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),LEXIEN)=""
  1.  . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58,"  ",DA
  1.  S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . N DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
  1.  . S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
  1.  . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
  1.  . Q:'$L(LEXD)  Q:'$L(LEXN)  Q:'$L(LEXS)  Q:'$L(LEXT)
  1.  . I '$D(^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)) D
  1.  . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58,"  ",DA
  1.  . S ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(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. RATAR ;   Index    ^LEX(757.33,"ATAR",DEF,TAR,SRC,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 ""ATAR""") Q:LEXTC=1
  1.  S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXFI=757.33,LEXIDX="ATAR",LEXIDXT="^LEX(757.33,""ATAR"",DEF,SRC,TGT,IEN)"
  1.  N LEXDEF S LEXDEF="" F  S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF)  D
  1.  . N LEXTGT S LEXTGT="" F  S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT)) Q:'$L(LEXTGT)  D
  1.  . . N LEXSRC S LEXSRC="" F  S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC)) Q:'$L(LEXSRC)  D
  1.  . . . N LEXIEN S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
  1.  . . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . . . . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
  1.  . . . . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
  1.  . . . . Q:'$L(LEXD)  Q:'$L(LEXN)  Q:'$L(LEXS)  Q:'$L(LEXT)
  1.  . . . . I LEXDEF'=LEXN!($TR(LEXSRC," ","")'=LEXS)!($TR(LEXTGT," ","")'=LEXT) D
  1.  . . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
  1.  . . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)
  1.  . . . . . S:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),LEXIEN)=""
  1.  . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58,"  ",DA
  1.  S LEXIEN=0 F  S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0  D
  1.  . N DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
  1.  . S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
  1.  . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
  1.  . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
  1.  . Q:'$L(LEXD)  Q:'$L(LEXN)  Q:'$L(LEXS)  Q:'$L(LEXT)
  1.  . I '$D(^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)) D
  1.  . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58,"  ",DA
  1.  . S ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),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. CLR ;   Clear
  1.  K LEXNAM,LEXTEST,ZTQUEUED
  1.  Q