*>
*> +============================================================================+
*> | S O U N D E X :    S C H L U E S S E L - E R Z E U G U N G                 |
*> +============================================================================+
*> | DIESES UNTERPROGRAMM ERZEUGT EINEN SOUNDEX-SCHLUESSEL FUER DIE SCHNELLERE  |
*> | KONTEXT-BEZOGENE SUCHE. DABEI WERDEN DIE ALPHANUMERISCHEN SCHLUESSEL IN    |
*> | EINEN SOUNDEX-KEY UMGEWANDELT. VOKALE WERDEN UNTERDRUECKT, SOWOHL AUCH DIE |
*> | BUCHSTABEN H, W UND Y, DIE KEINE BEDEUTUNG BEI DER SCHLUESSEL-ERZEUGUNG    |
*> | HABEN ...                                                                  |
*> +============================================================================+
*> | DATUM ERSTELLT:    2011-MAR-23                                             |
*> | AUTOR:             VEIT HEISE, PQM CONSULTING, D-63477 MAINTAL             |
*> | COPYRIGHT:         2011, ALL RIGHTS RESERVED. PQM-CONSULTING MAINTAL.      |
*> | VERSION:           2.3.1 (2015-11-26)                                      |
*> | REVISION 1.A:      MO DEZ 07 15:04:45 CET 2015                             |
*> +============================================================================+
IDENTIFICATION DIVISION.
PROGRAM-ID. SOUNDEX.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.    HP-PRO-BOOK-650G.
OBJECT-COMPUTER.    UBUNTU-64-BIT.
REPOSITORY.
    FUNCTION ALL INTRINSIC.
DATA DIVISION.
WORKING-STORAGE SECTION.
77  ZZ-ERROR                           PIC 99.
77  ZZ-ERRSTEP                         PIC 99.
77  ZZ-ERRMESSAGE                      PIC X(80).
77  ZZ-FILENAME                        PIC X(8).
77  ZZ-LINE                            PIC 99.
77  ZZ-COLUMN                          PIC 999.
77  ZZ-LEN                             PIC 99.
77  ZZ-COUNT                           PIC 99.
77  ZZ-IDX                             PIC 99.
77  ZZ-CODE                            PIC 9.
77  ANSWER                             PIC 9.
*> +==================================================================+
*> | A R G U M E N T E                                                |
*> +--------------+-----------+---------------------------------------+
*> | ZZ-START     | PIC X(40) | ALPHANUMERISCHER SCHLUESSEL (EINGABE) |
*> | ZZ-SOUNDEX   | PIC X(20) | SOUNDEX-KEY (AUSGABE)                 |
*> +==============+===========+=======================================+
LINKAGE SECTION.
01  ZZ-START                           PIC X(40).
01  ZZ-SOUNDEX                         PIC X(20).
PROCEDURE DIVISION USING ZZ-START, ZZ-SOUNDEX.
DECLARATIVES.
END DECLARATIVES.
STARTUP SECTION.
PROGRAM-START.
    MOVE STORED-CHAR-LENGTH(ZZ-START) TO ZZ-LEN.
    MOVE SPACES TO ZZ-SOUNDEX.
    MOVE 0 TO ZZ-COUNT ZZ-IDX.
    IF ZZ-LEN = 0 THEN
        MOVE 1 TO RETURN-CODE
        GOBACK
    END-IF.
    MOVE 2 TO ZZ-IDX.
    MOVE UPPER-CASE(ZZ-START) TO ZZ-START.
    MOVE ZZ-START(1:1) TO ZZ-SOUNDEX(1:1).
    PERFORM WITH TEST BEFORE
            VARYING ZZ-COUNT FROM 2 BY 1
            UNTIL ZZ-COUNT > ZZ-LEN
       PERFORM SOUNDEX-1 THRU SOUNDEX-XXX
       IF ZZ-IDX > 19 THEN EXIT PERFORM
    END-PERFORM.
PROGRAM-10.
    MOVE 0 TO RETURN-CODE.
    GOBACK.
*> +==================================+
*> | SOUNDEX-1 : SCHLUESSEL-ERZEUGUNG |
*> +==================================+
SOUNDEX-1.
    EVALUATE ZZ-START(ZZ-COUNT:1)
        WHEN 'B'
            MOVE 1 TO ZZ-CODE
        WHEN 'C'
            MOVE 2 TO ZZ-CODE
        WHEN 'D'
            MOVE 3 TO ZZ-CODE
        WHEN 'F'
            MOVE 1 TO ZZ-CODE
        WHEN 'G'
            MOVE 2 TO ZZ-CODE
        WHEN 'J'
            MOVE 2 TO ZZ-CODE
        WHEN 'K'
            MOVE 2 TO ZZ-CODE
        WHEN 'L'
            MOVE 4 TO ZZ-CODE
        WHEN 'M'
            MOVE 5 TO ZZ-CODE
        WHEN 'N'
            MOVE 5 TO ZZ-CODE
        WHEN 'P'
            MOVE 1 TO ZZ-CODE
        WHEN 'Q'
            MOVE 2 TO ZZ-CODE
        WHEN 'R'
            MOVE 6 TO ZZ-CODE
        WHEN 'S'
            MOVE 2 TO ZZ-CODE
        WHEN 'T'
            MOVE 3 TO ZZ-CODE
        WHEN 'V'
            MOVE 1 TO ZZ-CODE
        WHEN 'X'
            MOVE 2 TO ZZ-CODE
        WHEN 'Z'
            MOVE 2 TO ZZ-CODE
        WHEN 'ß'
            MOVE 2 TO ZZ-CODE
        WHEN OTHER
            MOVE 0 TO ZZ-CODE
    END-EVALUATE.
    EVALUATE ZZ-CODE
        WHEN 1
            MOVE '1' TO ZZ-SOUNDEX(ZZ-IDX:1)
            ADD 1 TO ZZ-IDX
        WHEN 2
            MOVE '2' TO ZZ-SOUNDEX(ZZ-IDX:1)
            ADD 1 TO ZZ-IDX
        WHEN 3
            MOVE '3' TO ZZ-SOUNDEX(ZZ-IDX:1)
            ADD 1 TO ZZ-IDX
        WHEN 4
            MOVE '4' TO ZZ-SOUNDEX(ZZ-IDX:1)
            ADD 1 TO ZZ-IDX
        WHEN 5
            MOVE '5' TO ZZ-SOUNDEX(ZZ-IDX:1)
            ADD 1 TO ZZ-IDX
        WHEN 6
            MOVE '6' TO ZZ-SOUNDEX(ZZ-IDX:1)
            ADD 1 TO ZZ-IDX
        WHEN OTHER
            PERFORM DO-NOTHING THRU DO-NOTHING-END
    END-EVALUATE.
    GO TO SOUNDEX-XXX.
SOUNDEX-XXX.
DO-NOTHING.
   MOVE ANSWER TO ANSWER.
DO-NOTHING-END.
END PROGRAM SOUNDEX.