| [613] | 1 | XUA4A71(X) ;DFW/MRL - BETTER SOUNDEX ;1/3/95 16:18
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | ;Extrinsic function, Call with string, Returns converted string.
|
|---|
| 4 | G 1
|
|---|
| 5 | EN(X) ;EF,New SAC complient entry point
|
|---|
| 6 | 1 N D,E,F,I,I1,J,J1,L,S,T,W,X1,Z
|
|---|
| 7 | 2 S (E(1),E)="" F I=1:1:$L(X) S L=$E(X,I) Q:L="," I L?1A S:$A(L)>95 L=$C($A(L)-32) I L'=E(1) S E(1)=L,E=E_L ;make uppercase---keep only alpha---drop duplicate's
|
|---|
| 8 | S E="#"_E D CONV S F=$E(E,1,3) F I=4:2 Q:I>$L(E) I +$E(E,I-2,I-1)'=+$E(E,I,I+1) S F=F_$E(E,I,I+1)
|
|---|
| 9 | Q $E(F_"0000000000000",2,9)
|
|---|
| 10 | ;
|
|---|
| 11 | CONV ;Convert word to numerics (first four sounds)
|
|---|
| 12 | S X=$P($T(SH),";;",2),D=0 F I=1:1 S S=$P(X,";",I) Q:S']""!(D) F J="S","N" S F=S_J,T=31_$S(J="S":24,1:21) D E Q:D
|
|---|
| 13 | F F="TIARY","TEARY","TIARE","TEARE" S T=31_$E(F,2,5) D E Q:D
|
|---|
| 14 | S X=$P($T(END+1),";;",2) F I=1:1 S J=$P(X,";",I) Q:J']"" S F=$P(J,":",1),T=$P(J,":",2) D E Q:D
|
|---|
| 15 | ;F I=1,2 S X(I)=$P($T(VOWEL+I),";;",2)
|
|---|
| 16 | DOUB ;Double Vowels
|
|---|
| 17 | S D=0 F J=1,2 S X=$P($T(VOWEL+J),";;",2) D
|
|---|
| 18 | . F I=1:1 S X1=$P(X,";",I) Q:X1']"" I E[$P(X1,":",1) S D=1,F=$P(X1,":",1),T=$P(X1,":",2),E=$P(E,F,1)_T_$P(E,F,2)
|
|---|
| 19 | G DOUB:D
|
|---|
| 20 | F I="START","CHNG","END1","CHNG1" S W=$E(I) F I1=1:1 S X=$P($T(@I+I1),";;",2) Q:X']"" F J=1:1 S J1=$P(X,";",J) Q:J1']"" S F=$P(J1,":",1),T=$P(J1,":",2) I E[F D @W
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | C ;Change sound to another
|
|---|
| 24 | S E=$P(E,F,1)_T_$P(E,F,2,99) G C:E[F Q
|
|---|
| 25 | ;
|
|---|
| 26 | S ;Change 'Starts with' sound to another
|
|---|
| 27 | I $E(E,2,$L(F)+1)=F S E=$P(E,F,1)_T_$P(E,F,2)
|
|---|
| 28 | Q
|
|---|
| 29 | E ;Change 'Ends with' sound to another
|
|---|
| 30 | S Z=$L(E)-($L(F))+1,Z=$S(Z>1:Z,1:2) I $E(E,Z,$L(E))=F S E=$E(E,1,Z-1)_T,D=1
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | SH ;;TEOU;TIOU;TOU;TIOU;TU;TYOU;SHU;SHI;CHU;CHO;XIOU;XOU;XU;XIU;CIOU;COU;CU;CO;SIOU;CEOU;CE;XEOU;XE;SEOU;SHOU;CHOU;CHE;CHI;SU;TIO
|
|---|
| 34 | ;
|
|---|
| 35 | VOWEL ;
|
|---|
| 36 | ;;AE:A;AI:A;AO:O;AU:O;AW:O;AY:A;EA:E;EI:E;EO:O;EU:U;EW:U;EY:I;IA:A;IE:E;IO:I;IU:O;IW:I;IY:I;OA:O;OE:O;OI:O;OU:U;GH:;
|
|---|
| 37 | ;;OWE:O;OW:O;OY:O;UA:A;UE:U;UI:I;UO:O;UW:U;UY:I;WA:A;WE:E;WI:I;WO:O;WU:U;WY:I;YA:A;YE:E;YI:I;YO:O:YU:U;AA:A;EE:E;II:I;OO:O;UU:U;YY:I
|
|---|
| 38 | ;
|
|---|
| 39 | END ;
|
|---|
| 40 | ;;VOUS:1512;RTIAL:R3118;GUE:16;
|
|---|
| 41 | ;
|
|---|
| 42 | START ;
|
|---|
| 43 | ;;MAC:MC;WR:23:GU:16;QU:17;TH:14
|
|---|
| 44 | ;
|
|---|
| 45 | CHNG ;
|
|---|
| 46 | ;;PE:22;GU:16;CA:24A;CE:24E;CI:24I;CY:24Y;AL:18;EL:18;IL:18;OL:18;UL:18;WL:18;YL:18;AN:21;EN:21;IN:21;AR:23;AV:15;V:15;BH:13;BT:13;ED:14;ER:23;IM:19;IT:14;IR:23;OR:23;EM:19;YT:14
|
|---|
| 47 | ;;OM:19;ON:21;UR:23;US:24;ES:24;UN:21;GN:21;KN:21;LK:14;LM:19;LN:21;CHM:19;TSCH:31;TSH:31;TCH:31;TSCH:31;SCH:31;SH:31;CH:31;DJ:16;MB:19;MN:21;PHN:21;PH:15;PN:21;YR:23;YN:21
|
|---|
| 48 | ;;WH:12;YL:18;RH:23
|
|---|
| 49 | ;
|
|---|
| 50 | END1 ;
|
|---|
| 51 | ;;CE:24;ZE:24;TE:14;E;;ATES:24;ES:24;IS:24;OS:24;US:24;YS:24;WS:24;EZ:24;Z:24;TI:14;TY:14;CY:2411;CI:2411;TE:14;NTS:N24;21TS:2124;21T24:2124;S:24
|
|---|
| 52 | CHNG1 ;
|
|---|
| 53 | ;;A:11;B:13;C:17;D:14;E:11;F:15;G:16;H:;I:11;J:16;K:17;L:18;M:19;N:21;O:12;P:22;Q:17;R:23;S:24;T:14;U:12;V:15;W:12;X:24;Y:11;Z:24
|
|---|
