LEXXGP2 ;ISL/KER - Global Post-Install (Repair Expressions) ;12/19/2014
;;2.0;LEXICON UTILITY;**80,86**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXASL") SACC 2.3.2.5.1
; ^TMP("LEXASLU") SACC 2.3.2.5.1
; ^TMP("LEXAWRD") SACC 2.3.2.5.1
; ^TMP("LEXAWRDU") SACC 2.3.2.5.1
; ^TMP("LEXTKN") SACC 2.3.2.5.1
; ^TMP("LEXXGPDAT") SACC 2.3.2.5.1
; ^TMP("LEXXGPRPT") SACC 2.3.2.5.1
; ^TMP("LEXXGPTIM") SACC 2.3.2.5.1
;
; External References
; $$S^%ZTLOAD ICR 10063
; $$UP^XLFSTR ICR 10104
;
; Local Variables NEWed or KILLed in LEXXGP1
; LEXFIR,LEXFUL,LEXMAIL,LEXQUIT,ZTQUEUED,ZTSK
;
Q
ASLB ; ASL String Length Index Build 6.5 minutes
N LEXA,LEXBEG,LEXBEGD,LEXBEGT,LEXC,LEXCHK,LEXDF,LEXE,LEXELP,LEXEND,LEXENDT,LEXM
N LEXN,LEXO,LEXP,LEXRT,LEXS,LEXT,LEXTK,LEXTKN,LEXTXT S LEXBEG=$$BEG^LEXXGP1
S:'$D(LEXQUIT) LEXQUIT="ASLB" S LEXTXT="Build 'ASL' String Length Index"
I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
S LEXRT="" S:$D(^LEX(757.01,"AWRD")) LEXRT="^LEX(757.01,""AWRD"","
S:$D(^TMP("LEXAWRD",$J)) LEXRT="^TMP(""LEXAWRD"","_$J_"," Q:'$L(LEXRT)
; For each Word
S (LEXFIR,LEXFC,LEXTK)=""
F S LEXTK=$O(@(LEXRT_""""_LEXTK_""")")) Q:'$L(LEXTK) D
. 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("LEXASLU",$J,LEXS)) D
. . . N LEXE,LEXM,LEXO,LEXT,LEXA,LEXN S (LEXA,LEXN,LEXT)=0
. . . S LEXT=$$SCT(LEXS) I +($G(LEXT))>0 D
. . . . K ^TMP("LEXASL",$J,LEXS)
. . . . S ^TMP("LEXASL",$J,LEXS,LEXT)=""
. . S ^TMP("LEXASLU",$J,LEXS)=""
H 1 S LEXEND=$$END^LEXXGP1 D SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
S LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND),LEXBEGD=$$ED^LEXXGP1(LEXBEG)
S LEXBEGT=$$ET^LEXXGP1(LEXBEG),LEXENDT=$$ET^LEXXGP1(LEXEND),LEXDF=$$DF^LEXXGP1(LEXBEG)
S LEXTXT=$G(LEXTXT)_$J(" ",(35-$L($G(LEXTXT))))
S LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
S LEXTXT=" "_LEXTXT W:'$D(ZTQUEUED) !,LEXTXT
D ASLR I $G(LEXQUIT)="ASLB" D
. D:$D(LEXMAIL) XM^LEXXGP3
. K ^TMP("LEXASL",$J),^TMP("LEXASLU",$J),^TMP("LEXAWRD",$J),^TMP("LEXAWRDU",$J)
. K ^TMP("LEXTKN",$J),^TMP("LEXXGPDAT",$J),^TMP("LEXXGPTIM",$J),^TMP("LEXXGPRPT",$J)
Q
ASLR ; ASL String Length Index Replace 0.5 minutes
N LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXC,LEXCHK,LEXCHR,LEXCHRS,LEXCOM,LEXCTL
N LEXDF,LEXELP,LEXEND,LEXENDT,LEXIT,LEXLTKN,LEXND,LEXNOD,LEXSTR,LEXTK,LEXTK1
N LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTMP,LEXTTKN,LEXTXT,LEXVAL S (LEX1,LEX2,LEX3)=0
Q:'$D(LEXQUIT) S LEXBEG=$$BEG^LEXXGP1,LEXTXT="Replace 'ASL' String Length Index"
I +($G(ZTSK))>0 S LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
N LEXCHR,LEXCHRS D CHRS S LEXCHR=""
F S LEXCHR=$O(LEXCHRS(LEXCHR)) Q:'$L(LEXCHR) D
. ; 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 S LEX1=+($G(LEX1))+1
. ; 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("LEXASL",$J,LEXTTKN)) Q:'$L(LEXTTKN) D Q:LEXIT>0
. . . Q:$E(LEXTTKN,1)'=LEXCHR
. . . N LEXNOD,LEXCTL S LEXNOD="^TMP(""LEXASL"","_$J_","_$$QQ(LEXTTKN)_")"
. . . S LEXCTL="^TMP(""LEXASL"","_$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 LEX3=+($G(LEX3))+1
. ; Repeat for all characters
H 1 S LEXEND=$$END^LEXXGP1 D SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
S LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND),LEXBEGD=$$ED^LEXXGP1(LEXBEG)
S LEXBEGT=$$ET^LEXXGP1(LEXBEG),LEXENDT=$$ET^LEXXGP1(LEXEND),LEXDF=$$DF^LEXXGP1(LEXBEG)
S LEXTXT=$G(LEXTXT)_$J(" ",(35-$L($G(LEXTXT))))
S LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
S LEXTXT=" "_LEXTXT W:'$D(ZTQUEUED) !,LEXTXT
I LEX3>0,$D(LEXFUL) D
. S LEXCOM=LEX3_" 'ASL' Index Node"_$S(LEX3>1:"s",1:"")
. D SAV^LEXXGP3(LEXBEG,"","",LEXCOM) W:'$D(ZTQUEUED) !," ",LEXCOM
Q
;
; Miscellaneous
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
SCT(X) ; String Count (exact string)
N LEX,LEXA,LEXE,LEXIT,LEXM,LEXN,LEXO,LEXOUT,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTKN
S LEXS=$$UP^XLFSTR($G(X)) Q:'$L(LEXS) 0 S LEXRT="" S:$D(^LEX(757.01,"AWRD")) LEXRT="^LEX(757.01,""AWRD"","
S:$D(^TMP("LEXAWRD",$J)) LEXRT="^TMP(""LEXAWRD"","_$J_"," Q:'$L(LEXRT) 0 S (LEXA,LEXN,LEXT)=0
S:$L(LEXS)>1 LEXO=$E(LEXS,1,($L(LEXS)-1))_$C(($A($E(LEXS,$L(LEXS)))-1))_"~"
S:$L(LEXS)=1 LEXO=$C(($A(LEXS)-1))_"~" S LEXIT=0
F S LEXO=$O(@(LEXRT_""""_LEXO_""")")) D Q:LEXIT>0
. S:'$L(LEXO) LEXIT=1 S:$E(LEXO,1,$L(LEXS))'=LEXS LEXIT=1
. Q:LEXIT>0 N LEXM S LEXM=0 F S LEXM=$O(@(LEXRT_""""_LEXO_""","_LEXM_")")) Q:+LEXM'>0 D
. . N LEXE,LEXRT2 S LEXE=0,LEXRT2=LEXRT_""""_LEXO_""","_LEXM_","
. . F S LEXE=$O(@(LEXRT2_LEXE_")")) Q:+LEXE'>0 S LEXT=LEXT+1,LEXA=LEXA+1
I $TR(LEXS,".","")?1N.N,$L(LEXS,".")'>2 I +LEXS=LEXS D
. N LEXFC S LEXFC=$E(LEXS,1) S:$E(LEXS,1)?1N LEXO=LEXS-.000000001
. S:$E(LEXS,1)="." LEXO=.000000001 S LEXIT=0
. F S LEXO=$O(@(LEXRT_+LEXO_")")) D Q:LEXIT>0 Q:'$L(LEXO)
. . S:LEXFC?1N&($E(LEXO,1)'?1N) LEXIT=1
. . S:LEXFC?1P&($E(LEXO,1)'?1P) LEXIT=1 Q:LEXIT>0
. . Q:'$L(LEXO) Q:$E(LEXO,1,$L(LEXS))'=LEXS N LEXM S LEXM=0
. . F S LEXM=$O(@(LEXRT_+LEXO_","_LEXM_")")) Q:+LEXM'>0 D
. . . N LEXE,LEXRT2 S LEXE=0,LEXRT2=LEXRT_+LEXO_","_LEXM_","
. . . F S LEXE=$O(@(LEXRT2_LEXE_")")) Q:+LEXE'>0 S LEXT=LEXT+1,LEXN=LEXN+1
S X=LEXT
Q X
CHRS ; Get Characters - Sets LEXCHRS
N LEXCHR,LEXRT,LEXRT1,LEXRT2,LEXTK K LEXCHRS S LEXRT1="^LEX(757.01,""AWRD"","
S LEXRT2="^TMP(""LEXAWRD"","_$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXGP2 7600 printed Dec 13, 2024@02:10:16 Page 2
LEXXGP2 ;ISL/KER - Global Post-Install (Repair Expressions) ;12/19/2014
+1 ;;2.0;LEXICON UTILITY;**80,86**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXASL") SACC 2.3.2.5.1
+5 ; ^TMP("LEXASLU") SACC 2.3.2.5.1
+6 ; ^TMP("LEXAWRD") SACC 2.3.2.5.1
+7 ; ^TMP("LEXAWRDU") SACC 2.3.2.5.1
+8 ; ^TMP("LEXTKN") SACC 2.3.2.5.1
+9 ; ^TMP("LEXXGPDAT") SACC 2.3.2.5.1
+10 ; ^TMP("LEXXGPRPT") SACC 2.3.2.5.1
+11 ; ^TMP("LEXXGPTIM") SACC 2.3.2.5.1
+12 ;
+13 ; External References
+14 ; $$S^%ZTLOAD ICR 10063
+15 ; $$UP^XLFSTR ICR 10104
+16 ;
+17 ; Local Variables NEWed or KILLed in LEXXGP1
+18 ; LEXFIR,LEXFUL,LEXMAIL,LEXQUIT,ZTQUEUED,ZTSK
+19 ;
+20 QUIT
ASLB ; ASL String Length Index Build 6.5 minutes
+1 NEW LEXA,LEXBEG,LEXBEGD,LEXBEGT,LEXC,LEXCHK,LEXDF,LEXE,LEXELP,LEXEND,LEXENDT,LEXM
+2 NEW LEXN,LEXO,LEXP,LEXRT,LEXS,LEXT,LEXTK,LEXTKN,LEXTXT
SET LEXBEG=$$BEG^LEXXGP1
+3 if '$DATA(LEXQUIT)
SET LEXQUIT="ASLB"
SET LEXTXT="Build 'ASL' String Length Index"
+4 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+5 SET LEXRT=""
if $DATA(^LEX(757.01,"AWRD"))
SET LEXRT="^LEX(757.01,""AWRD"","
+6 if $DATA(^TMP("LEXAWRD",$JOB))
SET LEXRT="^TMP(""LEXAWRD"","_$JOB_","
if '$LENGTH(LEXRT)
QUIT
+7 ; For each Word
+8 SET (LEXFIR,LEXFC,LEXTK)=""
+9 FOR
SET LEXTK=$ORDER(@(LEXRT_""""_LEXTK_""")"))
if '$LENGTH(LEXTK)
QUIT
Begin DoDot:1
+10 NEW LEXP,LEXS,LEXC,LEXF,LEXTKN
SET LEXTKN=LEXTK
+11 FOR
if $EXTRACT(LEXTKN,1)'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,2,$LENGTH(LEXTKN))
+12 FOR
if $EXTRACT(LEXTKN,$LENGTH(LEXTKN))'=" "
QUIT
SET LEXTKN=$EXTRACT(LEXTKN,1,($LENGTH(LEXTKN)-1))
+13 SET LEXF=$EXTRACT(LEXTKN,1)
+14 SET LEXFIR=LEXF
if LEXFC'[LEXF
SET LEXFC=LEXFC_LEXF
+15 ; Count the occurrences of each string
+16 FOR LEXP=1:1:$LENGTH(LEXTKN)
SET LEXS=$$UP^XLFSTR($EXTRACT(LEXTKN,1,LEXP))
Begin DoDot:2
+17 if '$LENGTH($GET(LEXS))
QUIT
IF '$DATA(^TMP("LEXASLU",$JOB,LEXS))
Begin DoDot:3
+18 NEW LEXE,LEXM,LEXO,LEXT,LEXA,LEXN
SET (LEXA,LEXN,LEXT)=0
+19 SET LEXT=$$SCT(LEXS)
IF +($GET(LEXT))>0
Begin DoDot:4
+20 KILL ^TMP("LEXASL",$JOB,LEXS)
+21 SET ^TMP("LEXASL",$JOB,LEXS,LEXT)=""
End DoDot:4
End DoDot:3
+22 SET ^TMP("LEXASLU",$JOB,LEXS)=""
End DoDot:2
End DoDot:1
+23 HANG 1
SET LEXEND=$$END^LEXXGP1
DO SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
+24 SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)
SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)
+25 SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)
SET LEXENDT=$$ET^LEXXGP1(LEXEND)
SET LEXDF=$$DF^LEXXGP1(LEXBEG)
+26 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+27 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+28 SET LEXTXT=" "_LEXTXT
if '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+29 DO ASLR
IF $GET(LEXQUIT)="ASLB"
Begin DoDot:1
+30 if $DATA(LEXMAIL)
DO XM^LEXXGP3
+31 KILL ^TMP("LEXASL",$JOB),^TMP("LEXASLU",$JOB),^TMP("LEXAWRD",$JOB),^TMP("LEXAWRDU",$JOB)
+32 KILL ^TMP("LEXTKN",$JOB),^TMP("LEXXGPDAT",$JOB),^TMP("LEXXGPTIM",$JOB),^TMP("LEXXGPRPT",$JOB)
End DoDot:1
+33 QUIT
ASLR ; ASL String Length Index Replace 0.5 minutes
+1 NEW LEX1,LEX2,LEX3,LEXBEG,LEXBEGD,LEXBEGT,LEXC,LEXCHK,LEXCHR,LEXCHRS,LEXCOM,LEXCTL
+2 NEW LEXDF,LEXELP,LEXEND,LEXENDT,LEXIT,LEXLTKN,LEXND,LEXNOD,LEXSTR,LEXTK,LEXTK1
+3 NEW LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTMP,LEXTTKN,LEXTXT,LEXVAL
SET (LEX1,LEX2,LEX3)=0
+4 if '$DATA(LEXQUIT)
QUIT
SET LEXBEG=$$BEG^LEXXGP1
SET LEXTXT="Replace 'ASL' String Length Index"
+5 IF +($GET(ZTSK))>0
SET LEXCHK=$$S^%ZTLOAD((LEXTXT_" in file 757.01"))
+6 NEW LEXCHR,LEXCHRS
DO CHRS
SET LEXCHR=""
+7 FOR
SET LEXCHR=$ORDER(LEXCHRS(LEXCHR))
if '$LENGTH(LEXCHR)
QUIT
Begin DoDot:1
+8 ; For strings beginning with character
+9 NEW LEXLTKN,LEXTTKN,LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5,LEXTK,LEXIT
+10 ; Delete strings from the ^LEX global
+11 SET (LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5)=""
+12 SET LEXTK1=$CHAR($ASCII(LEXCHR)-1)_"~"
SET LEXTK2=LEXCHR
SET LEXTK3=LEXCHR_" "
+13 if LEXCHR?1N
SET LEXTK4=LEXCHR-.00000001
+14 if LEXCHR="."
SET LEXTK5=.00000001
+15 FOR LEXTK=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5
Begin DoDot:2
+16 if '$LENGTH(LEXTK)
QUIT
SET (LEXLTKN,LEXTTKN)=LEXTK
SET LEXIT=0
+17 FOR
SET LEXLTKN=$ORDER(^LEX(757.01,"ASL",LEXLTKN))
Begin DoDot:3
+18 if '$LENGTH(LEXLTKN)
SET LEXIT=1
if $EXTRACT(LEXLTKN,1)'=LEXCHR
SET LEXIT=1
+19 if LEXIT>0
QUIT
NEW LEXNOD,LEXCTL
+20 SET LEXNOD="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_")"
+21 SET LEXCTL="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_","
+22 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:4
+23 NEW LEXTMP,LEXND
SET LEXTMP=$TRANSLATE(LEXLTKN,"""","")
+24 SET LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXLTKN)_")"
+25 KILL @LEXND
SET LEX1=+($GET(LEX1))+1
End DoDot:4
End DoDot:3
if LEXIT>0
QUIT
End DoDot:2
+26 ; Add strings to the ^LEX global
+27 FOR LEXTTKN=LEXTK1,LEXTK2,LEXTK3,LEXTK4,LEXTK5
Begin DoDot:2
+28 if '$LENGTH(LEXTTKN)
QUIT
NEW LEXC,LEXIT
SET LEXIT=0
SET LEXC=LEXTTKN
+29 FOR
SET LEXTTKN=$ORDER(^TMP("LEXASL",$JOB,LEXTTKN))
if '$LENGTH(LEXTTKN)
QUIT
Begin DoDot:3
+30 if $EXTRACT(LEXTTKN,1)'=LEXCHR
QUIT
+31 NEW LEXNOD,LEXCTL
SET LEXNOD="^TMP(""LEXASL"","_$JOB_","_$$QQ(LEXTTKN)_")"
+32 SET LEXCTL="^TMP(""LEXASL"","_$JOB_","_$$QQ(LEXTTKN)_","
+33 FOR
SET LEXNOD=$QUERY(@LEXNOD)
if '$LENGTH(LEXNOD)!(LEXNOD'[LEXCTL)
QUIT
Begin DoDot:4
+34 NEW LEXSTR,LEXVAL,LEXND,LEXTMP
SET LEXSTR=$PIECE($PIECE(LEXNOD,(","_$JOB_","),2),",",1)
+35 SET LEXVAL=+$PIECE($PIECE(LEXNOD,(","_$JOB_","),2),",",2)
if '$LENGTH(LEXSTR)
QUIT
if +LEXVAL'>0
QUIT
+36 SET LEXTMP=$TRANSLATE(LEXSTR,"""","")
SET LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXTMP)_")"
KILL @LEXND
+37 SET LEXND="^LEX(757.01,""ASL"","_$$QQ(LEXTMP)_","_LEXVAL_")"
+38 SET @LEXND=""
SET LEX3=+($GET(LEX3))+1
End DoDot:4
End DoDot:3
if LEXIT>0
QUIT
End DoDot:2
+39 ; Repeat for all characters
End DoDot:1
+40 HANG 1
SET LEXEND=$$END^LEXXGP1
DO SAV^LEXXGP3(LEXBEG,LEXEND,LEXTXT)
+41 SET LEXELP=$$ELP^LEXXGP1(LEXBEG,LEXEND)
SET LEXBEGD=$$ED^LEXXGP1(LEXBEG)
+42 SET LEXBEGT=$$ET^LEXXGP1(LEXBEG)
SET LEXENDT=$$ET^LEXXGP1(LEXEND)
SET LEXDF=$$DF^LEXXGP1(LEXBEG)
+43 SET LEXTXT=$GET(LEXTXT)_$JUSTIFY(" ",(35-$LENGTH($GET(LEXTXT))))
+44 SET LEXTXT=LEXTXT_LEXDF_" "_LEXBEGT_" "_LEXENDT_" "_LEXELP
+45 SET LEXTXT=" "_LEXTXT
if '$DATA(ZTQUEUED)
WRITE !,LEXTXT
+46 IF LEX3>0
IF $DATA(LEXFUL)
Begin DoDot:1
+47 SET LEXCOM=LEX3_" 'ASL' Index Node"_$SELECT(LEX3>1:"s",1:"")
+48 DO SAV^LEXXGP3(LEXBEG,"","",LEXCOM)
if '$DATA(ZTQUEUED)
WRITE !," ",LEXCOM
End DoDot:1
+49 QUIT
+50 ;
+51 ; Miscellaneous
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
SCT(X) ; String Count (exact string)
+1 NEW LEX,LEXA,LEXE,LEXIT,LEXM,LEXN,LEXO,LEXOUT,LEXP,LEXRT,LEXRT2,LEXS,LEXT,LEXTKN
+2 SET LEXS=$$UP^XLFSTR($GET(X))
if '$LENGTH(LEXS)
QUIT 0
SET LEXRT=""
if $DATA(^LEX(757.01,"AWRD"))
SET LEXRT="^LEX(757.01,""AWRD"","
+3 if $DATA(^TMP("LEXAWRD",$JOB))
SET LEXRT="^TMP(""LEXAWRD"","_$JOB_","
if '$LENGTH(LEXRT)
QUIT 0
SET (LEXA,LEXN,LEXT)=0
+4 if $LENGTH(LEXS)>1
SET LEXO=$EXTRACT(LEXS,1,($LENGTH(LEXS)-1))_$CHAR(($ASCII($EXTRACT(LEXS,$LENGTH(LEXS)))-1))_"~"
+5 if $LENGTH(LEXS)=1
SET LEXO=$CHAR(($ASCII(LEXS)-1))_"~"
SET LEXIT=0
+6 FOR
SET LEXO=$ORDER(@(LEXRT_""""_LEXO_""")"))
Begin DoDot:1
+7 if '$LENGTH(LEXO)
SET LEXIT=1
if $EXTRACT(LEXO,1,$LENGTH(LEXS))'=LEXS
SET LEXIT=1
+8 if LEXIT>0
QUIT
NEW LEXM
SET LEXM=0
FOR
SET LEXM=$ORDER(@(LEXRT_""""_LEXO_""","_LEXM_")"))
if +LEXM'>0
QUIT
Begin DoDot:2
+9 NEW LEXE,LEXRT2
SET LEXE=0
SET LEXRT2=LEXRT_""""_LEXO_""","_LEXM_","
+10 FOR
SET LEXE=$ORDER(@(LEXRT2_LEXE_")"))
if +LEXE'>0
QUIT
SET LEXT=LEXT+1
SET LEXA=LEXA+1
End DoDot:2
End DoDot:1
if LEXIT>0
QUIT
+11 IF $TRANSLATE(LEXS,".","")?1N.N
IF $LENGTH(LEXS,".")'>2
IF +LEXS=LEXS
Begin DoDot:1
+12 NEW LEXFC
SET LEXFC=$EXTRACT(LEXS,1)
if $EXTRACT(LEXS,1)?1N
SET LEXO=LEXS-.000000001
+13 if $EXTRACT(LEXS,1)="."
SET LEXO=.000000001
SET LEXIT=0
+14 FOR
SET LEXO=$ORDER(@(LEXRT_+LEXO_")"))
Begin DoDot:2
+15 if LEXFC?1N&($EXTRACT(LEXO,1)'?1N)
SET LEXIT=1
+16 if LEXFC?1P&($EXTRACT(LEXO,1)'?1P)
SET LEXIT=1
if LEXIT>0
QUIT
+17 if '$LENGTH(LEXO)
QUIT
if $EXTRACT(LEXO,1,$LENGTH(LEXS))'=LEXS
QUIT
NEW LEXM
SET LEXM=0
+18 FOR
SET LEXM=$ORDER(@(LEXRT_+LEXO_","_LEXM_")"))
if +LEXM'>0
QUIT
Begin DoDot:3
+19 NEW LEXE,LEXRT2
SET LEXE=0
SET LEXRT2=LEXRT_+LEXO_","_LEXM_","
+20 FOR
SET LEXE=$ORDER(@(LEXRT2_LEXE_")"))
if +LEXE'>0
QUIT
SET LEXT=LEXT+1
SET LEXN=LEXN+1
End DoDot:3
End DoDot:2
if LEXIT>0
QUIT
if '$LENGTH(LEXO)
QUIT
End DoDot:1
+21 SET X=LEXT
+22 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(""LEXAWRD"","_$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
