DCL SPCPTR .PARM1 PARM;
    DCL DD PARM-IN-MEMBER  CHAR(10) BAS(.PARM1);

DCL SPCPTR .PARM2 PARM;
    DCL DD PARM-IN-FILE    CHAR(10) BAS(.PARM2);

DCL SPCPTR .PARM3 PARM;
    DCL DD PARM-IN-LIBRARY CHAR(10) BAS(.PARM3);

DCL SPCPTR .PARM4 PARM;
    DCL DD PARM-INDEX      CHAR(10) BAS(.PARM4);

DCL SPCPTR .PARM5 PARM;
    DCL DD PARM-LIBRARY    CHAR(10) BAS(.PARM5);

DCL OL PARMS(.PARM1, .PARM2, .PARM3, .PARM4, .PARM5) EXT PARM MIN(5);

DCL SYSPTR .THE-IDX;
DCL DD RESOLVE CHAR(34);
    DCL DD RESOLVE-TYPE CHAR( 2) DEF(RESOLVE) POS( 1);
    DCL DD RESOLVE-NAME CHAR(30) DEF(RESOLVE) POS( 3);
    DCL DD RESOLVE-AUTH CHAR( 2) DEF(RESOLVE) POS(33) INIT(X'0000');

/********************************************************************/

ENTRY * (PARMS) EXT;

CHECK-IF-INDEX-EXISTS:
    CPYBLA       RESOLVE-TYPE, X'0401';
    CPYBLAP      RESOLVE-NAME, PARM-LIBRARY, " ";
    RSLVSP      .IDX-CONTEXT,  RESOLVE, *, *;

    CPYBLA       RESOLVE-TYPE, X'0E0A';
    CPYBLAP      RESOLVE-NAME, PARM-INDEX, " ";
    RSLVSP      .THE-IDX,  RESOLVE, .IDX-CONTEXT, *;

    B            OPEN-INPUT-FILE;

/************************  CREATE USER INDEX  ***********************/

DCL SPCPTR .IDX-DESCR INIT(IDX-DESCR);
DCL DD      IDX-DESCR CHAR(200) BDRY(16);
    DCL DD  IDX-BYTES-PROV        BIN(4) DEF(IDX-DESCR) POS(  1);
    DCL DD  IDX-BYTES-AVAIL       BIN(4) DEF(IDX-DESCR) POS(  5);
    DCL DD  IDX-OBJ-TYPE         CHAR(1) DEF(IDX-DESCR) POS(  9);
    DCL DD  IDX-OBJ-SUBTYPE      CHAR(1) DEF(IDX-DESCR) POS( 10);
    DCL DD  IDX-OBJ-NAME        CHAR(30) DEF(IDX-DESCR) POS( 11);
    DCL DD  IDX-CRT-OPTIONS      CHAR(4) DEF(IDX-DESCR) POS( 41);
    DCL DD  IDX-ASP-NUMBER        BIN(4) DEF(IDX-DESCR) POS( 45);
    DCL DD  IDX-SIZE-OF-SPACE     BIN(4) DEF(IDX-DESCR) POS( 49);
    DCL DD  IDX-INITIAL-VALUE    CHAR(1) DEF(IDX-DESCR) POS( 53);
    DCL DD  IDX-PERFM-OPTIONS    CHAR(4) DEF(IDX-DESCR) POS( 54);
    DCL DD  IDX-MBZ              CHAR(3) DEF(IDX-DESCR) POS( 58);
    DCL DD  IDX-EXT-OFFSET        BIN(4) DEF(IDX-DESCR) POS( 61);
    DCL SYSPTR .IDX-CONTEXT              DEF(IDX-DESCR) POS( 65);
    DCL SYSPTR .IDX-ACCESS-GROUP         DEF(IDX-DESCR) POS( 81);
    DCL DD  IDX-ATTRS            CHAR(1) DEF(IDX-DESCR) POS( 97);
    DCL DD  IDX-ENTRY-LENGTH      BIN(2) DEF(IDX-DESCR) POS( 98);
    DCL DD  IDX-KEY-LENGTH        BIN(2) DEF(IDX-DESCR) POS(100);

    DCL DD  IDX-EXT             CHAR(64) DEF(IDX-DESCR) POS(129);
        DCL DD  IDX-DOMAIN       CHAR(2) DEF(IDX-EXT)   POS(21);

DCL SPCPTR .UI-NAME-LIBRARY INIT(UI-NAME-LIBRARY);
DCL DD      UI-NAME-LIBRARY CHAR(20);
    DCL DD  UI-NAME     CHAR(10) DEF(UI-NAME-LIBRARY) POS( 1);
    DCL DD  UI-LIBRARY  CHAR(10) DEF(UI-NAME-LIBRARY) POS(11);

