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

LEXTOKN2.m

Go to the documentation of this file. 
  1. LEXTOKN2 ;ISL/KER - Parse term into words - Special Case ;04/21/2014
  1.  ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
  1.  ;               
  1.  ;               
  1.  ; Global Variables
  1.  ;    None
  1.  ;               
  1.  ; External References
  1.  ;    $$UP^XLFSTR         ICR  10104
  1.  ;               
  1.  ; Local Variables NEWed or KILLed Elsewhere
  1.  ;     LEXLOW   Set of lower case is needed (LEXNDX2)
  1.  ;               
  1.  Q
  1. SW(X) ; Special Case Word Swap
  1.  ;
  1.  ;   This sub-routine swaps one word for another
  1.  ;   This swap must apply to both Lookup and Indexing
  1.  ;   This swap only applies to uppercase text
  1.  ;   These words cannot be Replacement Words in file 757.05
  1.  ;   
  1.  N LEXTXT S (X,LEXTXT)=$G(X) Q:'$L(LEXTXT) X
  1.  I '$D(LEXLOW) D  Q X
  1.  . S (X,LEXTXT)=$$UP^XLFSTR(X) N LEXI
  1.  . F LEXI="X-RAY","X RAY" D
  1.  . . I LEXTXT[LEXI S LEXTXT=$$SWAP(LEXTXT,LEXI,"XRAY")
  1.  . F LEXI="E.COLI","E COLI","E. COLI" D
  1.  . . I LEXTXT[LEXI S LEXTXT=$$SWAP(LEXTXT,LEXI,"ECOLI")
  1.  . S X=$G(LEXTXT)
  1.  I $D(LEXLOW) D
  1.  . S (X,LEXTXT)=X N LEXI
  1.  . F LEXI="X-RAY","X RAY","X-Ray","X Ray","X-ray","X ray","x-ray","x ray" D
  1.  . . I LEXTXT[LEXI S LEXTXT=$$SWAP(LEXTXT,LEXI,"XRay")
  1.  . F LEXI="E COLI","E. COLI","E.COLI","ECOLI","E Coli","E. Coli","E.Coli","EColi" D
  1.  . . I LEXTXT[LEXI S LEXTXT=$$SWAP(LEXTXT,LEXI,"EColi")
  1.  . F LEXI="E coli","E. coli","E.coli","Ecoli","e coli","e. coli","e.coli","ecoli" D
  1.  . . I LEXTXT[LEXI S LEXTXT=$$SWAP(LEXTXT,LEXI,"EColi")
  1.  S X=LEXTXT
  1.  Q X
  1. SWAP(X,LEX1,LEX2) ; Swap text LEX1 for LEX2 in X
  1.  ; 
  1.  ; Input
  1.  ; 
  1.  ;    X      Text string
  1.  ;    LEX1   Word to remove in string (replace)
  1.  ;    LEX2   Word to insert in string (with)
  1.  ;    
  1.  ; Output
  1.  ; 
  1.  ;    X      Text string without LEX1
  1.  ;    
  1.  N LEXTXT,LEXNOT,LEXC,LEXLC,LEXTC S (X,LEXTXT)=$G(X) Q:'$L(LEXTXT) X  S LEX1=$G(LEX1)
  1.  Q:'$L(LEX1) X  S LEX2=$G(LEX2) Q:'$L(LEX2) X  Q:LEXTXT'[LEX1 X
  1.  S LEXNOT="~!@#$%^&*()_+`{}|[]\:;'<>?,./" I LEXTXT=LEX1 S X=LEX2 Q X
  1.  I $E(LEXTXT,1,$L(LEX1))=LEX1 D
  1.  . N LEXC S LEXC=$E(LEXTXT,($L(LEX1)+1)) Q:LEXC'=" "
  1.  . S LEXTXT=LEX2_$E(LEXTXT,($L(LEX1)+1),$L(LEXTXT))
  1.  F LEXLC=" ","-","(","<","{","[","," D
  1.  . N LEXO,LEXN F LEXTC=" ","-",")",">","}","]","," D
  1.  . . N LEXO,LEXN
  1.  . . S LEXO=LEXLC_LEX1_LEXTC,LEXN=LEXLC_LEX2_LEXTC
  1.  . . Q:LEXTXT'[LEXO
  1.  . . F  Q:LEXTXT'[LEXO  S LEXTXT=$P(LEXTXT,LEXO,1)_LEXN_$P(LEXTXT,LEXO,2)
  1.  . S LEXO=LEXLC_LEX1,LEXN=LEXLC_LEX2
  1.  . I LEXTXT[LEXO,$L($P(LEXTXT,LEXO,1)),'$L($P(LEXTXT,LEXO,2)) D
  1.  . . S LEXTXT=$P(LEXTXT,LEXO,1)_LEXN
  1.  S X=$G(LEXTXT)
  1.  Q X
  1. ORD ; Arrange in Frequency Order
  1.  ; 
  1.  ; Input
  1.  ;  
  1.  ;    ^TMP("LEXTKN",$J,#,WORD)=""
  1.  ;    
  1.  ;    Global array containing words parsed from text from
  1.  ;    API PTX^LEXTOKN
  1.  ;    
  1.  ;    "DIABETES MELLITUS KETOACIDOSIS" Parsed as:
  1.  ;    
  1.  ;       ^TMP("LEXTKN",$J,0)=3
  1.  ;       ^TMP("LEXTKN",$J,1,"DIABETES")=
  1.  ;       ^TMP("LEXTKN",$J,2,"MELLITUS")=
  1.  ;       ^TMP("LEXTKN",$J,3,"KETOACIDOSIS")=
  1.  ;    
  1.  ; Output
  1.  ; 
  1.  ;    ^TMP("LEXTKN",$J,#,WORD)=FREQ
  1.  ;    
  1.  ;    Global array containing words parsed from text arranged
  1.  ;    in order of the frequency of use, the least used word is
  1.  ;    first and the most frequently used word is last.
  1.  ;
  1.  ;    "DIABETES MELLITUS KETOACIDOSIS" Reordered to:
  1.  ;    
  1.  ;       ^TMP("LEXTKN",$J,0)=3
  1.  ;       ^TMP("LEXTKN",$J,1,"KETOACIDOSIS")=60
  1.  ;       ^TMP("LEXTKN",$J,2,"MELLITUS")=811
  1.  ;       ^TMP("LEXTKN",$J,3,"DIABETES")=1101
  1.  ;    
  1.  ; The Lexicon searches terms containing the least used word 
  1.  ; and checks to see if the remaining words are found in the
  1.  ; term.  Instead of checking 1101 terms for MELLITUS and 
  1.  ; KETOACIDOSIS, it will check 60 terms for DIABETES and MELLITUS.
  1.  ; 
  1.  N LEXI,LEXA,LEXC,LEXF S LEXI=0 F  S LEXI=$O(^TMP("LEXTKN",$J,LEXI)) Q:+LEXI'>0  D
  1.  . N LEXT S LEXT="" F  S LEXT=$O(^TMP("LEXTKN",$J,LEXI,LEXT)) Q:'$L(LEXT)  D
  1.  . . N LEXF S LEXF=+($O(^LEX(757.01,"ASL",LEXT,0))) Q:LEXF'>0  S LEXA(+LEXF,LEXT)=LEXF
  1.  K ^TMP("LEXTKN",$J) S LEXI=0 F  S LEXI=$O(LEXA(LEXI)) Q:+LEXI'>0  D
  1.  . N LEXT S LEXT="" F  S LEXT=$O(LEXA(LEXI,LEXT)) Q:'$L(LEXT)  D
  1.  . . N LEXC S LEXC=$O(^TMP("LEXTKN",$J," "),-1)+1,^TMP("LEXTKN",$J,LEXC,LEXT)=LEXI,^TMP("LEXTKN",$J,0)=LEXC
  1.  Q
  1. ST ; Show ^TMP("LEXTKN")
  1.  N LEXNN,LEXNC,LEXLOW S LEXNN="^TMP(""LEXTKN"","_$J_")",LEXNC="^TMP(""LEXTKN"","_$J_","
  1.  F  S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC)  W !,LEXNN,"=",@LEXNN
  1.  Q