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