- LEXRXS ;ISL/KER - Re-Index - Small Files ;05/23/2017
- ;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
- ;
- ; Global Variables
- ; ^LEX( SACC 1.3
- ; ^LEXT( SACC 1.3
- ; ^LEX(757.011, SACC 1.3
- ; ^LEX(757.014, SACC 1.3
- ; ^LEX(757.03, SACC 1.3
- ; ^LEX(757.04, SACC 1.3
- ; ^LEX(757.05, SACC 1.3
- ; ^LEX(757.06, SACC 1.3
- ; ^LEX(757.11, SACC 1.3
- ; ^LEX(757.12, SACC 1.3
- ; ^LEX(757.01, SACC 1.3
- ; ^LEXT(757.2, SACC 1.3
- ; ^TMP("LEXRX") SACC 2.3.2.5.1
- ;
- ; External References
- ; FILE^DID ICR 2052
- ; IX1^DIK ICR 10013
- ; $$FMDIFF^XLFDT ICR 10103
- ; $$NOW^XLFDT ICR 10103
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEXLONG Format flag NEWed/KILLed by Developer
- ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- ;
- EN ; Main Entry Point
- D R757011,R757014,R75703,R75704,R75705,R75706,R75707,R757071,R75711,R75712,EN^LEXRXS2
- Q
- R757011 ; Expression Type file 757.011
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
- S LEXFI="757.011" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="B and C",LEXNM="Expression Type" I $D(LEXLONG) S LEXIX(1)="^LEX(757.011,""B"",TYPE,IEN)",LEXIX(2)="^LEX(757.011,""C"",UPPER,IEN)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
- Q
- R757014 ; Expression Form file 757.014
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
- S LEXFI="757.014" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="B",LEXNM="Expression Form" I $D(LEXLONG) S LEXIX(1)="^LEX(757.014,""B"",MNEM,IEN)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
- Q
- R75703 ; Coding System file 757.03
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.03" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="B, ASAB, C and D",LEXNM="Coding Systems" I $D(LEXLONG) D
- . S LEXIX(1)="^LEX(757.03,""B"",SAB,IEN)",LEXIX(2)="^LEX(757.03,""ASAB"",SAB,IEN)"
- . S LEXIX(3)="^LEX(757.03,""C"",NOM,IEN)",LEXIX(4)="^LEX(757.03,""D"",HL7,IEN)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
- Q
- R75704 ; Excluded Word file 757.04
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.04" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="B, AB, ACTION",LEXNM="Excluded Words" I $D(LEXLONG) D
- . S LEXIX(1)="^LEX(757.04,""B"",WORD,IEN)",LEXIX(2)="^LEX(757.04,""AB"",WORD,IEN)",LEXIX(3)="^LEX(757.04,""ACTION"",WORD,EXC,IEN)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(LEXFI,LEXNM,"00:00:03",.LEXIX)
- Q
- R75705 ; Replacement Word file 757.05
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXIEN,LEXP3,LEXP4
- S LEXFI="757.05" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT N DA,DIK,LEXEX,LEXEXP,LEXIEN,LEXWRD H 1
- D RM(LEXFI) S (LEXP3,LEXP4,LEXIEN)=0 F S LEXIEN=$O(^LEX(757.05,LEXIEN)) Q:+LEXIEN'>0 D
- . N DA,DIK S LEXP3=LEXIEN,LEXP4=LEXP4+1
- . K ^LEX(757.05,LEXIEN,1,"B") S DA=LEXIEN,DIK="^LEX(757.05," D IX1^DIK
- S $P(^LEX(757.05,0),"^",3)=LEXP3,$P(^LEX(757.05,0),"^",4)=LEXP4
- S LEXIX(1)="B, AB, AEXP, ALINK, AWRD, and C",LEXNM="Replacement Words" I $D(LEXLONG) D
- . S LEXIX(1)="^LEX(757.05,""B"",WORD,IEN)",LEXIX(2)="^LEX(757.05,""AB"",WORD,IEN)",LEXIX(3)="^LEX(757.05,""C"",REP,IEN)"
- . S LEXIX(4)="^LEX(757.05,""AEXP"",EXP,IEN)",LEXIX(5)="^LEX(757.05,""ALINK"",WORD,EXP)",LEXIX(6)="^LEX(757.01,""AWRD"",WORD,EXP,""LINKED"")"
- . S LEXIX(7)="^LEX(757.05,IEN,1,""B"",EXP,IEN2)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(757.05,LEXNM,LEXELP,.LEXIX)
- Q
- R75706 ; Unresolved Narrative file 757.06
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.06" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT K ^LEX(757.06) S ^LEX(757.06,0)="UNRESOLVED NARRATIVES^757.06^^0"
- S LEXIX(1)="B",LEXNM="Unresolved Narratives" I $D(LEXLONG) S LEXIX(1)="^LEX(757.06,""B"",NAR,IEN)"
- D REX^LEXRXXS(757.06,LEXNM,"00:00:01",.LEXIX)
- Q
- R75711 ; Semantic Class file 757.11
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.11" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="B",LEXNM="Semantic Class" I $D(LEXLONG) S LEXIX(1)="^LEX(757.11,""B"",SC,IEN)",LEXIX(2)="^LEX(757.11,IEN,2,""B"",SYS,IEN2)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(757.11,LEXNM,"00:00:02",.LEXIX)
- Q
- R75712 ; Semantic Type file 757.12
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.12" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="B, C, D and E",LEXNM="Semantic Type" I $D(LEXLONG) D
- . S LEXIX(1)="^LEX(757.12,""B"",TUI,IEN)",LEXIX(2)="^LEX(757.12,""D"",DT,IEN)",LEXIX(3)="^LEX(757.12,""E"",UDT,IEN)",LEXIX(4)="^LEX(757.12,""C"",SC,IEN)",LEXIX(5)="^LEX(757.12,IEN,1,""B"",SYS,IEN2)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(757.12,LEXNM,"00:00:02",.LEXIX)
- Q
- R75707 ; Tokens file 757.07
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.07" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="ABBR, AED, B and D",LEXNM="Tokens" I $D(LEXLONG) D
- . S LEXIX(1)="^LEX(757.07,""ABBR"",TOKEN,IEN2,IEN1)=Abbreviation Text"
- . S LEXIX(2)="^LEX(757.07,""AED"",TOKEN,TEXT,IEN2,IEN1)"
- . S LEXIX(3)="^LEX(757.07,""B"",TOKEN,IEN2)"
- . S LEXIX(4)="^LEX(757.07,""D"",WORD,IEN2,IEN1)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(757.07,LEXNM,"00:00:02",.LEXIX)
- Q
- R757071 ; Supplemental Words file 757.071
- N LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- S LEXFI="757.071" W:'$D(ZTQUEUED) !,?8,"Re-Indexing file #",LEXFI
- N LEXTC S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,("Re-Indexing File #"_LEXFI)) Q:LEXTC=1
- S LEXBEG=$$NOW^XLFDT D RM(LEXFI),RX(LEXFI)
- S LEXIX(1)="AD and B",LEXNM="Supplemental Words" I $D(LEXLONG) D
- . S LEXIX(1)="^LEX(757.071,""AD"",TEXT,IEN)"
- . S LEXIX(2)="^LEX(757.071,""B"",WORD,IEN)"
- S LEXEND=$$NOW^XLFDT,LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- S:$E(LEXELP,1)=" "&($E(LEXELP,3)=":") LEXELP=$TR(LEXELP," ","0")
- D REX^LEXRXXS(757.071,LEXNM,"00:00:02",.LEXIX)
- Q
- ;
- ; Miscellaneous
- RM(X) ; Remove Main
- N LEXFI,LEXIX,LEXRT,LEXOUT,LEXMSG
- S LEXFI=+($G(X)) Q:+LEXFI'>0 Q:'$D(^LEX(LEXFI))&('$D(^LEXT(LEXFI)))
- D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX("&(LEXRT'["^LEXT(")
- S LEXIX=""" """ Q:'$L($O(@(LEXRT_LEXIX_")")))
- F S LEXIX=$O(@(LEXRT_LEXIX_")")) Q:'$L(LEXIX) D
- . S:+LEXIX'=LEXIX LEXIX=""""_LEXIX_""""
- . N LEXREF S LEXREF=LEXRT_LEXIX_")" Q:'$D(@LEXREF) K @LEXREF
- Q
- RX(X) ; Re-Index File X
- N DA,DIK,LEXFI,LEXOUT,LEXMSG,LEXRT,LEXP3,LEXP4 H 2
- S LEXFI=+($G(X)) Q:+LEXFI'>0 Q:'$D(^LEX(LEXFI))&('$D(^LEXT(LEXFI)))
- D FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- S LEXRT=$G(LEXOUT("GLOBAL NAME")) Q:LEXRT'["^LEX("&(LEXRT'["^LEXT(")
- S (LEXP3,LEXP4,DA)=0 F S DA=$O(@(LEXRT_DA_")")) Q:+DA'>0 D
- . S LEXP3=DA,LEXP4=LEXP4+1,DIK=LEXRT D IX1^DIK
- S $P(@(LEXRT_"0)"),"^",3)=LEXP3,$P(@(LEXRT_"0)"),"^",4)=LEXP4
- Q
- CLR ; Clear
- K LEXLONG,LEXNAM,ZTQUEUED
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXS 9044 printed Feb 18, 2025@23:35:29 Page 2
- LEXRXS ;ISL/KER - Re-Index - Small Files ;05/23/2017
- +1 ;;2.0;LEXICON UTILITY;**81,103**;Sep 23, 1996;Build 2
- +2 ;
- +3 ; Global Variables
- +4 ; ^LEX( SACC 1.3
- +5 ; ^LEXT( SACC 1.3
- +6 ; ^LEX(757.011, SACC 1.3
- +7 ; ^LEX(757.014, SACC 1.3
- +8 ; ^LEX(757.03, SACC 1.3
- +9 ; ^LEX(757.04, SACC 1.3
- +10 ; ^LEX(757.05, SACC 1.3
- +11 ; ^LEX(757.06, SACC 1.3
- +12 ; ^LEX(757.11, SACC 1.3
- +13 ; ^LEX(757.12, SACC 1.3
- +14 ; ^LEX(757.01, SACC 1.3
- +15 ; ^LEXT(757.2, SACC 1.3
- +16 ; ^TMP("LEXRX") SACC 2.3.2.5.1
- +17 ;
- +18 ; External References
- +19 ; FILE^DID ICR 2052
- +20 ; IX1^DIK ICR 10013
- +21 ; $$FMDIFF^XLFDT ICR 10103
- +22 ; $$NOW^XLFDT ICR 10103
- +23 ;
- +24 ; Local Variables NEWed or KILLed Elsewhere
- +25 ; LEXLONG Format flag NEWed/KILLed by Developer
- +26 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
- +27 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
- +28 ;
- EN ; Main Entry Point
- +1 DO R757011
- DO R757014
- DO R75703
- DO R75704
- DO R75705
- DO R75706
- DO R75707
- DO R757071
- DO R75711
- DO R75712
- DO EN^LEXRXS2
- +2 QUIT
- R757011 ; Expression Type file 757.011
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
- +2 SET LEXFI="757.011"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="B and C"
- SET LEXNM="Expression Type"
- IF $DATA(LEXLONG)
- SET LEXIX(1)="^LEX(757.011,""B"",TYPE,IEN)"
- SET LEXIX(2)="^LEX(757.011,""C"",UPPER,IEN)"
- +6 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +7 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +8 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
- +9 QUIT
- R757014 ; Expression Form file 757.014
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXNM
- +2 SET LEXFI="757.014"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="B"
- SET LEXNM="Expression Form"
- IF $DATA(LEXLONG)
- SET LEXIX(1)="^LEX(757.014,""B"",MNEM,IEN)"
- +6 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +7 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +8 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
- +9 QUIT
- R75703 ; Coding System file 757.03
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.03"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="B, ASAB, C and D"
- SET LEXNM="Coding Systems"
- IF $DATA(LEXLONG)
- Begin DoDot:1
- +6 SET LEXIX(1)="^LEX(757.03,""B"",SAB,IEN)"
- SET LEXIX(2)="^LEX(757.03,""ASAB"",SAB,IEN)"
- +7 SET LEXIX(3)="^LEX(757.03,""C"",NOM,IEN)"
- SET LEXIX(4)="^LEX(757.03,""D"",HL7,IEN)"
- End DoDot:1
- +8 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +9 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +10 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:01",.LEXIX)
- +11 QUIT
- R75704 ; Excluded Word file 757.04
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.04"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="B, AB, ACTION"
- SET LEXNM="Excluded Words"
- IF $DATA(LEXLONG)
- Begin DoDot:1
- +6 SET LEXIX(1)="^LEX(757.04,""B"",WORD,IEN)"
- SET LEXIX(2)="^LEX(757.04,""AB"",WORD,IEN)"
- SET LEXIX(3)="^LEX(757.04,""ACTION"",WORD,EXC,IEN)"
- End DoDot:1
- +7 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +8 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +9 DO REX^LEXRXXS(LEXFI,LEXNM,"00:00:03",.LEXIX)
- +10 QUIT
- R75705 ; Replacement Word file 757.05
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP,LEXIEN,LEXP3,LEXP4
- +2 SET LEXFI="757.05"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- NEW DA,DIK,LEXEX,LEXEXP,LEXIEN,LEXWRD
- HANG 1
- +5 DO RM(LEXFI)
- SET (LEXP3,LEXP4,LEXIEN)=0
- FOR
- SET LEXIEN=$ORDER(^LEX(757.05,LEXIEN))
- if +LEXIEN'>0
- QUIT
- Begin DoDot:1
- +6 NEW DA,DIK
- SET LEXP3=LEXIEN
- SET LEXP4=LEXP4+1
- +7 KILL ^LEX(757.05,LEXIEN,1,"B")
- SET DA=LEXIEN
- SET DIK="^LEX(757.05,"
- DO IX1^DIK
- End DoDot:1
- +8 SET $PIECE(^LEX(757.05,0),"^",3)=LEXP3
- SET $PIECE(^LEX(757.05,0),"^",4)=LEXP4
- +9 SET LEXIX(1)="B, AB, AEXP, ALINK, AWRD, and C"
- SET LEXNM="Replacement Words"
- IF $DATA(LEXLONG)
- Begin DoDot:1
- +10 SET LEXIX(1)="^LEX(757.05,""B"",WORD,IEN)"
- SET LEXIX(2)="^LEX(757.05,""AB"",WORD,IEN)"
- SET LEXIX(3)="^LEX(757.05,""C"",REP,IEN)"
- +11 SET LEXIX(4)="^LEX(757.05,""AEXP"",EXP,IEN)"
- SET LEXIX(5)="^LEX(757.05,""ALINK"",WORD,EXP)"
- SET LEXIX(6)="^LEX(757.01,""AWRD"",WORD,EXP,""LINKED"")"
- +12 SET LEXIX(7)="^LEX(757.05,IEN,1,""B"",EXP,IEN2)"
- End DoDot:1
- +13 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +14 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +15 DO REX^LEXRXXS(757.05,LEXNM,LEXELP,.LEXIX)
- +16 QUIT
- R75706 ; Unresolved Narrative file 757.06
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.06"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- KILL ^LEX(757.06)
- SET ^LEX(757.06,0)="UNRESOLVED NARRATIVES^757.06^^0"
- +5 SET LEXIX(1)="B"
- SET LEXNM="Unresolved Narratives"
- IF $DATA(LEXLONG)
- SET LEXIX(1)="^LEX(757.06,""B"",NAR,IEN)"
- +6 DO REX^LEXRXXS(757.06,LEXNM,"00:00:01",.LEXIX)
- +7 QUIT
- R75711 ; Semantic Class file 757.11
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.11"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="B"
- SET LEXNM="Semantic Class"
- IF $DATA(LEXLONG)
- SET LEXIX(1)="^LEX(757.11,""B"",SC,IEN)"
- SET LEXIX(2)="^LEX(757.11,IEN,2,""B"",SYS,IEN2)"
- +6 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +7 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +8 DO REX^LEXRXXS(757.11,LEXNM,"00:00:02",.LEXIX)
- +9 QUIT
- R75712 ; Semantic Type file 757.12
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.12"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="B, C, D and E"
- SET LEXNM="Semantic Type"
- IF $DATA(LEXLONG)
- Begin DoDot:1
- +6 SET LEXIX(1)="^LEX(757.12,""B"",TUI,IEN)"
- SET LEXIX(2)="^LEX(757.12,""D"",DT,IEN)"
- SET LEXIX(3)="^LEX(757.12,""E"",UDT,IEN)"
- SET LEXIX(4)="^LEX(757.12,""C"",SC,IEN)"
- SET LEXIX(5)="^LEX(757.12,IEN,1,""B"",SYS,IEN2)"
- End DoDot:1
- +7 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +8 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +9 DO REX^LEXRXXS(757.12,LEXNM,"00:00:02",.LEXIX)
- +10 QUIT
- R75707 ; Tokens file 757.07
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.07"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="ABBR, AED, B and D"
- SET LEXNM="Tokens"
- IF $DATA(LEXLONG)
- Begin DoDot:1
- +6 SET LEXIX(1)="^LEX(757.07,""ABBR"",TOKEN,IEN2,IEN1)=Abbreviation Text"
- +7 SET LEXIX(2)="^LEX(757.07,""AED"",TOKEN,TEXT,IEN2,IEN1)"
- +8 SET LEXIX(3)="^LEX(757.07,""B"",TOKEN,IEN2)"
- +9 SET LEXIX(4)="^LEX(757.07,""D"",WORD,IEN2,IEN1)"
- End DoDot:1
- +10 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +11 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +12 DO REX^LEXRXXS(757.07,LEXNM,"00:00:02",.LEXIX)
- +13 QUIT
- R757071 ; Supplemental Words file 757.071
- +1 NEW LEXBEG,LEXEND,LEXDIF,LEXIX,LEXELP
- +2 SET LEXFI="757.071"
- if '$DATA(ZTQUEUED)
- WRITE !,?8,"Re-Indexing file #",LEXFI
- +3 NEW LEXTC
- SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,("Re-Indexing File #"_LEXFI))
- if LEXTC=1
- QUIT
- +4 SET LEXBEG=$$NOW^XLFDT
- DO RM(LEXFI)
- DO RX(LEXFI)
- +5 SET LEXIX(1)="AD and B"
- SET LEXNM="Supplemental Words"
- IF $DATA(LEXLONG)
- Begin DoDot:1
- +6 SET LEXIX(1)="^LEX(757.071,""AD"",TEXT,IEN)"
- +7 SET LEXIX(2)="^LEX(757.071,""B"",WORD,IEN)"
- End DoDot:1
- +8 SET LEXEND=$$NOW^XLFDT
- SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
- +9 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
- SET LEXELP=$TRANSLATE(LEXELP," ","0")
- +10 DO REX^LEXRXXS(757.071,LEXNM,"00:00:02",.LEXIX)
- +11 QUIT
- +12 ;
- +13 ; Miscellaneous
- RM(X) ; Remove Main
- +1 NEW LEXFI,LEXIX,LEXRT,LEXOUT,LEXMSG
- +2 SET LEXFI=+($GET(X))
- if +LEXFI'>0
- QUIT
- if '$DATA(^LEX(LEXFI))&('$DATA(^LEXT(LEXFI)))
- QUIT
- +3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- +4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
- if LEXRT'["^LEX("&(LEXRT'["^LEXT(")
- QUIT
- +5 SET LEXIX=""" """
- if '$LENGTH($ORDER(@(LEXRT_LEXIX_")")))
- QUIT
- +6 FOR
- SET LEXIX=$ORDER(@(LEXRT_LEXIX_")"))
- if '$LENGTH(LEXIX)
- QUIT
- Begin DoDot:1
- +7 if +LEXIX'=LEXIX
- SET LEXIX=""""_LEXIX_""""
- +8 NEW LEXREF
- SET LEXREF=LEXRT_LEXIX_")"
- if '$DATA(@LEXREF)
- QUIT
- KILL @LEXREF
- End DoDot:1
- +9 QUIT
- RX(X) ; Re-Index File X
- +1 NEW DA,DIK,LEXFI,LEXOUT,LEXMSG,LEXRT,LEXP3,LEXP4
- HANG 2
- +2 SET LEXFI=+($GET(X))
- if +LEXFI'>0
- QUIT
- if '$DATA(^LEX(LEXFI))&('$DATA(^LEXT(LEXFI)))
- QUIT
- +3 DO FILE^DID(LEXFI,"N","GLOBAL NAME","LEXOUT","LEXMSG")
- +4 SET LEXRT=$GET(LEXOUT("GLOBAL NAME"))
- if LEXRT'["^LEX("&(LEXRT'["^LEXT(")
- QUIT
- +5 SET (LEXP3,LEXP4,DA)=0
- FOR
- SET DA=$ORDER(@(LEXRT_DA_")"))
- if +DA'>0
- QUIT
- Begin DoDot:1
- +6 SET LEXP3=DA
- SET LEXP4=LEXP4+1
- SET DIK=LEXRT
- DO IX1^DIK
- End DoDot:1
- +7 SET $PIECE(@(LEXRT_"0)"),"^",3)=LEXP3
- SET $PIECE(@(LEXRT_"0)"),"^",4)=LEXP4
- +8 QUIT
- CLR ; Clear
- +1 KILL LEXLONG,LEXNAM,ZTQUEUED
- +2 QUIT