- 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 Feb 18, 2025@23:35:23 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