source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXDDT2.m@ 1783

Last change on this file since 1783 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1LEXDDT2 ; ISL Display Defaults - Concatenate Text ; 09-23-96
2 ;;2.0;LEXICON UTILITY;;Sep 23, 1996
3 ;
4CONCAT ; Concatenation of Data Elements
5 N LEXTI,LEXTL,LEXTP
6PHRASE ; Get Phrase and Parse into Words
7 I $D(LEX(LEXT,"H")) S LEXTP=LEX(LEXT,"H"),LEXTI=0 D WORD
8 F LEXTI=1:1:LEX(LEXT,0) D
9 . S LEXTP=LEX(LEXT,LEXTI)
10 . S:LEXTP["/" LEXTP=$P(LEXTP,"/",1)_" or "_$P(LEXTP,"/",2),LEXTP=$$TRIM(LEXTP)
11 . I LEXTI=LEX(LEXT,0),LEX(LEXT,0)>1 D
12 . . S LEXTP="and "_LEXTP_"."
13 . . S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
14 . I LEXTI=LEX(LEXT,0),LEX(LEXT,0)'>1 D
15 . . S LEXTP=LEXTP_"."
16 . . S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
17 . D WORD I $L(LEXTSTR)>LEXSTLN D SET S LEXTSTR=""
18 I $D(LEX(LEXT,"T")) D
19 . F Q:$E(LEXTSTR,$L(LEXTSTR))'?1P S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1)) Q:$E(LEXTSTR,$L(LEXTSTR))'?1P
20 . S LEXTP=LEX(LEXT,"T"),LEXTI=0 D WORD
21 S LEXTSTR=$$TRIM(LEXTSTR)
22 Q
23WORD ; Concatenate Word
24 N LEXTW,LEXTD F LEXTD=1:1:$L(LEXTP," ") D
25 . S LEXTW=$P(LEXTP," ",LEXTD),LEXTW=$$TRIM(LEXTW)
26 . I LEXTD=$L(LEXTP," "),LEXTI>0 S LEXTW=LEXTW_","
27 . I ($L(LEXTSTR)+$L(LEXTW)+1)'>LEXSTLN D Q
28 . . S LEXTSTR=LEXTSTR_" "_LEXTW
29 . I ($L(LEXTSTR)+$L(LEXTW)+1)>LEXSTLN D
30 . . D SET S LEXTSTR=LEXTW
31 Q
32EOC ; End of Concatenation
33 F Q:$E(LEXTSTR,$L(LEXTSTR))'="," S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1)) Q:$E(LEXTSTR,$L(LEXTSTR))'=","
34 D SET
35 Q
36SET ; Set Array Node
37 S LEXTCTR=LEXTCTR+1 S LEX(LEXTCTR)=$$TRIM(LEXTSTR),LEX(0)=LEXTCTR
38 Q
39TRIM(X) ; Remove Spaces
40 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1)) Q:$E(X,$L(X))'=" "
41 F Q:$E(X,1)'=" " S X=$E(X,2,$L(X)) Q:$E(X,1)'=" "
42 Q X
Note: See TracBrowser for help on using the repository browser.