DCL SPCPTR .UI-ATTR     INIT(UI-ATTR);
DCL DD      UI-ATTR     CHAR(10) INIT("INDEX"); /* ARBITRARY ATTR */

DCL SPCPTR .UI-TYPE     INIT(UI-TYPE);
DCL DD      UI-TYPE     CHAR(1) INIT("F"); /* FIXED LENGTH */

DCL SPCPTR .UI-ENTRY-LENGTH INIT(UI-ENTRY-LENGTH);
DCL DD      UI-ENTRY-LENGTH BIN(4);

DCL SPCPTR .UI-KEYED    INIT(UI-KEYED);
DCL DD      UI-KEYED    CHAR(1) INIT("1"); /* INSERT KEYED */

DCL SPCPTR .UI-KEY-LENGTH INIT(UI-KEY-LENGTH);
DCL DD      UI-KEY-LENGTH BIN(4);

DCL SPCPTR .UI-UPDATE    INIT(UI-UPDATE);
DCL DD      UI-UPDATE    CHAR(1) INIT("0"); /* NO IMMEDIATE UPDATE */

DCL SPCPTR .UI-ACCESS    INIT(UI-ACCESS);
DCL DD      UI-ACCESS    CHAR(1) INIT("0");/* OPTIMIZE RANDOM ACCESS */

DCL SPCPTR .UI-AUTHORITY INIT(UI-AUTHORITY);
DCL DD      UI-AUTHORITY CHAR(10) INIT("*ALL"); /* ALL HAVE ACCESS */

DCL SPCPTR .UI-DESCRIPTION INIT(UI-DESCRIPTION);
DCL DD      UI-DESCRIPTION CHAR(50) INIT("My Index");

DCL SPCPTR .UI-REPLACE   INIT(UI-REPLACE);
DCL DD      UI-REPLACE   CHAR(10) INIT("*YES");/* REPLACE IF EXISTS */

DCL SPCPTR .UI-ERROR INIT(UI-ERROR);
DCL DD      UI-ERROR BIN(4) INIT(0); /* PERCOLATE ERROR */

DCL OL QUSCRTUI (.UI-NAME-LIBRARY,
                 .UI-ATTR,
                 .UI-TYPE,
                 .UI-ENTRY-LENGTH,
                 .UI-KEYED,
                 .UI-KEY-LENGTH,
                 .UI-UPDATE,
                 .UI-ACCESS,
                 .UI-AUTHORITY,
                 .UI-DESCRIPTION,
                 .UI-REPLACE,
                 .UI-ERROR) ARG;

DCL EXCM * EXCID(H'2201') BP(OBJECT-NOT-FOUND) CV(X'00000000') IMD;
OBJECT-NOT-FOUND:
    CMPBLA(B)    RESOLVE-TYPE, X'0401'/EQ(RETURN);
    CPYBLAP      IDX-OBJ-NAME, PARM-INDEX, " ";
    CPYBLA       IDX-OBJ-TYPE,     X'0E';      /* INDEX              */
    CPYBLA       IDX-OBJ-SUBTYPE,  X'0A';      /* USER INDEX         */
    CPYBLA       IDX-CRT-OPTIONS,  X'A0040000';/* PERMANENT, IN CTX  */
    CPYBLA       IDX-PERFM-OPTIONS,X'00000000';/* DEFAULTS           */
    CPYBLA       IDX-MBZ,          X'000000'  ;/* MUST BE ZEROES     */
    CPYBLA       IDX-ATTRS,        X'20';      /* FIXED, KEYED, SHORT*/
    CPYNV        IDX-ASP-NUMBER,     0;        /* USE SYSTEM ASP     */
    CPYNV        IDX-SIZE-OF-SPACE,  0;        /* INITIAL SPACE SIZE */
    CPYNV        IDX-ENTRY-LENGTH, 120;        /* KEY + DATA         */
    CPYNV        IDX-KEY-LENGTH,    40;        /* WORD + SEQ-NBR     */
    CPYNV        IDX-EXT-OFFSET,   128;        /* EXTENSION          */
    CPYBREP      IDX-EXT,    X'00';
    CPYBLA       IDX-DOMAIN, X'0001'; /* USER DOMAIN */

    CRTINX      .THE-IDX, .IDX-DESCR; /* CREATE INDEX, IF POSSIBLE */
    B            OPEN-INPUT-FILE;

