LEXRXE ;ISL/KER - Re-Index 757.1 B/AMCC/AMCT/ASTT ;05/23/2017
;;2.0;LEXICON UTILITY;**81,80,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^LEX(757) SACC 1.3
; ^LEX(757.1) SACC 1.3
; ^LEX(757.11) SACC 1.3
; ^LEX(757.12) SACC 1.3
; ^TMP("LEXRX",$J) SACC 2.3.2.5.1
;
; External References
; FILE^DID ICR 2052
; IXALL^DIK ICR 10013
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
;
; Local Variables NEWed or KILLed Elsewhere
; LEXNAM Task name NEWed/KILLed by LEXRXXT
; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
; LEXTEST Test variable NEWed/KILLed by Developer
; ZTQUEUED Task flag NEWed/KILLed by Taskman
;
Q
EN ; Main Entry Point
R7571 ; Repair file 757.1
D RB,RAMCC,RAMCT,RASTT,SET
Q
RB ; Index ^LEX(757.1,"B",MC,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
S LEXFI="757.1"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""B""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI="757.1",LEXIDX="B",LEXIDXT="^LEX(757.1,""B"",MC,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,LEXMC S LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),"^",1)
. . S LEXOK=0 S:LEXMC=LEXSTR LEXOK=1 I 'LEXOK D
. . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXIEN) S:$L(LEXMC) ^LEX(LEXFI,LEXIDX,LEXMC,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,LEXMC S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),"^",1) Q:+LEXMC'>0 Q:'$D(^LEX(757,+LEXMC,0))
. I '$D(^LEX(LEXFI,LEXIDX,LEXMC,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,?58," ",DA
. S:$L(LEXMC) ^LEX(LEXFI,LEXIDX,LEXMC,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
RAMCC ; Index ^LEX(757.1,"AMCC",MC,SC,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.1"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""AMCC""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR=0,LEXFI=757.1,LEXIDX="AMCC",LEXIDXT="^LEX(757.1,""AMCC"",MC,SC,IEN) "
S LEXMAJ=0 F S LEXMAJ=$O(^LEX(LEXFI,LEXIDX,LEXMAJ)) Q:+LEXMAJ'>0 D
. N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR)) Q:'$L(LEXSTR) D
. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC,LEXSC S LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,1)
. . . S LEXSC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,2),LEXSC=$P($G(^LEX(757.11,+LEXSC,0)),U,1)
. . . S LEXOK=1 S:LEXMC'=LEXMAJ LEXOK=0 S:LEXSTR'=LEXSC LEXOK=0 I 'LEXOK D
. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)
. . . . S:$L(LEXSC)&(+LEXMC>0) ^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,LEXIEN)=""
. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXMC,"/",LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,LEXMC,LEXSC,DIK S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),U,1) Q:+LEXMC'>0
. S LEXSC=$P($G(^LEX(LEXFI,DA,0)),U,2),LEXSC=$E($P($G(^LEX(757.11,+LEXSC,0)),U,1),1,3) Q:$L(LEXSC)'=3
. I '$D(^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,"/",LEXSC,?58," ",DA
. S:$L(LEXMC)&($L(LEXSC)) ^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,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
RAMCT ; Index ^LEX(757.1,"AMCT",MC,ST,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.1"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""AMCT""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR=0,LEXFI=757.1,LEXIDX="AMCT",LEXIDXT="^LEX(757.1,""AMCT"",MC,ST,IEN)"
S LEXMAJ=0 F S LEXMAJ=$O(^LEX(LEXFI,LEXIDX,LEXMAJ)) Q:+LEXMAJ'>0 D
. N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR)) Q:'$L(LEXSTR) D
. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)) Q:+LEXIEN'>0 D
. . . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC,LEXST S LEXOK=1,LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,1)
. . . S LEXST=$P($G(^LEX(LEXFI,LEXIEN,0)),U,3) S:LEXMC'=LEXMAJ LEXOK=0 S:LEXSTR'=LEXST LEXOK=0 I 'LEXOK D
. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)
. . . . S:$L(LEXST)&(+LEXMC>0) ^LEX(LEXFI,LEXIDX,LEXMC,LEXST,LEXIEN)=""
. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXMC,"/",LEXSTR,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXMC,LEXTY S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),U,1) Q:+LEXMC'>0
. S LEXTY=$P($G(^LEX(LEXFI,DA,0)),U,3) Q:'$L(LEXTY)
. I '$D(^LEX(LEXFI,LEXIDX,LEXMC,LEXTY,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,"/",LEXTY,?58," ",DA
. S:$L(LEXMC)&($L(LEXTY)) ^LEX(LEXFI,LEXIDX,LEXMC,LEXTY,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
RASTT ; Index ^LEX(757.1,"ASTT",ST,MC,IEN)
N DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
S LEXFI="757.1"
N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.1 ""ASTT""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR=0,LEXFI=757.1,LEXIDX="ASTT",LEXIDXT="^LEX(757.1,""ASTT"",ST,MC,IEN)"
N LEXSTR S LEXSTR="" F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXMAJ S LEXMAJ=0 F S LEXMAJ=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ)) Q:+LEXMAJ'>0 D
. . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ,LEXIEN)) Q:+LEXIEN'>0 D
. . . S LEXNDS=LEXNDS+1 N LEXOK,LEXMC,LEXST S LEXOK=1,LEXMC=$P($G(^LEX(LEXFI,LEXIEN,0)),U,1)
. . . S LEXST=$P($G(^LEX(LEXFI,LEXIEN,0)),U,3) S:LEXMC'=LEXMAJ LEXOK=0 S:LEXSTR'=LEXST LEXOK=0 I 'LEXOK D
. . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ,LEXIEN)
. . . . S:$L(LEXST)&(+LEXMC>0) ^LEX(LEXFI,LEXIDX,LEXST,LEXMC,LEXIEN)=""
. . . . I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,"/",LEXMC,?58," ",LEXIEN
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXMC,LEXTY S DA=LEXIEN,LEXMC=$P($G(^LEX(LEXFI,DA,0)),U,1) Q:+LEXMC'>0
. S LEXTY=$P($G(^LEX(LEXFI,DA,0)),U,3) Q:'$L(LEXTY)
. I '$D(^LEX(LEXFI,LEXIDX,LEXTY,LEXMC,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTY,"/",LEXMC,?58," ",DA
. S:$L(LEXTY)&($L(LEXMC)) ^LEX(LEXFI,LEXIDX,LEXTY,LEXMC,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
SET ; Re-Index Semantic Map file 757.1 (Set logic only)
Q:'$D(LEXSET) N LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
N LEXOUT,LEXMSG S LEXFI=757.1
D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX"
S LEXPRE=$G(^TMP("LEXRX",$J,"T",1,"ELAP"))
S LEXBEG=$$NOW^XLFDT,LEXNM=$$FN^LEXRXXM(LEXFI)
S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI))
Q:LEXTC=1 I '$D(ZTQUEUED) W !,?8,"Re-Indexing",!
N LEXIEN,LEXP3,LEXP4 S (LEXP3,LEXP4,LEXIEN)=0
F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 S LEXP3=LEXIEN,LEXP4=LEXP4+1
S:LEXP3>0 $P(^LEX(LEXFI,0),"^",3)=LEXP3 S:LEXP4>0 $P(^LEX(LEXFI,0),"^",4)=LEXP4
I +($G(LEXP4))>0 D
. N ZTQUEUED,DIK S ZTQUEUED=$G(ZTQUEUED) S DIK="^LEX("_LEXFI_"," D IXALL^DIK
Q:$D(LEXQ) 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,"ALLIX",,,"Re-Index",LEXELP)
S LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
S ^TMP("LEXRX",$J,"T",1,"ELAP")=LEXELP
Q
CLR ; Clear
K LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXE 9210 printed Dec 13, 2024@02:09:20 Page 2
LEXRXE ;ISL/KER - Re-Index 757.1 B/AMCC/AMCT/ASTT ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**81,80,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^LEX(757) SACC 1.3
+5 ; ^LEX(757.1) SACC 1.3
+6 ; ^LEX(757.11) SACC 1.3
+7 ; ^LEX(757.12) SACC 1.3
+8 ; ^TMP("LEXRX",$J) SACC 2.3.2.5.1
+9 ;
+10 ; External References
+11 ; FILE^DID ICR 2052
+12 ; IXALL^DIK ICR 10013
+13 ; $$FMDIFF^XLFDT ICR 10103
+14 ; $$NOW^XLFDT ICR 10103
+15 ;
+16 ; Local Variables NEWed or KILLed Elsewhere
+17 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+18 ; LEXSET Re-Index flag NEWed/KILLed by LEXRXXT
+19 ; LEXQ Quiet flat NEWed/KILLed by LEXRXXT2
+20 ; LEXTEST Test variable NEWed/KILLed by Developer
+21 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+22 ;
+23 QUIT
EN ; Main Entry Point
R7571 ; Repair file 757.1
+1 DO RB
DO RAMCC
DO RAMCT
DO RASTT
DO SET
+2 QUIT
RB ; Index ^LEX(757.1,"B",MC,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMC,LEXNDS,LEXOK,LEXSTR
+2 SET LEXFI="757.1"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.1 ""B""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI="757.1"
SET LEXIDX="B"
SET LEXIDXT="^LEX(757.1,""B"",MC,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,LEXMC
SET LEXMC=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),"^",1)
+8 SET LEXOK=0
if LEXMC=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(LEXMC)
SET ^LEX(LEXFI,LEXIDX,LEXMC,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,LEXMC
SET DA=LEXIEN
SET LEXMC=$PIECE($GET(^LEX(LEXFI,DA,0)),"^",1)
if +LEXMC'>0
QUIT
if '$DATA(^LEX(757,+LEXMC,0))
QUIT
+13 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXMC,DA))
Begin DoDot:2
+14 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,?58," ",DA
End DoDot:2
+15 if $LENGTH(LEXMC)
SET ^LEX(LEXFI,LEXIDX,LEXMC,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
RAMCC ; Index ^LEX(757.1,"AMCC",MC,SC,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.1"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.1 ""AMCC""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=0
SET LEXFI=757.1
SET LEXIDX="AMCC"
SET LEXIDXT="^LEX(757.1,""AMCC"",MC,SC,IEN) "
+5 SET LEXMAJ=0
FOR
SET LEXMAJ=$ORDER(^LEX(LEXFI,LEXIDX,LEXMAJ))
if +LEXMAJ'>0
QUIT
Begin DoDot:1
+6 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:2
+7 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:3
+8 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXMC,LEXSC
SET LEXMC=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,1)
+9 SET LEXSC=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,2)
SET LEXSC=$PIECE($GET(^LEX(757.11,+LEXSC,0)),U,1)
+10 SET LEXOK=1
if LEXMC'=LEXMAJ
SET LEXOK=0
if LEXSTR'=LEXSC
SET LEXOK=0
IF 'LEXOK
Begin DoDot:4
+11 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)
+12 if $LENGTH(LEXSC)&(+LEXMC>0)
SET ^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,LEXIEN)=""
+13 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXMC,"/",LEXSTR,?58," ",LEXIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+15 NEW DA,LEXMC,LEXSC,DIK
SET DA=LEXIEN
SET LEXMC=$PIECE($GET(^LEX(LEXFI,DA,0)),U,1)
if +LEXMC'>0
QUIT
+16 SET LEXSC=$PIECE($GET(^LEX(LEXFI,DA,0)),U,2)
SET LEXSC=$EXTRACT($PIECE($GET(^LEX(757.11,+LEXSC,0)),U,1),1,3)
if $LENGTH(LEXSC)'=3
QUIT
+17 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,DA))
Begin DoDot:2
+18 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,"/",LEXSC,?58," ",DA
End DoDot:2
+19 if $LENGTH(LEXMC)&($LENGTH(LEXSC))
SET ^LEX(LEXFI,LEXIDX,LEXMC,LEXSC,DA)=""
End DoDot:1
+20 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+21 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+22 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+23 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+24 QUIT
RAMCT ; Index ^LEX(757.1,"AMCT",MC,ST,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.1"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.1 ""AMCT""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=0
SET LEXFI=757.1
SET LEXIDX="AMCT"
SET LEXIDXT="^LEX(757.1,""AMCT"",MC,ST,IEN)"
+5 SET LEXMAJ=0
FOR
SET LEXMAJ=$ORDER(^LEX(LEXFI,LEXIDX,LEXMAJ))
if +LEXMAJ'>0
QUIT
Begin DoDot:1
+6 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:2
+7 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:3
+8 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXMC,LEXST
SET LEXOK=1
SET LEXMC=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,1)
+9 SET LEXST=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,3)
if LEXMC'=LEXMAJ
SET LEXOK=0
if LEXSTR'=LEXST
SET LEXOK=0
IF 'LEXOK
Begin DoDot:4
+10 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXMAJ,LEXSTR,LEXIEN)
+11 if $LENGTH(LEXST)&(+LEXMC>0)
SET ^LEX(LEXFI,LEXIDX,LEXMC,LEXST,LEXIEN)=""
+12 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXMC,"/",LEXSTR,?58," ",LEXIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+14 NEW DA,DIK,LEXMC,LEXTY
SET DA=LEXIEN
SET LEXMC=$PIECE($GET(^LEX(LEXFI,DA,0)),U,1)
if +LEXMC'>0
QUIT
+15 SET LEXTY=$PIECE($GET(^LEX(LEXFI,DA,0)),U,3)
if '$LENGTH(LEXTY)
QUIT
+16 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXMC,LEXTY,DA))
Begin DoDot:2
+17 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXMC,"/",LEXTY,?58," ",DA
End DoDot:2
+18 if $LENGTH(LEXMC)&($LENGTH(LEXTY))
SET ^LEX(LEXFI,LEXIDX,LEXMC,LEXTY,DA)=""
End DoDot:1
+19 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+20 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+21 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+22 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+23 QUIT
RASTT ; Index ^LEX(757.1,"ASTT",ST,MC,IEN)
+1 NEW DA,DIK,LEXBEG,LEXDIF,LEXELP,LEXEND,LEXERR,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXMAJ,LEXNDS,LEXOK,LEXSO,LEXSTR
+2 SET LEXFI="757.1"
+3 NEW LEXTC
SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.1 ""ASTT""")
if LEXTC=1
QUIT
+4 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=0
SET LEXFI=757.1
SET LEXIDX="ASTT"
SET LEXIDXT="^LEX(757.1,""ASTT"",ST,MC,IEN)"
+5 NEW LEXSTR
SET LEXSTR=""
FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+6 NEW LEXMAJ
SET LEXMAJ=0
FOR
SET LEXMAJ=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ))
if +LEXMAJ'>0
QUIT
Begin DoDot:2
+7 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:3
+8 SET LEXNDS=LEXNDS+1
NEW LEXOK,LEXMC,LEXST
SET LEXOK=1
SET LEXMC=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,1)
+9 SET LEXST=$PIECE($GET(^LEX(LEXFI,LEXIEN,0)),U,3)
if LEXMC'=LEXMAJ
SET LEXOK=0
if LEXSTR'=LEXST
SET LEXOK=0
IF 'LEXOK
Begin DoDot:4
+10 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXMAJ,LEXIEN)
+11 if $LENGTH(LEXST)&(+LEXMC>0)
SET ^LEX(LEXFI,LEXIDX,LEXST,LEXMC,LEXIEN)=""
+12 IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,LEXSTR,"/",LEXMC,?58," ",LEXIEN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+14 NEW DA,DIK,LEXMC,LEXTY
SET DA=LEXIEN
SET LEXMC=$PIECE($GET(^LEX(LEXFI,DA,0)),U,1)
if +LEXMC'>0
QUIT
+15 SET LEXTY=$PIECE($GET(^LEX(LEXFI,DA,0)),U,3)
if '$LENGTH(LEXTY)
QUIT
+16 IF '$DATA(^LEX(LEXFI,LEXIDX,LEXTY,LEXMC,DA))
Begin DoDot:2
+17 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXTY,"/",LEXMC,?58," ",DA
End DoDot:2
+18 if $LENGTH(LEXTY)&($LENGTH(LEXMC))
SET ^LEX(LEXFI,LEXIDX,LEXTY,LEXMC,DA)=""
End DoDot:1
+19 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,LEXFI,?19,LEXIDX,?30,LEXIDXT
+20 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+21 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+22 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
+23 QUIT
+24 ;
+25 ; Miscellaneous
SET ; Re-Index Semantic Map file 757.1 (Set logic only)
+1 if '$DATA(LEXSET)
QUIT
NEW LEXTC,LEXPRE,LEXBEG,LEXEND,LEXELP,LEXNM,LEXFI,LEXRT
+2 NEW LEXOUT,LEXMSG
SET LEXFI=757.1
+3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
+4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
if LEXRT'["^LEX"
QUIT
+5 SET LEXPRE=$GET(^TMP("LEXRX",$JOB,"T",1,"ELAP"))
+6 SET LEXBEG=$$NOW^XLFDT
SET LEXNM=$$FN^LEXRXXM(LEXFI)
+7 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
+8 if LEXTC=1
QUIT
IF '$DATA(ZTQUEUED)
WRITE !,?8,"Re-Indexing",!
+9 NEW LEXIEN,LEXP3,LEXP4
SET (LEXP3,LEXP4,LEXIEN)=0
+10 FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
SET LEXP3=LEXIEN
SET LEXP4=LEXP4+1
+11 if LEXP3>0
SET $PIECE(^LEX(LEXFI,0),"^",3)=LEXP3
if LEXP4>0
SET $PIECE(^LEX(LEXFI,0),"^",4)=LEXP4
+12 IF +($GET(LEXP4))>0
Begin DoDot:1
+13 NEW ZTQUEUED,DIK
SET ZTQUEUED=$GET(ZTQUEUED)
SET DIK="^LEX("_LEXFI_","
DO IXALL^DIK
End DoDot:1
+14 if $DATA(LEXQ)
QUIT
SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+15 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+16 DO REP^LEXRXXS(LEXFI,LEXFI,"ALLIX",,,"Re-Index",LEXELP)
+17 SET LEXELP=$$ADDT^LEXRXXM(LEXELP,LEXPRE)
+18 SET ^TMP("LEXRX",$JOB,"T",1,"ELAP")=LEXELP
+19 QUIT
CLR ; Clear
+1 KILL LEXNAM,LEXSET,LEXTEST,ZTQUEUED,LEXQ
+2 QUIT
