Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEXXGP2

LEXXGP2.m

Go to the documentation of this file.
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