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 Apr 09, 2024@21:07:47 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