DCL EXCM * EXCID(H'4401') BP(CREATE-INDEX-API) CV(X'00000000') IMD;
CREATE-INDEX-API:
    CPYBLA       UI-NAME,          PARM-INDEX;
    CPYBLA       UI-LIBRARY,       PARM-LIBRARY;
    CPYNV        UI-ENTRY-LENGTH, 120;
    CPYNV        UI-KEY-LENGTH,    40;
    CALLX       .SEPT(5389), QUSCRTUI, *;
    RSLVSP      .THE-IDX,  RESOLVE, .IDX-CONTEXT, *;
    B            OPEN-INPUT-FILE;

/**********************  READ AND INDEX THE FILE ********************/

DCL SPCPTR .ODP;
DCL SPC     ODP BAS(.ODP);
    DCL DD  ODP.DCB  BIN(4) DEF(ODP) POS(17);

DCL SPCPTR .DCB;
DCL SPC     DCB BAS(.DCB);
    DCL DD  DCB-GET  BIN(2) DEF (DCB) POS(25);
    DCL DD  DCB-PUT  BIN(2) DEF (DCB) POS(33);

DCL SPCPTR .NULL;
DCL SPCPTR @SEPT BASPCO;
DCL SYSPTR .SEPT(6440) BAS(@SEPT);

DCL SPCPTR .IFCB INIT(IFCB);
DCL DD IFCB CHAR(214) BDRY(16);
    DCL SPCPTR .IFCB-ODP               DEF(IFCB) POS(  1);
    DCL SPCPTR .IFCB-INBUF             DEF(IFCB) POS( 17);
    DCL DD IFCB-FILE          CHAR(10) DEF(IFCB) POS(129);
    DCL DD IFCB-LIB-ID        BIN(2)   DEF(IFCB) POS(139) INIT(72);
    DCL DD IFCB-LIBRARY       CHAR(10) DEF(IFCB) POS(141);
    DCL DD IFCB-MBR-ID        BIN(2)   DEF(IFCB) POS(151) INIT(73);
    DCL DD IFCB-MEMBER        CHAR(10) DEF(IFCB) POS(153);
    DCL DD IFCB-FLAGS-1       CHAR(1)  DEF(IFCB) POS(175) INIT(X'80');
    DCL DD IFCB-FLAGS-2       CHAR(1)  DEF(IFCB) POS(176) INIT(X'20');
    DCL DD IFCB-LENGTH-ID     BIN (2)  DEF(IFCB) POS(209) INIT(1);
    DCL DD IFCB-RECORD-LENGTH BIN (2)  DEF(IFCB) POS(211) INIT(92);
    DCL DD IFCB-NO-MORE-PARMS BIN (2)  DEF(IFCB) POS(213) INIT(32767);

DCL OL  OPEN-I(.IFCB) ARG;
DCL OL CLOSE-I(.IFCB) ARG;

DCL CON OPEN-ENTRY  BIN(2) INIT(12);
DCL CON CLOSE-ENTRY BIN(2) INIT(11);
DCL DD  GET-ENTRY   BIN(2);

DCL DD INBUF  CHAR(92) BAS(.IFCB-INBUF);
    DCL DD INDATA CHAR(80) DEF(INBUF) POS(13);

DCL DD      GET-OPTION BIN(4) INIT(H'03000001');
DCL SPCPTR .GET-OPTION        INIT(GET-OPTION);
DCL OL GET-OPERATION(.IFCB, .GET-OPTION, .NULL);

DCL DD THE-RECORD CHAR(82);
DCL DD REC-NBR    ZND(8,0);

OPEN-INPUT-FILE:
    CPYBWP      .NULL, *; /* MAKE NULL PTR */
    CPYNV        REC-NBR, 0;

    CPYBLA       IFCB-MEMBER,  PARM-IN-MEMBER;
    CPYBLA       IFCB-FILE,    PARM-IN-FILE;
    CPYBLA       IFCB-LIBRARY, PARM-IN-LIBRARY;
    CALLX       .SEPT(OPEN-ENTRY), OPEN-I, *;

    CPYBWP      .ODP, .IFCB-ODP;
    ADDSPP      .DCB, .ODP, ODP.DCB;
    CPYNV        GET-ENTRY, DCB-GET;

TRANSFORM-FILE:
    CALLX       .SEPT(GET-ENTRY), GET-OPERATION, *; /*AT END: EOF */
    ADDN(S)      REC-NBR, 1;
    CPYBLA       THE-RECORD(81:2), " ."; /* SENTINELS */
    XLATE        THE-RECORD(1:80), INDATA, '()[]{}:;,"/><!%^+=\',
                                           '                   ';
    CPYNV        FROM, 0;
