- LEXRXG2 ;ISL/KER - Re-Index 757.33 ACT/AMAP/AREV ;08/17/2011
- ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
- ;
- ; Global Variables
- ; ^LEX( SACC 1.3
- ; ^LEX(757.33, SACC 1.3
- ; ^LEX(757.32, SACC 1.3
- ;
- ; External References
- ; $$FMDIFF^XLFDT ICR 10103
- ; $$FMTE^XLFDT ICR 10103
- ; $$NOW^XLFDT ICR 10103
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- ; LEXTEST Test variable NEWed/KILLed by Developer
- ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- ;
- Q
- EN ; Main Entry Point
- R75733 ; Repair file 757.33
- D RACT,RAMAP,RAREV
- Q
- RACT ; Index ^LEX(757.33,"ACT",SRC,TGT,EFF,STA,IEN,HIS)
- N DA,DIK,LEXBEG,LEXDIF,LEXEFF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSRC,LEXSTA,LEXTGT
- S LEXFI="757.33"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""ACT""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSRC="",LEXFI=757.33,LEXIDX="ACT",LEXIDXT="^LEX(757.33,""ACT"",SR,TG,EF,ST,IEN,HIS)"
- S LEXSRC="" F S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXSRC)) Q:'$L(LEXSRC) D
- . N LEXTGT S LEXTGT="" F S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT)) Q:'$L(LEXTGT) D
- . . N LEXEFF S LEXEFF="" F S LEXEFF=$O(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF)) Q:'$L(LEXEFF) D
- . . . N LEXSTA S LEXSTA="" F S LEXSTA=$O(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA)) Q:'$L(LEXSTA) D
- . . . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA,LEXIEN)) Q:+LEXIEN'>0 D
- . . . . . N LEXHIS S LEXHIS=0 F S LEXHIS=$O(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA,LEXIEN,LEXHIS)) Q:+LEXHIS'>0 D
- . . . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXR,LEXT,LEXE,LEXS,LEXED,LEXSD
- . . . . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0)),LEXNH=$G(^LEX(757.33,+LEXIEN,2,+LEXHIS,0))
- . . . . . . S LEXR=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3),LEXE=$P(LEXNH,"^",1),LEXS=$P(LEXNH,"^",2)
- . . . . . . Q:'$L(LEXR) Q:'$L(LEXT) Q:'$L(LEXE) Q:'$L(LEXS)
- . . . . . . S LEXED=$TR($$FMTE^XLFDT(LEXEFF,"5DZ"),"@"," ")
- . . . . . . S LEXSD=$S(+LEXSTA>0:"Active",1:"Inactive")
- . . . . . . I $TR(LEXSRC," ","")'=LEXR!($TR(LEXTGT," ","")'=LEXT)!(LEXEFF'=LEXE)!(LEXSTA'=LEXS) D
- . . . . . . . N DA S DA(1)=LEXIEN,DA=LEXHIS S LEXERR=LEXERR+1
- . . . . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA,LEXIEN,LEXHIS)
- . . . . . . . S:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,(LEXR_" "),(LEXT_" "),LEXE,LEXS,DA(1),DA)=""
- . . . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXED," ",LEXSD,?58," ",DA(1),"/",DA
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N LEXHIS S LEXHIS=0 F S LEXHIS=$O(^LEX(LEXFI,LEXIEN,2,LEXHIS)) Q:+LEXHIS'>0 D
- . . N DA,DIK,X,LEXN0,LEXHN,LEXR,LEXT,LEXE,LEXS,LEXED,LEXSD
- . . S DA(1)=LEXIEN,DA=LEXHIS,LEXN0=$G(^LEX(757.33,+LEXIEN,0)),LEXNH=$G(^LEX(757.33,+LEXIEN,2,+LEXHIS,0))
- . . S LEXR=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3),LEXE=$P(LEXNH,"^",1),LEXS=$P(LEXNH,"^",2)
- . . Q:'$L(LEXR) Q:'$L(LEXT) Q:'$L(LEXE) Q:'$L(LEXS) S LEXED=$TR($$FMTE^XLFDT(LEXE,"5DZ"),"@"," ")
- . . S LEXSD=$S(+LEXS>0:"Active",1:"Inactive") I '$D(^LEX(LEXFI,LEXIDX,(LEXR_" "),(LEXT_" "),LEXE,LEXS,DA(1),DA)) D
- . . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXED," ",LEXSD,?58," ",DA(1),"/",DA
- . . S ^LEX(LEXFI,LEXIDX,(LEXR_" "),(LEXT_" "),LEXE,LEXS,DA(1),DA)=""
- S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- H 5 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- Q
- RAMAP ; Index ^LEX(757.33,"AMAP",DEF,SRC,TGT,IEN)
- N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF,LEXTGT
- S LEXFI="757.33"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""AMAP""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXDEF="",LEXFI=757.33,LEXIDX="AMAP",LEXIDXT="^LEX(757.33,""AMAP"",DEF,SRC,TGT,IEN)"
- S LEXDEF="" F S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF) D
- . S LEXSRC="" F S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC)) Q:'$L(LEXSRC) D
- . . S LEXTGT="" F S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT)) Q:'$L(LEXTGT) D
- . . . S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN)) Q:+LEXIEN'>0 D
- . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
- . . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
- . . . . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
- . . . . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
- . . . . Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
- . . . . I LEXDEF'=LEXN!($TR(LEXSRC," ","")'=LEXS)!($TR(LEXTGT," ","")'=LEXT) D
- . . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
- . . . . . K:'$D(LEXTEST) ^LEX(757.33,LEXIDX,LEXDEF,LEXSRC,LEXTGT,DA)
- . . . . . S:'$D(LEXTEST) ^LEX(757.33,LEXIDX,LEXN,LEXS,LEXT,DA)=""
- . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Map ",LEXS,?58," ",DA
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
- . S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0))
- . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
- . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
- . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
- . Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
- . I '$D(^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)) D
- . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Map ",LEXS,?58," ",DA
- . S ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)=""
- S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- H 3 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- Q
- RAREV ; Index ^LEX(757.33,"AREV",DEF,TGT,SRC,IEN)
- N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF,LEXTGT
- S LEXFI="757.33"
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.33 ""AREV""") Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXDEF="",LEXFI=757.33,LEXIDX="AREV",LEXIDXT="^LEX(757.33,""AREV"",DEF,TGT,SRC,IEN)"
- S LEXDEF="" F S LEXDEF=$O(^LEX(LEXFI,LEXIDX,LEXDEF)) Q:'$L(LEXDEF) D
- . S LEXTGT="" F S LEXTGT=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT)) Q:'$L(LEXTGT) D
- . . S LEXSRC="" F S LEXSRC=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC)) Q:'$L(LEXSRC) D
- . . . S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)) Q:+LEXIEN'>0 D
- . . . . S LEXNDS=LEXNDS+1 N LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
- . . . . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
- . . . . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
- . . . . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
- . . . . Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
- . . . . I LEXDEF'=LEXN!($TR(LEXSRC," ","")'=LEXS)!($TR(LEXTGT," ","")'=LEXT) D
- . . . . . N DA S DA=LEXIEN S LEXERR=LEXERR+1
- . . . . . K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)
- . . . . . S:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),LEXIEN)=""
- . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58," ",DA
- S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
- . S DA=LEXIEN,LEXN0=$G(^LEX(757.33,+LEXIEN,0))
- . S LEXN0=$G(^LEX(757.33,+LEXIEN,0))
- . S LEXD=$P(LEXN0,"^",4),LEXN=$P($G(^LEX(757.32,+LEXD,0)),"^",1)
- . S LEXS=$P(LEXN0,"^",2),LEXT=$P(LEXN0,"^",3)
- . Q:'$L(LEXD) Q:'$L(LEXN) Q:'$L(LEXS) Q:'$L(LEXT)
- . I '$D(^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)) D
- . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58," ",DA
- . S ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)=""
- S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- H 3 S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- Q
- ;
- ; Miscellaneous
- CLR ; Clear
- K LEXNAM,LEXTEST,ZTQUEUED
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXG2 8538 printed Feb 18, 2025@23:35:26 Page 2
- LEXRXG2 ;ISL/KER - Re-Index 757.33 ACT/AMAP/AREV ;08/17/2011
- +1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX( SACC 1.3
- +5 ; ^LEX(757.33, SACC 1.3
- +6 ; ^LEX(757.32, SACC 1.3
- +7 ;
- +8 ; External References
- +9 ; $$FMDIFF^XLFDT ICR 10103
- +10 ; $$FMTE^XLFDT ICR 10103
- +11 ; $$NOW^XLFDT ICR 10103
- +12 ;
- +13 ; Local Variables NEWed or KILLed Elsewhere
- +14 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- +15 ; LEXTEST Test variable NEWed/KILLed by Developer
- +16 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- +17 ;
- +18 QUIT
- EN ; Main Entry Point
- R75733 ; Repair file 757.33
- +1 DO RACT
- DO RAMAP
- DO RAREV
- +2 QUIT
- RACT ; Index ^LEX(757.33,"ACT",SRC,TGT,EFF,STA,IEN,HIS)
- +1 NEW DA,DIK,LEXBEG,LEXDIF,LEXEFF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSRC,LEXSTA,LEXTGT
- +2 SET LEXFI="757.33"
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.33 ""ACT""")
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXSRC=""
- SET LEXFI=757.33
- SET LEXIDX="ACT"
- SET LEXIDXT="^LEX(757.33,""ACT"",SR,TG,EF,ST,IEN,HIS)"
- +5 SET LEXSRC=""
- FOR
- SET LEXSRC=$ORDER(^LEX(LEXFI,LEXIDX,LEXSRC))
- if '$LENGTH(LEXSRC)
- QUIT
- Begin DoDot:1
- +6 NEW LEXTGT
- SET LEXTGT=""
- FOR
- SET LEXTGT=$ORDER(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT))
- if '$LENGTH(LEXTGT)
- QUIT
- Begin DoDot:2
- +7 NEW LEXEFF
- SET LEXEFF=""
- FOR
- SET LEXEFF=$ORDER(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF))
- if '$LENGTH(LEXEFF)
- QUIT
- Begin DoDot:3
- +8 NEW LEXSTA
- SET LEXSTA=""
- FOR
- SET LEXSTA=$ORDER(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA))
- if '$LENGTH(LEXSTA)
- QUIT
- Begin DoDot:4
- +9 NEW LEXIEN
- SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:5
- +10 NEW LEXHIS
- SET LEXHIS=0
- FOR
- SET LEXHIS=$ORDER(^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA,LEXIEN,LEXHIS))
- if +LEXHIS'>0
- QUIT
- Begin DoDot:6
- +11 SET LEXNDS=LEXNDS+1
- NEW LEXN0,LEXNH,LEXR,LEXT,LEXE,LEXS,LEXED,LEXSD
- +12 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- SET LEXNH=$GET(^LEX(757.33,+LEXIEN,2,+LEXHIS,0))
- +13 SET LEXR=$PIECE(LEXN0,"^",2)
- SET LEXT=$PIECE(LEXN0,"^",3)
- SET LEXE=$PIECE(LEXNH,"^",1)
- SET LEXS=$PIECE(LEXNH,"^",2)
- +14 if '$LENGTH(LEXR)
- QUIT
- if '$LENGTH(LEXT)
- QUIT
- if '$LENGTH(LEXE)
- QUIT
- if '$LENGTH(LEXS)
- QUIT
- +15 SET LEXED=$TRANSLATE($$FMTE^XLFDT(LEXEFF,"5DZ"),"@"," ")
- +16 SET LEXSD=$SELECT(+LEXSTA>0:"Active",1:"Inactive")
- +17 IF $TRANSLATE(LEXSRC," ","")'=LEXR!($TRANSLATE(LEXTGT," ","")'=LEXT)!(LEXEFF'=LEXE)!(LEXSTA'=LEXS)
- Begin DoDot:7
- +18 NEW DA
- SET DA(1)=LEXIEN
- SET DA=LEXHIS
- SET LEXERR=LEXERR+1
- +19 if '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIDX,LEXSRC,LEXTGT,LEXEFF,LEXSTA,LEXIEN,LEXHIS)
- +20 if '$DATA(LEXTEST)
- SET ^LEX(LEXFI,LEXIDX,(LEXR_" "),(LEXT_" "),LEXE,LEXS,DA(1),DA)=""
- +21 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXED," ",LEXSD,?58," ",DA(1),"/",DA
- End DoDot:7
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +23 NEW LEXHIS
- SET LEXHIS=0
- FOR
- SET LEXHIS=$ORDER(^LEX(LEXFI,LEXIEN,2,LEXHIS))
- if +LEXHIS'>0
- QUIT
- Begin DoDot:2
- +24 NEW DA,DIK,X,LEXN0,LEXHN,LEXR,LEXT,LEXE,LEXS,LEXED,LEXSD
- +25 SET DA(1)=LEXIEN
- SET DA=LEXHIS
- SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- SET LEXNH=$GET(^LEX(757.33,+LEXIEN,2,+LEXHIS,0))
- +26 SET LEXR=$PIECE(LEXN0,"^",2)
- SET LEXT=$PIECE(LEXN0,"^",3)
- SET LEXE=$PIECE(LEXNH,"^",1)
- SET LEXS=$PIECE(LEXNH,"^",2)
- +27 if '$LENGTH(LEXR)
- QUIT
- if '$LENGTH(LEXT)
- QUIT
- if '$LENGTH(LEXE)
- QUIT
- if '$LENGTH(LEXS)
- QUIT
- SET LEXED=$TRANSLATE($$FMTE^XLFDT(LEXE,"5DZ"),"@"," ")
- +28 SET LEXSD=$SELECT(+LEXS>0:"Active",1:"Inactive")
- IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXR_" "),(LEXT_" "),LEXE,LEXS,DA(1),DA))
- Begin DoDot:3
- +29 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXED," ",LEXSD,?58," ",DA(1),"/",DA
- End DoDot:3
- +30 SET ^LEX(LEXFI,LEXIDX,(LEXR_" "),(LEXT_" "),LEXE,LEXS,DA(1),DA)=""
- End DoDot:2
- End DoDot:1
- +31 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +32 HANG 5
- SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +33 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +34 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +35 QUIT
- RAMAP ; Index ^LEX(757.33,"AMAP",DEF,SRC,TGT,IEN)
- +1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF,LEXTGT
- +2 SET LEXFI="757.33"
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.33 ""AMAP""")
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXDEF=""
- SET LEXFI=757.33
- SET LEXIDX="AMAP"
- SET LEXIDXT="^LEX(757.33,""AMAP"",DEF,SRC,TGT,IEN)"
- +5 SET LEXDEF=""
- FOR
- SET LEXDEF=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF))
- if '$LENGTH(LEXDEF)
- QUIT
- Begin DoDot:1
- +6 SET LEXSRC=""
- FOR
- SET LEXSRC=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC))
- if '$LENGTH(LEXSRC)
- QUIT
- Begin DoDot:2
- +7 SET LEXTGT=""
- FOR
- SET LEXTGT=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT))
- if '$LENGTH(LEXTGT)
- QUIT
- Begin DoDot:3
- +8 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXSRC,LEXTGT,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:4
- +9 SET LEXNDS=LEXNDS+1
- NEW LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
- +10 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- +11 SET LEXD=$PIECE(LEXN0,"^",4)
- SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
- +12 SET LEXS=$PIECE(LEXN0,"^",2)
- SET LEXT=$PIECE(LEXN0,"^",3)
- +13 if '$LENGTH(LEXD)
- QUIT
- if '$LENGTH(LEXN)
- QUIT
- if '$LENGTH(LEXS)
- QUIT
- if '$LENGTH(LEXT)
- QUIT
- +14 IF LEXDEF'=LEXN!($TRANSLATE(LEXSRC," ","")'=LEXS)!($TRANSLATE(LEXTGT," ","")'=LEXT)
- Begin DoDot:5
- +15 NEW DA
- SET DA=LEXIEN
- SET LEXERR=LEXERR+1
- +16 if '$DATA(LEXTEST)
- KILL ^LEX(757.33,LEXIDX,LEXDEF,LEXSRC,LEXTGT,DA)
- +17 if '$DATA(LEXTEST)
- SET ^LEX(757.33,LEXIDX,LEXN,LEXS,LEXT,DA)=""
- +18 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Map ",LEXS,?58," ",DA
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +20 NEW DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
- +21 SET DA=LEXIEN
- SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- +22 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- +23 SET LEXD=$PIECE(LEXN0,"^",4)
- SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
- +24 SET LEXS=$PIECE(LEXN0,"^",2)
- SET LEXT=$PIECE(LEXN0,"^",3)
- +25 if '$LENGTH(LEXD)
- QUIT
- if '$LENGTH(LEXN)
- QUIT
- if '$LENGTH(LEXS)
- QUIT
- if '$LENGTH(LEXT)
- QUIT
- +26 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA))
- Begin DoDot:2
- +27 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Map ",LEXS,?58," ",DA
- End DoDot:2
- +28 SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXS_" "),(LEXT_" "),DA)=""
- End DoDot:1
- +29 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +30 HANG 3
- SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +31 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +32 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +33 QUIT
- RAREV ; Index ^LEX(757.33,"AREV",DEF,TGT,SRC,IEN)
- +1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXDEF,LEXTGT
- +2 SET LEXFI="757.33"
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.33 ""AREV""")
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- SET (LEXNDS,LEXERR)=0
- SET LEXDEF=""
- SET LEXFI=757.33
- SET LEXIDX="AREV"
- SET LEXIDXT="^LEX(757.33,""AREV"",DEF,TGT,SRC,IEN)"
- +5 SET LEXDEF=""
- FOR
- SET LEXDEF=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF))
- if '$LENGTH(LEXDEF)
- QUIT
- Begin DoDot:1
- +6 SET LEXTGT=""
- FOR
- SET LEXTGT=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT))
- if '$LENGTH(LEXTGT)
- QUIT
- Begin DoDot:2
- +7 SET LEXSRC=""
- FOR
- SET LEXSRC=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC))
- if '$LENGTH(LEXSRC)
- QUIT
- Begin DoDot:3
- +8 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:4
- +9 SET LEXNDS=LEXNDS+1
- NEW LEXN0,LEXNH,LEXD,LEXN,LEXT,LEXE,LEXS
- +10 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- +11 SET LEXD=$PIECE(LEXN0,"^",4)
- SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
- +12 SET LEXS=$PIECE(LEXN0,"^",2)
- SET LEXT=$PIECE(LEXN0,"^",3)
- +13 if '$LENGTH(LEXD)
- QUIT
- if '$LENGTH(LEXN)
- QUIT
- if '$LENGTH(LEXS)
- QUIT
- if '$LENGTH(LEXT)
- QUIT
- +14 IF LEXDEF'=LEXN!($TRANSLATE(LEXSRC," ","")'=LEXS)!($TRANSLATE(LEXTGT," ","")'=LEXT)
- Begin DoDot:5
- +15 NEW DA
- SET DA=LEXIEN
- SET LEXERR=LEXERR+1
- +16 if '$DATA(LEXTEST)
- KILL ^LEX(LEXFI,LEXIDX,LEXDEF,LEXTGT,LEXSRC,LEXIEN)
- +17 if '$DATA(LEXTEST)
- SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),LEXIEN)=""
- +18 IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid ",LEXN," Rev ",LEXS,?58," ",DA
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 SET LEXIEN=0
- FOR
- SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +20 NEW DA,DIK,X,LEXN0,LEXD,LEXN,LEXS,LEXT
- +21 SET DA=LEXIEN
- SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- +22 SET LEXN0=$GET(^LEX(757.33,+LEXIEN,0))
- +23 SET LEXD=$PIECE(LEXN0,"^",4)
- SET LEXN=$PIECE($GET(^LEX(757.32,+LEXD,0)),"^",1)
- +24 SET LEXS=$PIECE(LEXN0,"^",2)
- SET LEXT=$PIECE(LEXN0,"^",3)
- +25 if '$LENGTH(LEXD)
- QUIT
- if '$LENGTH(LEXN)
- QUIT
- if '$LENGTH(LEXS)
- QUIT
- if '$LENGTH(LEXT)
- QUIT
- +26 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA))
- Begin DoDot:2
- +27 SET LEXERR=LEXERR+1
- IF '$DATA(ZTQUEUED)
- WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXN," Rev ",LEXS,?58," ",DA
- End DoDot:2
- +28 SET ^LEX(LEXFI,LEXIDX,LEXN,(LEXT_" "),(LEXS_" "),DA)=""
- End DoDot:1
- +29 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
- IF '$DATA(ZTQUEUED)
- WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
- +30 HANG 3
- SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +31 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +32 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
- +33 QUIT
- +34 ;
- +35 ; Miscellaneous
- CLR ; Clear
- +1 KILL LEXNAM,LEXTEST,ZTQUEUED
- +2 QUIT
