[613] | 1 | LEXTOLKN ; ISL Parse term into words ; 01-31-97
|
---|
| 2 | ;;2.0;LEXICON UTILITY;**4**;Sep 23, 1996;Build 1
|
---|
| 3 | ;
|
---|
| 4 | ; Returns ^TMP("LEXTKN",$J,#,WORD) containing words
|
---|
| 5 | ;
|
---|
| 6 | ; If LEXIDX is set, then the Excluded Words file is used to
|
---|
| 7 | ; selectively exclude words from the indexing process. If
|
---|
| 8 | ; LEXLOOK is set, then the Excluded Words file is used to
|
---|
| 9 | ; selectively exclude words from the look-up process. If
|
---|
| 10 | ; LEXIDX and LEXLOOK do not exist then all words are parsed
|
---|
| 11 | ; parsed.
|
---|
| 12 | ;
|
---|
| 13 | PT ; Entry point where DA is defined and X is unknown
|
---|
| 14 | Q:'$D(DA) S X=^LEX(757.01,DA,0)
|
---|
| 15 | PTX ; Entry point to parse string (X must exist)
|
---|
| 16 | N LEXOK,LEXTOKS,LEXTOKS2,LEXTOKI,LEXTOKW,LEXTOLKN
|
---|
| 17 | N LEXOKC,LEXOKN,LEXOKP
|
---|
| 18 | K ^TMP("LEXTKN",$J)
|
---|
| 19 | Q:'$L($G(X)) S LEXTOKS=$TR(X,"-"," ")
|
---|
| 20 | ; Remove leading blanks from string
|
---|
| 21 | F LEXOKP=1:1:$L(LEXTOKS) Q:$E(LEXTOKS,LEXOKP)'[" "
|
---|
| 22 | S LEXTOKS=$E(LEXTOKS,LEXOKP,$L(LEXTOKS))
|
---|
| 23 | ; Remove trailing blanks from string
|
---|
| 24 | F LEXOKP=$L(LEXTOKS):-1:1 Q:$E(LEXTOKS,LEXOKP)'[" "
|
---|
| 25 | S LEXTOKS=$E(LEXTOKS,1,LEXOKP)
|
---|
| 26 | ; Remove Punctuation (less slashes)
|
---|
| 27 | S LEXTOKS=$TR(LEXTOKS,"?`~!@#$%^&*()_-+={}[]\:;,<>"," ")
|
---|
| 28 | ; Conditionally remove slashes
|
---|
| 29 | S:$D(LEXIDX) LEXTOKS=$TR(LEXTOKS,"/"," ")
|
---|
| 30 | S LEXTOKS=$TR(LEXTOKS,".","")
|
---|
| 31 | S LEXTOKS=$TR(LEXTOKS,"""","")
|
---|
| 32 | ; Swtich to UPPERCASE (lower case is not specified by LEXLOW)
|
---|
| 33 | S:'$D(LEXLOW) LEXTOKS=$$UP^XLFSTR(LEXTOKS)
|
---|
| 34 | ; Store in temporary array (based on space character)
|
---|
| 35 | S LEXOKC=0 F LEXTOKI=1:1:$L(LEXTOKS," ") D
|
---|
| 36 | . N LEXTOKW S LEXTOKW=$P(LEXTOKS," ",LEXTOKI) Q:LEXTOKW=""
|
---|
| 37 | . I LEXTOKW'["/" D
|
---|
| 38 | . . S LEXOKC=LEXOKC+1,LEXTOLKN(LEXOKC)=LEXTOKW
|
---|
| 39 | . . S LEXTOLKN(0)=LEXOKC
|
---|
| 40 | . I LEXTOKW["/"&('$D(^LEX(757.05,"B",LEXTOKW))) D Q ; PCH 4
|
---|
| 41 | . . N LEXP S LEXP=0 F S LEXP=LEXP+1 Q:$P(LEXTOKW,"/",LEXP)="" D
|
---|
| 42 | . . . S LEXOKC=LEXOKC+1,LEXTOLKN(LEXOKC)=$P(LEXTOKW,"/",LEXP)
|
---|
| 43 | . . . S LEXTOLKN(0)=LEXOKC
|
---|
| 44 | . I LEXTOKW["/"&($D(^LEX(757.05,"B",LEXTOKW))) D
|
---|
| 45 | . . N LEXOKR S LEXOKR=$O(^LEX(757.05,"B",LEXTOKW,0))
|
---|
| 46 | . . I $P($G(^LEX(757.05,LEXOKR,0)),U,3)="R" D
|
---|
| 47 | . . . S LEXOKC=LEXOKC+1,LEXTOLKN(LEXOKC)=LEXTOKW
|
---|
| 48 | . . . S LEXTOLKN(0)=LEXOKC
|
---|
| 49 | K LEXOKC,LEXOKR
|
---|
| 50 | I +($G(LEXTOLKN(0)))=0 K LEXTOLKN S ^TMP("LEXTKN",$J,0)=0 G EXIT
|
---|
| 51 | S LEXTOKW="",LEXOKN=0 F LEXTOKI=1:1:LEXTOLKN(0) D
|
---|
| 52 | . S LEXTOKW=$G(LEXTOLKN(LEXTOKI))
|
---|
| 53 | . ; Remove leading blanks
|
---|
| 54 | . F LEXOKP=1:1:$L(LEXTOKW) Q:$E(LEXTOKW,LEXOKP)'[" "
|
---|
| 55 | . S LEXTOKW=$E(LEXTOKW,LEXOKP,$L(LEXTOKW))
|
---|
| 56 | . ; Remove trailing blanks
|
---|
| 57 | . F LEXOKP=$L(LEXTOKW):-1:1 Q:$E(LEXTOKW,LEXOKP)'[" "
|
---|
| 58 | . S LEXTOKW=$E(LEXTOKW,1,LEXOKP)
|
---|
| 59 | . ; Leading numerics or Zero
|
---|
| 60 | . ;I +LEXTOKW>0 S LEXTOKW="" Q
|
---|
| 61 | . I $A($E(LEXTOKW,1))=48 S LEXTOKW="" Q
|
---|
| 62 | . ; Apostrophies and spaces
|
---|
| 63 | . S LEXTOKW=$TR(LEXTOKW,"'",""),LEXTOKW=$TR(LEXTOKW," ","")
|
---|
| 64 | . ; Numeric only
|
---|
| 65 | . ;S LEXOK=0 F LEXOKP=1:1:$L(LEXTOKW) S:$E(LEXTOKW,LEXOKP)?1U LEXOK=1 Q:LEXOK=1
|
---|
| 66 | . ;I 'LEXOK S LEXTOKW="" Q
|
---|
| 67 | . I $D(LEXIDX) D
|
---|
| 68 | . . I LEXTOKW'="" S:$D(^LEX(757.04,"ACTION",LEXTOKW,"I")) LEXTOKW=""
|
---|
| 69 | . . I LEXTOKW'="" S:$D(^LEX(757.04,"ACTION",LEXTOKW,"B")) LEXTOKW=""
|
---|
| 70 | . I $D(LEXLOOK) D
|
---|
| 71 | . . I LEXTOKW'="" S:$D(^LEX(757.04,"ACTION",LEXTOKW,"L")) LEXTOKW=""
|
---|
| 72 | . . I LEXTOKW'="" S:$D(^LEX(757.04,"ACTION",LEXTOKW,"B")) LEXTOKW=""
|
---|
| 73 | . I $D(LEXOKN),$D(LEXTOKW),LEXTOKW'="" D
|
---|
| 74 | . . S LEXOKN=+(LEXOKN)+1,^TMP("LEXTKN",$J,LEXOKN,LEXTOKW)=""
|
---|
| 75 | . S LEXTOKW=""
|
---|
| 76 | S ^TMP("LEXTKN",$J,0)=LEXOKN
|
---|
| 77 | EXIT ; Clean up and quit
|
---|
| 78 | K LEXOK,LEXTOKI,LEXOKN,LEXOKP,LEXOKR,LEXTOKS,LEXTOKS2,LEXTOKW,LEXTOLKN
|
---|
| 79 | Q
|
---|