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

LEXAS3.m

Go to the documentation of this file.
  1. LEXAS3 ;ISL/KER - Look-up Check Input (SHIFT) ;04/21/2014
  1. ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
  1. ;
  1. SHIFT(LEXX) ; Letters are shifted out of position
  1. ;
  1. ; LEXORG( Array of characters in the ORiGinal string
  1. ; LEXORD( Array of characters in the $O variable
  1. ; LEXE $E string
  1. ; LEXL Length
  1. ; LEXD Flag - Difference of strings
  1. ; LEXOK Flag - Shifted string is ok to use
  1. ; LEXO $O variable
  1. ; LEXI Incremental counter
  1. ; LEXX Returned value
  1. ;
  1. ;
  1. Q:$L(LEXX)<5 LEXX
  1. N LEXT,LEXE,LEXL,LEXO,LEXOK,LEXORG,LEXORD
  1. S LEXT=LEXX,LEXOK=0
  1. F LEXL=1:1:3 D SHF Q:LEXOK S LEXT=$E(LEXT,1,($L(LEXT)-1))
  1. K LEXORG,LEXORD
  1. S LEXX=LEXT
  1. Q LEXX
  1. ;
  1. SHF ; Shift letters in arrays
  1. K LEXORG D ORG(LEXT)
  1. S LEXE=$E(LEXT,1,2),LEXO=$$SCH^LEXAS6(LEXE)
  1. F S LEXO=$O(^LEX(757.01,"AWRD",LEXO)) Q:LEXO=""!(LEXO'[LEXE)!(LEXOK) D Q:LEXOK
  1. . Q:$L(LEXO)<$L(LEXT)!($L(LEXO)>($L(LEXT)+1))
  1. . N LEXD D ORD(LEXO) S LEXD=$$COMP
  1. . I LEXD S LEXOK=0 Q
  1. . I 'LEXD S LEXT=LEXO,LEXOK=1 Q
  1. Q
  1. ;
  1. ORG(LEXX) ; Original tolken
  1. K LEXORG N LEXI
  1. F LEXI=1:1:$L(LEXX) D
  1. . I $D(LEXORG($E(LEXX,LEXI))) D Q
  1. . . S LEXORG($E(LEXX,LEXI))=LEXORG($E(LEXX,LEXI))+1
  1. . S LEXORG($E(LEXX,LEXI))=1
  1. Q
  1. ORD(LEXO) ; Ordered tolken
  1. K LEXORD N LEXI
  1. F LEXI=1:1:$L(LEXO) D
  1. . I $D(LEXORD($E(LEXO,LEXI))) D Q
  1. . . S LEXORD($E(LEXO,LEXI))=LEXORD($E(LEXO,LEXI))+1
  1. . S LEXORD($E(LEXO,LEXI))=1
  1. Q
  1. COMP(LEXX) ; Compare Original to Ordered
  1. N LEXI,LEXD S LEXI="",LEXD=1
  1. F S LEXI=$O(LEXORG(LEXI)) Q:LEXI="" D Q:'LEXD
  1. . I '$D(LEXORD(LEXI)) S LEXD=0 Q
  1. . I LEXORG(LEXI)>LEXORD(LEXI) S LEXD=0
  1. I LEXD=0 K LEXORD Q 1
  1. S LEXI="",LEXD=1
  1. F S LEXI=$O(LEXORD(LEXI)) Q:LEXI="" D Q:'LEXD
  1. . ;I '$D(LEXORG(LEXI)) Q
  1. . I LEXORD(LEXI)>($G(LEXORG(LEXI))+1) S LEXD=0
  1. I LEXD=0 K LEXORD Q 1
  1. K LEXORD Q 0