EXTRACT-AND-PROCESS-WORD:
    CALLI        GET-A-WORD, *, .GET-A-WORD; /*AT END: TRANSFORM-FILE*/
    CALLI        PUT-A-WORD, *, .PUT-A-WORD;
    B            EXTRACT-AND-PROCESS-WORD;

DCL EXCM * EXCID(H'5001') BP(EOF) CV("CPF") IMD;
EOF: /* end of file */
    CALLX       .SEPT(CLOSE-ENTRY), CLOSE-I, *;
RETURN:
    RTX          *;

DCL INSPTR .GET-A-WORD;
ENTRY       GET-A-WORD INT;
START-A-WORD:
    CPYBREP      A-WORD, " ";
    CPYNV        TO, 0;
GET-FIRST-CHAR:
    ADDN(S)      FROM, 1;
    CMPBLA(B)    THE-RECORD(FROM:1), " "/EQ(GET-FIRST-CHAR);
    CMPNV(B)     FROM, 80/HI(TRANSFORM-FILE);

ADD-CHAR-TO-WORD:
    ADDN(S)      TO, 1;
    CPYBLA       A-WORD(TO:1), THE-RECORD(FROM:1);
    ADDN(S)      FROM, 1;
    CMPBLA(B)    THE-RECORD(FROM:1), " "/NEQ(ADD-CHAR-TO-WORD);

    CMPBLA(B)    A-WORD(TO:1), "."/NEQ(=+3);
    CPYBLA       A-WORD(TO:1), " ";
    SUBN(SB)     TO, 1/ZER(START-A-WORD);:

    CMPNV(B)     TO, 1/HI(=+2);
    VERIFY(B)    WHERE, A-WORD(1:1), "0123456789"/POS(START-A-WORD);:

CHECK-FOR-NOISE-WORD:
    SCAN(B)      WHERE, NOISE-WORDS, A-WORD(1:TO)/POS(START-A-WORD);
    B           .GET-A-WORD;

DCL DD NOISE-WORDS CHAR(128);
DCL DD *        (2) CHAR(64) DEF(NOISE-WORDS) POS(1) INIT(
  "DD DCL POS INIT DEF CHAR BIN SPCPTR SYSPTR PARM ENTRY INT EXT   ",
  "INSPTR BAS                                                      ");

DCL DD A-WORD CHAR(81);
DCL DD WHERE  BIN(4);
DCL DD FROM   BIN(2);
DCL DD TO     BIN(2);

DCL SPCPTR .ENTRIES INIT(ENTRIES);
DCL DD      ENTRIES(1) CHAR(120);
    DCL DD  THE-ENTRY          CHAR(120) DEF(ENTRIES) POS(1);
        DCL DD  THE-KEY         CHAR(40) DEF(THE-ENTRY) POS( 1);
            DCL DD THE-WORD     CHAR(25) DEF(THE-KEY)     POS( 1);
            DCL DD THE-MEMBER   CHAR(10) DEF(THE-KEY)     POS(26);
            DCL DD THE-LINE     CHAR(05) DEF(THE-KEY)     POS(36);
        DCL DD  THE-DATA        CHAR(80) DEF(THE-ENTRY) POS(41);

DCL SPCPTR .THE-OPTION INIT(THE-OPTION);
DCL DD      THE-OPTION  CHAR(14);
    DCL DD  RULE-OPTION  CHAR(2) DEF(THE-OPTION) POS( 1);
    DCL DD  DATA-LENGTH   BIN(2) DEF(THE-OPTION) POS( 3);
    DCL DD  DATA-OFFSET   BIN(2) DEF(THE-OPTION) POS( 5);
    DCL DD  WANTED-COUNT  BIN(2) DEF(THE-OPTION) POS( 7);
    DCL DD  RETURN-COUNT  BIN(2) DEF(THE-OPTION) POS( 9);
    DCL DD  ENTRY-LENGTH  BIN(2) DEF(THE-OPTION) POS(11) INIT(120);
    DCL DD  ENTRY-OFFSET  BIN(2) DEF(THE-OPTION) POS(13) INIT(0);

DCL INSPTR .PUT-A-WORD;
ENTRY       PUT-A-WORD INT;
    CPYBLA       THE-WORD,   A-WORD; /* TRUNCATE */
    CPYBLA       THE-MEMBER, IFCB-MEMBER;
    CPYBRA       THE-LINE,   REC-NBR;
    CPYBLA       THE-DATA,   INDATA;

    CPYBLA       RULE-OPTION, X'0002'; /* INSERT OR UPDATE */
    CPYNV        WANTED-COUNT, 1;      /* INSERT ONE ENTRY */
    INSINXEN    .THE-IDX, .ENTRIES, .THE-OPTION;
    B           .PUT-A-WORD;