LEXRXD4 ;ISL/KER - Re-Index 757.02 AVA/CODE/ADX/APR ;12/19/2014
;;2.0;LEXICON UTILITY;**81,80,86**;Sep 23, 1996;Build 1
;
; Global Variables
; ^LEX( SACC 1.3
; ^LEX(757.02, SACC 1.3
; ^LEX(757, SACC 1.3
; ^LEX(757.03, SACC 1.3
;
; External References
; $$FMDIFF^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
R75702 ; Repair file 757.02
D RAVA,RCODE,RI10 Q
RAVA ; Index ^LEX(757.02,"AVA",CODE,EXP,SAB,IEN)
N DA,DIK,LEXBEG,LEXCK,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""AVA""") Q:LEXTC=1
S LEXCK=$$SABS^LEXRXXM S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0
S LEXSTR="",LEXFI=757.02,LEXIDX="AVA",LEXIDXT="^LEX(757.02,""AVA"",CODE,EXP,SAB,IEN)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXEXP S LEXEXP=0 F S LEXEXP=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP)) Q:+LEXEXP'>0 D
. . N LEXSAB S LEXSAB="" F S LEXSAB=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB)) Q:'$L(LEXSAB) D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)) Q:+LEXIEN'>0 D
. . . . N LEXOK,LEXSO,LEXEX,LEXSR,LEXSB S LEXNDS=LEXNDS+1
. . . . S LEXEX=$P($G(^LEX(757.02,+LEXIEN,0)),"^",1),LEXSO=$P($G(^LEX(757.02,+LEXIEN,0)),"^",2)
. . . . S LEXSR=$P($G(^LEX(757.02,+LEXIEN,0)),"^",3),LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
. . . . I $L(LEXSAB)'=3!(LEXCK'[LEXSAB) D Q
. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid SAB ",LEXSAB,?58," ",LEXIEN,!,?30,LEXCK
. . . . I '$L(LEXEX)!('$L(LEXSO))!($L(LEXSB)'=3) D Q
. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
. . . . S LEXOK=1 S:LEXSTR='(LEXSO_" ") LEXOK=0 S:LEXEXP'=LEXEX LEXOK=0 S:LEXSAB'=LEXSB LEXOK=0 I 'LEXOK D
. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
. . . . . S:$L(LEXSO)&($L(LEXEX))&($L(LEXSB))&(LEXCK[("^"_LEXSB_"^")) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXEX,LEXSB,LEXIEN)=""
. . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXEX,LEXSO,LEXSR,LEXSB S DA=LEXIEN,LEXSR=$P($G(^LEX(LEXFI,+DA,0)),"^",3),LEXSO=$P($G(^LEX(LEXFI,DA,0)),U,2)
. S LEXEX=$P($G(^LEX(LEXFI,DA,0)),U,1),LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3) Q:$L(LEXSB)'=3 Q:'$L(LEXSO) Q:+LEXEX'>0
. I LEXCK[("^"_LEXSB_"^"),'$D(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,"/",LEXSB,?58," ",DA
. I LEXCK'[("^"_LEXSB_"^"),$D(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted) ",LEXSO,"/",LEXSB,?58," ",DA
. . K:'$D(LEXTEST) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
. S:LEXCK[("^"_LEXSB_"^")&($L(LEXSO))&($L(LEXEX)) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)=""
. K:LEXCK'[("^"_LEXSB_"^")&('$D(LEXTEST))&($L(LEXSO))&($L(LEXEX)) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
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
RCODE ; Index ^LEX(757.02,"CODE",CODE,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""CODE""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.02,LEXIDX="CODE",LEXIDXT="^LEX(757.02,""CODE"",CODE,IEN)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . S LEXNDS=LEXNDS+1 N LEXOK,LEXSO S LEXSO=$P($G(^LEX(757.02,LEXIEN,0)),U,2)
. . S LEXOK=0 S:(LEXSO_" ")=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXSO) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
. . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXSO S DA=LEXIEN,LEXSO=$P($G(^LEX(LEXFI,DA,0)),U,2) Q:'$L(LEXSO)
. I '$D(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA
. S:$L(LEXSO) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
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
RI10 ; Index ^LEX(757.02 "ADX" amd "APR"
D:$D(^LEX(757.02,"ADX")) RADX D:$D(^LEX(757.02,"APR")) RAPR
Q
RADX ; Index ^LEX(757.02,"ADX",CODE,DATE,STA,IEN,HIS)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""ADX""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.02,LEXIDX="ADX",LEXIDXT="^LEX(757.02,""ADX"",CODE,DT,STA,IEN,HIS)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXEFF S LEXEFF=0 F S LEXEFF=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF)) Q:+LEXEFF'>0 D
. . N LEXSTA S LEXSTA="" F S LEXSTA=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA)) Q:'$L(LEXSTA) D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN)) Q:+LEXIEN'>0 D
. . . . N LEXHIS S LEXHIS=0 F S LEXHIS=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS)) Q:+LEXHIS'>0 D
. . . . . S LEXNDS=LEXNDS+1 N LEXOK,LEX0,LEXH,LEXSO,LEXSR,LEXST,LEXEF
. . . . . S LEX0=$G(^LEX(757.02,LEXIEN,0)),LEXH=$G(^LEX(757.02,LEXIEN,4,LEXHIS,0)),LEXSO=$P(LEX0,"^",2)
. . . . . S LEXSR=$P(LEX0,"^",3),LEXST=$P(LEXH,"^",2),LEXEF=$P(LEXH,"^",1)
. . . . . S LEXOK=1 S:(LEXSO_" ")'=LEXSTR LEXOK=0 S:LEXSR'=30 LEXOK=0
. . . . . S:LEXEFF'=LEXEF LEXOK=0 S:LEXSTA'=LEXST LEXOK=0 I 'LEXOK D
. . . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS)
. . . . . . S:$L(LEXSO) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
. . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Error: ",LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEX0,LEXHI,LEXSO,LEXSR
. S LEX0=$G(^LEX(LEXFI,LEXIEN,0)) S LEXSO=$P(LEX0,U,2) Q:'$L(LEXSO) S LEXSR=$P(LEX0,U,3) Q:+LEXSR'=30
. S LEXHI=0 F S LEXHI=$O(^LEX(757.02,LEXIEN,4,LEXHI)) Q:+LEXHI'>0 D
. . N LEXH,LEXEF,LEXST S LEXH=$G(^LEX(LEXFI,LEXIEN,4,LEXHI,0))
. . S LEXEF=$P(LEXH,U,1) Q:'$L(LEXEF)
. . S LEXST=$P(LEXH,U,2) Q:'$L(LEXST)
. . S DA(1)=LEXIEN,DA=LEXHI
. . I '$D(^LEX(757.02,"ADX",(LEXSO_" "),LEXEF,LEXST,DA(1),DA)) D
. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA(1),", ",DA
. . . S:$L(LEXSO)&($L(LEXEF))&($L(LEXST))&(+($G(DA(1)))>0)&(+($G(DA))>0) ^LEX(757.02,"ADX",(LEXSO_" "),LEXEF,LEXST,DA(1),DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
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
RAPR ; Index ^LEX(757.02,"APR",CODE,DATE,STA,IEN,HIS)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.02"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.02 ""APR""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.02,LEXIDX="APR",LEXIDXT="^LEX(757.02,""APR"",CODE,DT,STA,IEN,HIS)"
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXEFF S LEXEFF=0 F S LEXEFF=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF)) Q:+LEXEFF'>0 D
. . N LEXSTA S LEXSTA="" F S LEXSTA=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA)) Q:'$L(LEXSTA) D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN)) Q:+LEXIEN'>0 D
. . . . N LEXHIS S LEXHIS=0 F S LEXHIS=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS)) Q:+LEXHIS'>0 D
. . . . . S LEXNDS=LEXNDS+1 N LEXOK,LEX0,LEXH,LEXSO,LEXSR,LEXST,LEXEF
. . . . . S LEX0=$G(^LEX(757.02,LEXIEN,0)),LEXH=$G(^LEX(757.02,LEXIEN,4,LEXHIS,0)),LEXSO=$P(LEX0,"^",2)
. . . . . S LEXSR=$P(LEX0,"^",3),LEXST=$P(LEXH,"^",2),LEXEF=$P(LEXH,"^",1)
. . . . . S LEXOK=1 S:(LEXSO_" ")'=LEXSTR LEXOK=0 S:LEXSR'=31 LEXOK=0
. . . . . S:LEXEFF'=LEXEF LEXOK=0 S:LEXSTA'=LEXST LEXOK=0 I 'LEXOK D
. . . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS)
. . . . . . S:$L(LEXSO) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
. . . . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Error: ",LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEX0,LEXHI,LEXSO,LEXSR
. S LEX0=$G(^LEX(LEXFI,LEXIEN,0)) S LEXSO=$P(LEX0,U,2) Q:'$L(LEXSO) S LEXSR=$P(LEX0,U,3) Q:+LEXSR'=31
. S LEXHI=0 F S LEXHI=$O(^LEX(757.02,LEXIEN,4,LEXHI)) Q:+LEXHI'>0 D
. . N LEXH,LEXEF,LEXST S LEXH=$G(^LEX(LEXFI,LEXIEN,4,LEXHI,0))
. . S LEXEF=$P(LEXH,U,1) Q:'$L(LEXEF)
. . S LEXST=$P(LEXH,U,2) Q:'$L(LEXST)
. . S DA(1)=LEXIEN,DA=LEXHI
. . I '$D(^LEX(757.02,LEXIDX,(LEXSO_" "),LEXEF,LEXST,DA(1),DA)) D
. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA(1),", ",DA
. . . S:$L(LEXSO)&($L(LEXEF))&($L(LEXST))&(+($G(DA(1)))>0)&(+($G(DA))>0) ^LEX(757.02,LEXIDX,(LEXSO_" "),LEXEF,LEXST,DA(1),DA)=""
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
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[HLEXRXD4 10848 printed Sep 23, 2025@19:45:11 Page 2
LEXRXD4 ;ISL/KER - Re-Index 757.02 AVA/CODE/ADX/APR ;12/19/2014
+1 ;;2.0;LEXICON UTILITY;**81,80,86**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^LEX( SACC 1.3
+5 ; ^LEX(757.02, SACC 1.3
+6 ; ^LEX(757, SACC 1.3
+7 ; ^LEX(757.03, SACC 1.3
+8 ;
+9 ; External References
+10 ; $$FMDIFF^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
R75702 ; Repair file 757.02
+1 DO RAVA
DO RCODE
DO RI10
QUIT
RAVA ; Index ^LEX(757.02,"AVA",CODE,EXP,SAB,IEN)
+1 NEW DA,DIK,LEXBEG,LEXCK,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""AVA""")
if LEXTC=1
QUIT
+4 SET LEXCK=$$SABS^LEXRXXM
SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
+5 SET LEXSTR=""
SET LEXFI=757.02
SET LEXIDX="AVA"
SET LEXIDXT="^LEX(757.02,""AVA"",CODE,EXP,SAB,IEN)"
+6 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+7 NEW LEXEXP
SET LEXEXP=0
FOR
SET LEXEXP=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP))
if +LEXEXP'>0
QUIT
Begin DoDot:2
+8 NEW LEXSAB
SET LEXSAB=""
FOR
SET LEXSAB=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB))
if '$LENGTH(LEXSAB)
QUIT
Begin DoDot:3
+9 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:4
+10 NEW LEXOK,LEXSO,LEXEX,LEXSR,LEXSB
SET LEXNDS=LEXNDS+1
+11 SET LEXEX=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",1)
SET LEXSO=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",2)
+12 SET LEXSR=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",3)
SET LEXSB=$EXTRACT($PIECE($GET(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
+13 IF $LENGTH(LEXSAB)'=3!(LEXCK'[LEXSAB)
Begin DoDot:5
+14 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
+15 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid SAB ",LEXSAB,?58," ",LEXIEN,!,?30,LEXCK
End DoDot:5
QUIT
+16 IF '$LENGTH(LEXEX)!('$LENGTH(LEXSO))!($LENGTH(LEXSB)'=3)
Begin DoDot:5
+17 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
+18 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:5
QUIT
+19 SET LEXOK=1
if LEXSTR='(LEXSO_" ")
SET LEXOK=0
if LEXEXP'=LEXEX
SET LEXOK=0
if LEXSAB'=LEXSB
SET LEXOK=0
IF 'LEXOK
Begin DoDot:5
+20 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
+21 if $LENGTH(LEXSO)&($LENGTH(LEXEX))&($LENGTH(LEXSB))&(LEXCK[("^"_LEXSB_"^"))
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXEX,LEXSB,LEXIEN)=""
+22 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+24 NEW DA,DIK,LEXEX,LEXSO,LEXSR,LEXSB
SET DA=LEXIEN
SET LEXSR=$PIECE($GET(^LEX(LEXFI,+DA,0)),"^",3)
SET LEXSO=$PIECE($GET(^LEX(LEXFI,DA,0)),U,2)
+25 SET LEXEX=$PIECE($GET(^LEX(LEXFI,DA,0)),U,1)
SET LEXSB=$EXTRACT($PIECE($GET(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
if $LENGTH(LEXSB)'=3
QUIT
if '$LENGTH(LEXSO)
QUIT
if +LEXEX'>0
QUIT
+26 IF LEXCK[("^"_LEXSB_"^")
IF '$DATA(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA))
Begin DoDot:2
+27 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,"/",LEXSB,?58," ",DA
End DoDot:2
+28 IF LEXCK'[("^"_LEXSB_"^")
IF $DATA(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA))
Begin DoDot:2
+29 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Invalid (deleted) ",LEXSO,"/",LEXSB,?58," ",DA
+30 if '$DATA(LEXTEST)
KILL ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
End DoDot:2
+31 if LEXCK[("^"_LEXSB_"^")&($LENGTH(LEXSO))&($LENGTH(LEXEX))
SET ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)=""
+32 if LEXCK'[("^"_LEXSB_"^")&('$DATA(LEXTEST))&($LENGTH(LEXSO))&($LENGTH(LEXEX))
KILL ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
End DoDot:1
+33 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+34 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+35 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+36 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+37 QUIT
RCODE ; Index ^LEX(757.02,"CODE",CODE,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""CODE""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.02
SET LEXIDX="CODE"
SET LEXIDXT="^LEX(757.02,""CODE"",CODE,IEN)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:2
+7 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXSO
SET LEXSO=$PIECE($GET(^LEX(757.02,LEXIEN,0)),U,2)
+8 SET LEXOK=0
if (LEXSO_" ")=LEXSTR
SET LEXOK=1
IF 'LEXOK
Begin DoDot:3
+9 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN)
if $LENGTH(LEXSO)
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
+10 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,?58," ",LEXIEN
End DoDot:3
End DoDot:2
End DoDot:1
+11 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+12 NEW DA,DIK,LEXSO
SET DA=LEXIEN
SET LEXSO=$PIECE($GET(^LEX(LEXFI,DA,0)),U,2)
if '$LENGTH(LEXSO)
QUIT
+13 IF '$DATA(^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA))
Begin DoDot:2
+14 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA
End DoDot:2
+15 if $LENGTH(LEXSO)
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),DA)=""
End DoDot:1
+16 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+17 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+18 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+19 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+20 QUIT
RI10 ; Index ^LEX(757.02 "ADX" amd "APR"
+1 if $DATA(^LEX(757.02,"ADX"))
DO RADX
if $DATA(^LEX(757.02,"APR"))
DO RAPR
+2 QUIT
RADX ; Index ^LEX(757.02,"ADX",CODE,DATE,STA,IEN,HIS)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""ADX""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.02
SET LEXIDX="ADX"
SET LEXIDXT="^LEX(757.02,""ADX"",CODE,DT,STA,IEN,HIS)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXEFF
SET LEXEFF=0
FOR
SET LEXEFF=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF))
if +LEXEFF'>0
QUIT
Begin DoDot:2
+7 NEW LEXSTA
SET LEXSTA=""
FOR
SET LEXSTA=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA))
if '$LENGTH(LEXSTA)
QUIT
Begin DoDot:3
+8 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:4
+9 NEW LEXHIS
SET LEXHIS=0
FOR
SET LEXHIS=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS))
if +LEXHIS'>0
QUIT
Begin DoDot:5
+10 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEX0,LEXH,LEXSO,LEXSR,LEXST,LEXEF
+11 SET LEX0=$GET(^LEX(757.02,LEXIEN,0))
SET LEXH=$GET(^LEX(757.02,LEXIEN,4,LEXHIS,0))
SET LEXSO=$PIECE(LEX0,"^",2)
+12 SET LEXSR=$PIECE(LEX0,"^",3)
SET LEXST=$PIECE(LEXH,"^",2)
SET LEXEF=$PIECE(LEXH,"^",1)
+13 SET LEXOK=1
if (LEXSO_" ")'=LEXSTR
SET LEXOK=0
if LEXSR'=30
SET LEXOK=0
+14 if LEXEFF'=LEXEF
SET LEXOK=0
if LEXSTA'=LEXST
SET LEXOK=0
IF 'LEXOK
Begin DoDot:6
+15 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS)
+16 if $LENGTH(LEXSO)
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
+17 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Error: ",LEXSTR,?58," ",LEXIEN
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+19 NEW DA,DIK,LEX0,LEXHI,LEXSO,LEXSR
+20 SET LEX0=$GET(^LEX(LEXFI,LEXIEN,0))
SET LEXSO=$PIECE(LEX0,U,2)
if '$LENGTH(LEXSO)
QUIT
SET LEXSR=$PIECE(LEX0,U,3)
if +LEXSR'=30
QUIT
+21 SET LEXHI=0
FOR
SET LEXHI=$ORDER(^LEX(757.02,LEXIEN,4,LEXHI))
if +LEXHI'>0
QUIT
Begin DoDot:2
+22 NEW LEXH,LEXEF,LEXST
SET LEXH=$GET(^LEX(LEXFI,LEXIEN,4,LEXHI,0))
+23 SET LEXEF=$PIECE(LEXH,U,1)
if '$LENGTH(LEXEF)
QUIT
+24 SET LEXST=$PIECE(LEXH,U,2)
if '$LENGTH(LEXST)
QUIT
+25 SET DA(1)=LEXIEN
SET DA=LEXHI
+26 IF '$DATA(^LEX(757.02,"ADX",(LEXSO_" "),LEXEF,LEXST,DA(1),DA))
Begin DoDot:3
+27 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA(1),", ",DA
+28 if $LENGTH(LEXSO)&($LENGTH(LEXEF))&($LENGTH(LEXST))&(+($GET(DA(1)))>0)&(+($GET(DA))>0)
SET ^LEX(757.02,"ADX",(LEXSO_" "),LEXEF,LEXST,DA(1),DA)=""
End DoDot:3
End DoDot:2
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 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
RAPR ; Index ^LEX(757.02,"APR",CODE,DATE,STA,IEN,HIS)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.02"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.02 ""APR""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.02
SET LEXIDX="APR"
SET LEXIDXT="^LEX(757.02,""APR"",CODE,DT,STA,IEN,HIS)"
+5 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXEFF
SET LEXEFF=0
FOR
SET LEXEFF=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF))
if +LEXEFF'>0
QUIT
Begin DoDot:2
+7 NEW LEXSTA
SET LEXSTA=""
FOR
SET LEXSTA=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA))
if '$LENGTH(LEXSTA)
QUIT
Begin DoDot:3
+8 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:4
+9 NEW LEXHIS
SET LEXHIS=0
FOR
SET LEXHIS=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS))
if +LEXHIS'>0
QUIT
Begin DoDot:5
+10 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEX0,LEXH,LEXSO,LEXSR,LEXST,LEXEF
+11 SET LEX0=$GET(^LEX(757.02,LEXIEN,0))
SET LEXH=$GET(^LEX(757.02,LEXIEN,4,LEXHIS,0))
SET LEXSO=$PIECE(LEX0,"^",2)
+12 SET LEXSR=$PIECE(LEX0,"^",3)
SET LEXST=$PIECE(LEXH,"^",2)
SET LEXEF=$PIECE(LEXH,"^",1)
+13 SET LEXOK=1
if (LEXSO_" ")'=LEXSTR
SET LEXOK=0
if LEXSR'=31
SET LEXOK=0
+14 if LEXEFF'=LEXEF
SET LEXOK=0
if LEXSTA'=LEXST
SET LEXOK=0
IF 'LEXOK
Begin DoDot:6
+15 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEFF,LEXSTA,LEXIEN,LEXHIS)
+16 if $LENGTH(LEXSO)
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXIEN)=""
+17 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Error: ",LEXSTR,?58," ",LEXIEN
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+19 NEW DA,DIK,LEX0,LEXHI,LEXSO,LEXSR
+20 SET LEX0=$GET(^LEX(LEXFI,LEXIEN,0))
SET LEXSO=$PIECE(LEX0,U,2)
if '$LENGTH(LEXSO)
QUIT
SET LEXSR=$PIECE(LEX0,U,3)
if +LEXSR'=31
QUIT
+21 SET LEXHI=0
FOR
SET LEXHI=$ORDER(^LEX(757.02,LEXIEN,4,LEXHI))
if +LEXHI'>0
QUIT
Begin DoDot:2
+22 NEW LEXH,LEXEF,LEXST
SET LEXH=$GET(^LEX(LEXFI,LEXIEN,4,LEXHI,0))
+23 SET LEXEF=$PIECE(LEXH,U,1)
if '$LENGTH(LEXEF)
QUIT
+24 SET LEXST=$PIECE(LEXH,U,2)
if '$LENGTH(LEXST)
QUIT
+25 SET DA(1)=LEXIEN
SET DA=LEXHI
+26 IF '$DATA(^LEX(757.02,LEXIDX,(LEXSO_" "),LEXEF,LEXST,DA(1),DA))
Begin DoDot:3
+27 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,?58," ",DA(1),", ",DA
+28 if $LENGTH(LEXSO)&($LENGTH(LEXEF))&($LENGTH(LEXST))&(+($GET(DA(1)))>0)&(+($GET(DA))>0)
SET ^LEX(757.02,LEXIDX,(LEXSO_" "),LEXEF,LEXST,DA(1),DA)=""
End DoDot:3
End DoDot:2
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 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
