LEXRXC4 ;ISL/KER - Re-Index 757.01 ASL ;12/19/2014
;;2.0;LEXICON UTILITY;**81,86**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXRXASL") SACC 2.3.2.5.1
; ^TMP("LEXRXASLU") SACC 2.3.2.5.1
; ^TMP("LEXRXAWRD") SACC 2.3.2.5.1
; ^TMP("LEXRXERR") SACC 2.3.2.5.1
; ^TMP("LEXRXPRO") SACC 2.3.2.5.1
; ^TMP("LEXRXREP") SACC 2.3.2.5.1
; ^TMP("LEXTKN") SACC 2.3.2.5.1
;
; External References
; $$FMDIFF^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$UP^XLFSTR ICR 10104
;
; 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
;
; The AWRD cross-references is used to create the ASL
; cross-reference, hence the AWRD cross-reference must
; be repaired/re-indexed before ASL.
;
Q
EN ; Main Entry Point
R75701 ; Repair file 757.01
D:'$D(^TMP("LEXRXAWRD",$J)) RAWRD^LEXRXC3
D RASL,KGBL
Q
;
RASL ; Index ^LEX(757.01,"ASL",FRAG,FREQ)
N LEXA,LEXBEG,LEXC,LEXCHR,LEXCHRS,LEXCTL,LEXDIF,LEXE,LEXELP,LEXEND,LEXERR,LEXF,LEXFC,LEXFI,LEXFIR,LEXIDX,LEXIDXT,LEXIT
N LEXLTKN,LEXM,LEXN,LEXND,LEXNDS,LEXNOD,LEXO,LEXP,LEXPSCT,LEXRT,LEXRT1,LEXRT2,LEXS,LEXSCT,LEXSTR,LEXT,LEXTC
N LEXTK,LEXTK1,LEXTK2,LEXTK3,LEXTKN,LEXTNG,LEXTTKN,LEXVAL S LEXFI="757.01" N LEXTC
K ^TMP("LEXRXPRO",$J,"ASL"),^TMP("LEXRXERR",$J,"ASL"),^TMP("LEXRXASL",$J),^TMP("LEXRXASLU",$J)
S LEXTC=$$UPD^LEXRXXT3($G(LEXNAM),,"Repairing File #757.01 ""ASL""") Q:LEXTC=1
S LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0,LEXSTR="",LEXFI=757.01,LEXIDX="ASL",LEXIDXT="^LEX(757.01,""ASL"",STR,FREQ)"
; Build
S LEXRT="" S:$D(^LEX(757.01,"AWRD")) LEXRT="^LEX(757.01,""AWRD"","
S:$D(^TMP("LEXRXAWRD",$J)) LEXRT="^TMP(""LEXRXAWRD"","_$J_"," Q:'$L(LEXRT)
; For each Word
S (LEXFIR,LEXFC,LEXTK)=""
F S LEXTK=$O(@(LEXRT_""""_LEXTK_""")")) Q:'$L(LEXTK) D
. S ^TMP("LEXRXPRO",$J,"ASL","BUILD","TKN")=LEXTK
. N LEXP,LEXS,LEXC,LEXF,LEXTKN S LEXTKN=LEXTK
. F Q:$E(LEXTKN,1)'=" " S LEXTKN=$E(LEXTKN,2,$L(LEXTKN))
. F Q:$E(LEXTKN,$L(LEXTKN))'=" " S LEXTKN=$E(LEXTKN,1,($L(LEXTKN)-1))
. S LEXF=$E(LEXTKN,1)
. S LEXFIR=LEXF S:LEXFC'[LEXF LEXFC=LEXFC_LEXF
. ; Count the occurrences of each string
. F LEXP=1:1:$L(LEXTKN) S LEXS=$$UP^XLFSTR($E(LEXTKN,1,LEXP)) D
. . Q:'$L($G(LEXS)) I '$D(^TMP("LEXRXASLU",$J,LEXS)) D
. . . N LEXE,LEXM,LEXO,LEXT,LEXA,LEXN S (LEXA,LEXN,LEXT)=0
. . . S LEXT=$$SCT^LEXRXC3(LEXS) I +($G(LEXT))>0 D
. . . . K ^TMP("LEXRXASL",$J,LEXS)
. . . . S ^TMP("LEXRXASL",$J,LEXS,LEXT)=""
. . S ^TMP("LEXRXASLU",$J,LEXS)=""
; Replace
N LEXCHR,LEXCHRS S LEXERR=$G(LEXERR) D CHRS,ERRCHK
S LEXCHR="" F S LEXCHR=$O(LEXCHRS(LEXCHR)) Q:'$L(LEXCHR) D
. S ^TMP("LEXRXPRO",$J,"ASL","REPLACE","CHR")=LEXCHR
. ; For strings beginning with character
. N LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
. ; Delete strings from the ^LEX global
. S (LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5)=""
. S LEXTK1=$C($A(LEXCHR)-1)_"~",LEXTK2=LEXCHR,LEXTK3=LEXCHR_" "
. S:LEXCHR?1N LEXTK4=LEXCHR-.00000001
. S:LEXCHR="." LEXTK5=.00000001
. F LEXTK=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5 D
. . Q:'$L(LEXTK) S (LEXLTKN,LEXTTKN)=LEXTK S LEXIT=0
. . F S LEXLTKN=$O(^LEX(757.01,"ASL",LEXLTKN)) D Q:LEXIT>0
. . . S:'$L(LEXLTKN) LEXIT=1 S:$E(LEXLTKN,1)'=LEXCHR LEXIT=1
. . . Q:LEXIT>0 N LEXNOD,LEXCTL
. . . S LEXNOD="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_")"
. . . S LEXCTL="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_","
. . . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . . N LEXTMP,LEXND S LEXTMP=$TR(LEXLTKN,"""","")
. . . . S LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_")" K @LEXND
. ; Add strings to the ^LEX global
. F LEXTTKN=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5 D
. . Q:'$L(LEXTTKN) N LEXC,LEXIT S LEXIT=0,LEXC=LEXTTKN
. . F S LEXTTKN=$O(^TMP("LEXRXASL",$J,LEXTTKN)) Q:'$L(LEXTTKN) D Q:LEXIT>0
. . . Q:$E(LEXTTKN,1)'=LEXCHR
. . . N LEXNOD,LEXCTL S LEXNOD="^TMP(""LEXRXASL"","_$J_","_$$QQ(LEXTTKN)_")"
. . . S LEXCTL="^TMP(""LEXRXASL"","_$J_","_$$QQ(LEXTTKN)_","
. . . F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. . . . N LEXSTR,LEXVAL,LEXND,LEXTMP S LEXSTR=$P($P(LEXNOD,(","_$J_","),2),",",1)
. . . . S LEXVAL=+$P($P(LEXNOD,(","_$J_","),2),",",2) Q:'$L(LEXSTR) Q:+LEXVAL'>0
. . . . S LEXTMP=$TR(LEXSTR,"""",""),LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXTMP)_")" K @LEXND
. . . . S LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXTMP)_","_LEXVAL_")" S @LEXND=""
. . . . S ^TMP("LEXRXREP",$J,"ASL")=+($G(^TMP("LEXRXREP",$J,"ASL")))+1
. . . . S LEXNDS=+($G(LEXNDS))+1
S LEXERR=$S(+LEXERR>0:LEXERR,1:"")
I '$D(ZTQUEUED) W !,$J(LEXERR,5),?8,$G(LEXFI),?19,$G(LEXIDX),?30,$G(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),KGBL
Q
;
; Miscellaneous
ERRCHK ; Check for Errors - Sets LEXERR
K ^TMP("LEXRXERR",$J,"ASL")
N LEXCTL,LEXCHRS,LEXN1,LEXN2,LEXND,LEXNOD,LEXS,LEXT S LEXERR=0 D CHRS
S LEXNOD="^TMP(""LEXRXASL"","_$J_")",LEXCTL="^TMP(""LEXRXASL"","_$J_","
F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. N LEXS,LEXT,LEXND,LEXN1,LEXN2,LEXTND S LEXTND=$TR(LEXNOD,"""","")
. S LEXS=$P(LEXTND,",",3) Q:'$L(LEXS)
. S LEXT=+($P(LEXTND,",",4)) Q:+LEXT'>0
. S LEXN1="^LEX(757.01,""ASL"","_$$QQ(LEXS)_")"
. S LEXN2="^LEX(757.01,""ASL"","_$$QQ(LEXS)_","_LEXT_")"
. I '$D(@LEXN1) D
. . S LEXERR=+($G(LEXERR))+1
. . S ^TMP("LEXRXERR",$J,"ASL",0)=$G(^TMP("LEXRXERR",$J,"ASL",0))+1
. . S ^TMP("LEXRXERR",$J,"ASL",1)=$G(^TMP("LEXRXERR",$J,"ASL",1))+1
. . S ^TMP("LEXRXERR",$J,"ASL",1,0)="String missing in ""ASL"" index"
. . S ^TMP("LEXRXERR",$J,"ASL",1,"ERR",LEXS,LEXT)=""
. . S ^TMP("LEXRXPRO",$J,"ASL","ERR")=+($G(^TMP("LEXRXPRO",$J,"ASL","ERR")))+1
. I $D(@LEXN2),'$D(@LEXN2) D
. . S LEXERR=+($G(LEXERR))+1
. . S ^TMP("LEXRXERR",$J,"ASL",0)=$G(^TMP("LEXRXERR",$J,"ASL",0))+1
. . S ^TMP("LEXRXERR",$J,"ASL",2)=$G(^TMP("LEXRXERR",$J,"ASL",2))+1
. . S ^TMP("LEXRXERR",$J,"ASL",2,0)="Value missing in ""ASL"" index"
. . S ^TMP("LEXRXERR",$J,"ASL",2,"ERR",LEXS,LEXT)=""
. . S ^TMP("LEXRXPRO",$J,"ASL","ERR")=+($G(^TMP("LEXRXPRO",$J,"ASL","ERR")))+1
S LEXNOD="^LEX(757.01,""ASL"")",LEXCTL="^LEX(757.01,""ASL"","
F S LEXNOD=$Q(@LEXNOD) Q:'$L(LEXNOD)!(LEXNOD'[LEXCTL) D
. N LEXS,LEXT,LEXN1,LEXN2,LEXTND S LEXTND=$TR(LEXNOD,"""","")
. S LEXS=$P(LEXTND,",",3) Q:'$L(LEXS)
. S LEXT=+($P(LEXTND,",",4)) Q:+LEXT'>0
. S LEXN1="^TMP(""LEXRXASL"","_$J_","_$$QQ(LEXS)_")"
. S LEXN2="^TMP(""LEXRXASL"","_$J_","_$$QQ(LEXS)_","_LEXT_")"
. I '$D(@LEXN1) D
. . S LEXERR=+($G(LEXERR))+1
. . S ^TMP("LEXRXERR",$J,"ASL",0)=$G(^TMP("LEXRXERR",$J,"ASL",0))+1
. . S ^TMP("LEXRXERR",$J,"ASL",3)=$G(^TMP("LEXRXERR",$J,"ASL",3))+1
. . S ^TMP("LEXRXERR",$J,"ASL",3,0)="Invalid String found in ""ASL"" index"
. . S ^TMP("LEXRXERR",$J,"ASL",3,"ERR",LEXS,LEXT)=""
. . S ^TMP("LEXRXPRO",$J,"ASL","ERR")=+($G(^TMP("LEXRXPRO",$J,"ASL","ERR")))+1
. I $D(@LEXN1),'$D(@LEXN2) D
. . S LEXERR=+($G(LEXERR))+1
. . S ^TMP("LEXRXERR",$J,"ASL",0)=$G(^TMP("LEXRXERR",$J,"ASL",0))+1
. . S ^TMP("LEXRXERR",$J,"ASL",0)=$G(^TMP("LEXRXERR",$J,"ASL",0))+1
. . S ^TMP("LEXRXERR",$J,"ASL",4)=$G(^TMP("LEXRXERR",$J,"ASL",4))+1
. . S ^TMP("LEXRXERR",$J,"ASL",4,0)="Invalid Value found in ""ASL"" index"
. . S ^TMP("LEXRXERR",$J,"ASL",4,"ERR",LEXS,LEXT)=""
. . S ^TMP("LEXRXPRO",$J,"ASL","ERR")=+($G(^TMP("LEXRXPRO",$J,"ASL","ERR")))+1
S ^TMP("LEXRXERR",$J,"ASL",0)=+($G(^TMP("LEXRXERR",$J,"ASL",0)))
Q
QQ(X) ; Set Quotes
N LEXS,LEXT S LEXS=$TR($G(X),"""",""),LEXT=0
S:$TR(LEXS,".","")'?1N.N LEXT=1 I $TR(LEXS,".","")?1N.N S:$L(+LEXS)'=$L(LEXS) LEXT=1
S X=LEXS S:LEXT=1 X=""""_LEXS_""""
Q X
CHRS ; Get Characters - Sets LEXCHRS
N LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK K LEXCHRS S LEXRT1="^LEX(757.01,""AWRD"","
S LEXRT2="^TMP(""LEXRXAWRD"","_$J_"," F LEXRT=LEXRT1,LEXRT2 D
. N LEXTK S LEXTK="#" F S LEXTK=$O(@(LEXRT_""""_LEXTK_""")")) Q:'$L(LEXTK) D
. . N LEXCHR S LEXCHR=$E($TR(LEXTK," ",""),1) S LEXTK=$E(LEXTK,1)_"~"
. . S:$L(LEXCHR) LEXCHRS(LEXCHR)=""
Q
CLR ; Clear
Q
KGBL ; Kill Global Arrays
K:'$D(LEXTEST) ^TMP("LEXRXASL",$J),^TMP("LEXRXASLU",$J),^TMP("LEXRXAWRD",$J),^TMP("LEXTKN",$J)
K:'$D(LEXTEST) ^TMP("LEXRXPRO",$J),^TMP("LEXRXERR",$J),^TMP("LEXRXREP",$J)
K:+($G(LEXRXTMP))'>0 ^TMP("LEXRX",$J) N LEXTEST,LEXRXTMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXRXC4 8758 printed Dec 13, 2024@02:09:15 Page 2
LEXRXC4 ;ISL/KER - Re-Index 757.01 ASL ;12/19/2014
+1 ;;2.0;LEXICON UTILITY;**81,86**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXRXASL") SACC 2.3.2.5.1
+5 ; ^TMP("LEXRXASLU") SACC 2.3.2.5.1
+6 ; ^TMP("LEXRXAWRD") SACC 2.3.2.5.1
+7 ; ^TMP("LEXRXERR") SACC 2.3.2.5.1
+8 ; ^TMP("LEXRXPRO") SACC 2.3.2.5.1
+9 ; ^TMP("LEXRXREP") SACC 2.3.2.5.1
+10 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+11 ;
+12 ; External References
+13 ; $$FMDIFF^XLFDT ICR 10103
+14 ; $$NOW^XLFDT ICR 10103
+15 ; $$UP^XLFSTR ICR 10104
+16 ;
+17 ; Local Variables NEWed or KILLed Elsewhere
+18 ; LEXNAM Task name NEWed/KILLed by LEXRXXT
+19 ; LEXTEST Test variable NEWed/KILLed by Developer
+20 ; ZTQUEUED Task flag NEWed/KILLed by Taskman
+21 ;
+22 ; The AWRD cross-references is used to create the ASL
+23 ; cross-reference, hence the AWRD cross-reference must
+24 ; be repaired/re-indexed before ASL.
+25 ;
+26 QUIT
EN ; Main Entry Point
R75701 ; Repair file 757.01
+1 if '$DATA(^TMP("LEXRXAWRD",$JOB))
DO RAWRD^LEXRXC3
+2 DO RASL
DO KGBL
+3 QUIT
+4 ;
RASL ; Index ^LEX(757.01,"ASL",FRAG,FREQ)
+1 NEW LEXA,LEXBEG,LEXC,LEXCHR,LEXCHRS,LEXCTL,LEXDIF,LEXE,LEXELP,LEXEND,LEXERR,LEXF,LEXFC,LEXFI,LEXFIR,LEXIDX,LEXIDXT,LEXIT
+2 NEW LEXLTKN,LEXM,LEXN,LEXND,LEXNDS,LEXNOD,LEXO,LEXP,LEXPSCT,LEXRT,LEXRT1,LEXRT2,LEXS,LEXSCT,LEXSTR,LEXT,LEXTC
+3 NEW LEXTK,LEXTK1,LEXTK2,LEXTK3,LEXTKN,LEXTNG,LEXTTKN,LEXVAL
SET LEXFI="757.01"
NEW LEXTC
+4 KILL ^TMP("LEXRXPRO",$JOB,"ASL"),^TMP("LEXRXERR",$JOB,"ASL"),^TMP("LEXRXASL",$JOB),^TMP("LEXRXASLU",$JOB)
+5 SET LEXTC=$$UPD^LEXRXXT3($GET(LEXNAM),,"Repairing File #757.01 ""ASL""")
if LEXTC=1
QUIT
+6 SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
SET LEXSTR=""
SET LEXFI=757.01
SET LEXIDX="ASL"
SET LEXIDXT="^LEX(757.01,""ASL"",STR,FREQ)"
+7 ; Build
+8 SET LEXRT=""
if $DATA(^LEX(757.01,"AWRD"))
SET LEXRT="^LEX(757.01,""AWRD"","
+9 if $DATA(^TMP("LEXRXAWRD",$JOB))
SET LEXRT="^TMP(""LEXRXAWRD"","_$JOB_","
if '$LENGTH(LEXRT)
QUIT
+10 ; For each Word
+11 SET (LEXFIR,LEXFC,LEXTK)=""
+12 FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
if '$LENGTH(LEXTK)
QUIT
Begin DoDot:1
+13 SET ^TMP("LEXRXPRO",$JOB,"ASL","BUILD","TKN")=LEXTK
+14 NEW LEXP,LEXS,LEXC,LEXF,LEXTKN
SET LEXTKN=LEXTK
+15 FOR
if $EXTRACT(LEXTKN,1)'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,2,$LENGTH(LEXTKN))
+16 FOR
if $EXTRACT(LEXTKN,$LENGTH(LEXTKN))'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,1,($LENGTH(LEXTKN)-1))
+17 SET LEXF=$EXTRACT(LEXTKN,1)
+18 SET LEXFIR=LEXF
if LEXFC'[LEXF
SET LEXFC=LEXFC_LEXF
+19 ; Count the occurrences of each string
+20 FOR LEXP=1:1:$LENGTH(LEXTKN)
SET LEXS=$$UP^XLFSTR($EXTRACT(LEXTKN,1,LEXP))
Begin DoDot:2
+21 if '$LENGTH($GET(LEXS))
QUIT
IF '$DATA(^TMP("LEXRXASLU",$JOB,LEXS))
Begin DoDot:3
+22 NEW LEXE,LEXM,LEXO,LEXT,LEXA,LEXN
SET (LEXA,LEXN,LEXT)=0
+23 SET LEXT=$$SCT^LEXRXC3(LEXS)
IF +($GET(LEXT))>0
Begin DoDot:4
+24 KILL ^TMP("LEXRXASL",$JOB,LEXS)
+25 SET ^TMP("LEXRXASL",$JOB,LEXS,LEXT)=""
End DoDot:4
End DoDot:3
+26 SET ^TMP("LEXRXASLU",$JOB,LEXS)=""
End DoDot:2
End DoDot:1
+27 ; Replace
+28 NEW LEXCHR,LEXCHRS
SET LEXERR=$GET(LEXERR)
DO CHRS
DO ERRCHK
+29 SET LEXCHR=""
FOR
SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))
if '$LENGTH(LEXCHR)
QUIT
Begin DoDot:1
+30 SET ^TMP("LEXRXPRO",$JOB,"ASL","REPLACE","CHR")=LEXCHR
+31 ; For strings beginning with character
+32 NEW LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
+33 ; Delete strings from the ^LEX global
+34 SET (LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5)=""
+35 SET LEXTK1=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXTK2=LEXCHR
SET LEXTK3=LEXCHR_" "
+36 if LEXCHR?1N
SET LEXTK4=LEXCHR-.00000001
+37 if LEXCHR="."
SET LEXTK5=.00000001
+38 FOR LEXTK=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5
Begin DoDot:2
+39 if '$LENGTH(LEXTK)
QUIT
SET (LEXLTKN,LEXTTKN)=LEXTK
SET LEXIT=0
+40 FOR
SET LEXLTKN=$ORDER(^LEX(757.01,"ASL",LEXLTKN))
Begin DoDot:3
+41 if '$LENGTH(LEXLTKN)
SET LEXIT=1
if $EXTRACT(LEXLTKN,1)'=LEXCHR
SET LEXIT=1
+42 if LEXIT>0
QUIT
NEW LEXNOD,LEXCTL
+43 SET LEXNOD="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_")"
+44 SET LEXCTL="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_","
+45 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:4
+46 NEW LEXTMP,LEXND
SET LEXTMP=$TRANSLATE(LEXLTKN,"""","")
+47 SET LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_")"
KILL @LEXND
End DoDot:4
End DoDot:3
if LEXIT>0
QUIT
End DoDot:2
+48 ; Add strings to the ^LEX global
+49 FOR LEXTTKN=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5
Begin DoDot:2
+50 if '$LENGTH(LEXTTKN)
QUIT
NEW LEXC,LEXIT
SET LEXIT=0
SET LEXC=LEXTTKN
+51 FOR
SET LEXTTKN=$ORDER(^TMP("LEXRXASL",$JOB,LEXTTKN))
if '$LENGTH(LEXTTKN)
QUIT
Begin DoDot:3
+52 if $EXTRACT(LEXTTKN,1)'=LEXCHR
QUIT
+53 NEW LEXNOD,LEXCTL
SET LEXNOD="^TMP(""LEXRXASL"","_$JOB_","_$$QQ(LEXTTKN)_")"
+54 SET LEXCTL="^TMP(""LEXRXASL"","_$JOB_","_$$QQ(LEXTTKN)_","
+55 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:4
+56 NEW LEXSTR,LEXVAL,LEXND,LEXTMP
SET LEXSTR=$PIECE($PIECE(LEXNOD,(","_$JOB_","),2),",",1)
+57 SET LEXVAL=+$PIECE($PIECE(LEXNOD,(","_$JOB_","),2),",",2)
if '$LENGTH(LEXSTR)
QUIT
if +LEXVAL'>0
QUIT
+58 SET LEXTMP=$TRANSLATE(LEXSTR,"""","")
SET LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXTMP)_")"
KILL @LEXND
+59 SET LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXTMP)_","_LEXVAL_")"
SET @LEXND=""
+60 SET ^TMP("LEXRXREP",$JOB,"ASL")=+($GET(^TMP("LEXRXREP",$JOB,"ASL")))+1
+61 SET LEXNDS=+($GET(LEXNDS))+1
End DoDot:4
End DoDot:3
if LEXIT>0
QUIT
End DoDot:2
End DoDot:1
+62 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
+63 IF '$DATA(ZTQUEUED)
WRITE !,$JUSTIFY(LEXERR,5),?8,$GET(LEXFI),?19,$GET(LEXIDX),?30,$GET(LEXIDXT)
+64 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$FMDIFF^XLFDT(LEXEND,LEXBEG,3)
+65 if $EXTRACT(LEXELP,1)=" "&($EXTRACT(LEXELP,3)="
SET LEXELP=$TRANSLATE(LEXELP," ","0")
+66 DO REP^LEXRXXS(LEXFI,LEXFI,LEXIDX,LEXNDS,LEXERR,LEXIDXT,LEXELP)
DO KGBL
+67 QUIT
+68 ;
+69 ; Miscellaneous
ERRCHK ; Check for Errors - Sets LEXERR
+1 KILL ^TMP("LEXRXERR",$JOB,"ASL")
+2 NEW LEXCTL,LEXCHRS,LEXN1,LEXN2,LEXND,LEXNOD,LEXS,LEXT
SET LEXERR=0
DO CHRS
+3 SET LEXNOD="^TMP(""LEXRXASL"","_$JOB_")"
SET LEXCTL="^TMP(""LEXRXASL"","_$JOB_","
+4 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:1
+5 NEW LEXS,LEXT,LEXND,LEXN1,LEXN2,LEXTND
SET LEXTND=$TRANSLATE(LEXNOD,"""","")
+6 SET LEXS=$PIECE(LEXTND,",",3)
if '$LENGTH(LEXS)
QUIT
+7 SET LEXT=+($PIECE(LEXTND,",",4))
if +LEXT'>0
QUIT
+8 SET LEXN1="^LEX(757.01,""ASL"","_$$QQ(LEXS)_")"
+9 SET LEXN2="^LEX(757.01,""ASL"","_$$QQ(LEXS)_","_LEXT_")"
+10 IF '$DATA(@LEXN1)
Begin DoDot:2
+11 SET LEXERR=+($GET(LEXERR))+1
+12 SET ^TMP("LEXRXERR",$JOB,"ASL",0)=$GET(^TMP("LEXRXERR",$JOB,"ASL",0))+1
+13 SET ^TMP("LEXRXERR",$JOB,"ASL",1)=$GET(^TMP("LEXRXERR",$JOB,"ASL",1))+1
+14 SET ^TMP("LEXRXERR",$JOB,"ASL",1,0)="String missing in ""ASL"" index"
+15 SET ^TMP("LEXRXERR",$JOB,"ASL",1,"ERR",LEXS,LEXT)=""
+16 SET ^TMP("LEXRXPRO",$JOB,"ASL","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"ASL","ERR")))+1
End DoDot:2
+17 IF $DATA(@LEXN2)
IF '$DATA(@LEXN2)
Begin DoDot:2
+18 SET LEXERR=+($GET(LEXERR))+1
+19 SET ^TMP("LEXRXERR",$JOB,"ASL",0)=$GET(^TMP("LEXRXERR",$JOB,"ASL",0))+1
+20 SET ^TMP("LEXRXERR",$JOB,"ASL",2)=$GET(^TMP("LEXRXERR",$JOB,"ASL",2))+1
+21 SET ^TMP("LEXRXERR",$JOB,"ASL",2,0)="Value missing in ""ASL"" index"
+22 SET ^TMP("LEXRXERR",$JOB,"ASL",2,"ERR",LEXS,LEXT)=""
+23 SET ^TMP("LEXRXPRO",$JOB,"ASL","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"ASL","ERR")))+1
End DoDot:2
End DoDot:1
+24 SET LEXNOD="^LEX(757.01,""ASL"")"
SET LEXCTL="^LEX(757.01,""ASL"","
+25 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:1
+26 NEW LEXS,LEXT,LEXN1,LEXN2,LEXTND
SET LEXTND=$TRANSLATE(LEXNOD,"""","")
+27 SET LEXS=$PIECE(LEXTND,",",3)
if '$LENGTH(LEXS)
QUIT
+28 SET LEXT=+($PIECE(LEXTND,",",4))
if +LEXT'>0
QUIT
+29 SET LEXN1="^TMP(""LEXRXASL"","_$JOB_","_$$QQ(LEXS)_")"
+30 SET LEXN2="^TMP(""LEXRXASL"","_$JOB_","_$$QQ(LEXS)_","_LEXT_")"
+31 IF '$DATA(@LEXN1)
Begin DoDot:2
+32 SET LEXERR=+($GET(LEXERR))+1
+33 SET ^TMP("LEXRXERR",$JOB,"ASL",0)=$GET(^TMP("LEXRXERR",$JOB,"ASL",0))+1
+34 SET ^TMP("LEXRXERR",$JOB,"ASL",3)=$GET(^TMP("LEXRXERR",$JOB,"ASL",3))+1
+35 SET ^TMP("LEXRXERR",$JOB,"ASL",3,0)="Invalid String found in ""ASL"" index"
+36 SET ^TMP("LEXRXERR",$JOB,"ASL",3,"ERR",LEXS,LEXT)=""
+37 SET ^TMP("LEXRXPRO",$JOB,"ASL","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"ASL","ERR")))+1
End DoDot:2
+38 IF $DATA(@LEXN1)
IF '$DATA(@LEXN2)
Begin DoDot:2
+39 SET LEXERR=+($GET(LEXERR))+1
+40 SET ^TMP("LEXRXERR",$JOB,"ASL",0)=$GET(^TMP("LEXRXERR",$JOB,"ASL",0))+1
+41 SET ^TMP("LEXRXERR",$JOB,"ASL",0)=$GET(^TMP("LEXRXERR",$JOB,"ASL",0))+1
+42 SET ^TMP("LEXRXERR",$JOB,"ASL",4)=$GET(^TMP("LEXRXERR",$JOB,"ASL",4))+1
+43 SET ^TMP("LEXRXERR",$JOB,"ASL",4,0)="Invalid Value found in ""ASL"" index"
+44 SET ^TMP("LEXRXERR",$JOB,"ASL",4,"ERR",LEXS,LEXT)=""
+45 SET ^TMP("LEXRXPRO",$JOB,"ASL","ERR")=+($GET(^TMP("LEXRXPRO",$JOB,"ASL","ERR")))+1
End DoDot:2
End DoDot:1
+46 SET ^TMP("LEXRXERR",$JOB,"ASL",0)=+($GET(^TMP("LEXRXERR",$JOB,"ASL",0)))
+47 QUIT
QQ(X) ; Set Quotes
+1 NEW LEXS,LEXT
SET LEXS=$TRANSLATE($GET(X),"""","")
SET LEXT=0
+2 if $TRANSLATE(LEXS,".","")'?1N.N
SET LEXT=1
IF $TRANSLATE(LEXS,".","")?1N.N
if $LENGTH(+LEXS)'=$LENGTH(LEXS)
SET LEXT=1
+3 SET X=LEXS
if LEXT=1
SET X=""""_LEXS_""""
+4 QUIT X
CHRS ; Get Characters - Sets LEXCHRS
+1 NEW LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK
KILL LEXCHRS
SET LEXRT1="^LEX(757.01,""AWRD"","
+2 SET LEXRT2="^TMP(""LEXRXAWRD"","_$JOB_","
FOR LEXRT=LEXRT1,LEXRT2
Begin DoDot:1
+3 NEW LEXTK
SET LEXTK="#"
FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
if '$LENGTH(LEXTK)
QUIT
Begin DoDot:2
+4 NEW LEXCHR
SET LEXCHR=$EXTRACT($TRANSLATE(LEXTK," ",""),1)
SET LEXTK=$EXTRACT(LEXTK,1)_"~"
+5 if $LENGTH(LEXCHR)
SET LEXCHRS(LEXCHR)=""
End DoDot:2
End DoDot:1
+6 QUIT
CLR ; Clear
+1 QUIT
KGBL ; Kill Global Arrays
+1 if '$DATA(LEXTEST)
KILL ^TMP("LEXRXASL",$JOB),^TMP("LEXRXASLU",$JOB),^TMP("LEXRXAWRD",$JOB),^TMP("LEXTKN",$JOB)
+2 if '$DATA(LEXTEST)
KILL ^TMP("LEXRXPRO",$JOB),^TMP("LEXRXERR",$JOB),^TMP("LEXRXREP",$JOB)
+3 if +($GET(LEXRXTMP))'>0
KILL ^TMP("LEXRX",$JOB)
NEW LEXTEST,LEXRXTMP
+4 QUIT
