Home page  Up a level  Display Fields command source  Display Fields control language source  Display Fields display file source  Display Fields help PanelGroup source  Display Fields RPG Source  Display Fields printer file source  Display Fields CL Subprogram 1  Display Fields CL subprogram 2  Display Fields Logicals  Display Fields create command source

Display Fields RPG source

     H BNDDIR('JHDUTIL')
     H DFTACTGRP(*NO)
      **************************************************************************
      ***        NAME: DSPFLDR                                               ***
      *** DESCRIPTION: Display the fields and field attributes, key fields   ***
      *** and database relations for a file.  Separate windows show the key  ***
      *** fields, select/omit fields and values, and the database relations. ***
      *** Query/400 can be run on the file showing in the window.  A total   ***
      *** of four files can be loaded and scrolled through.  Files can be    ***
      *** closed and opened without exiting the program.  Pressing F14 will  ***
      *** show a window that lists all of the files with their key fields.   ***
      *** Pressing the Print key will print the file listing.  It will list  ***
      *** all of the fields, the key fields, and the database relations with ***
      *** their key fields.  A maximum of four files can be displayed at any ***
      *** one time.  These files can be requested one at a time after the    ***
      *** first one has been loaded or one to four can be entered in the     ***
      *** command to be displayed at once.                                   ***
      ***                                                                    ***
      *** Copyright 1995 by John H. Daily III                                ***
      **************************************************************************
      ***                             SUBROUTINES                            ***
      ***                                                                    ***
      *** Subroutine     Description                                         ***
      *** LoadControl    load the subfile control record information         ***
      *** LoadKeys       load the key fields to the key field subfile        ***
      *** LoadAccPaths   load the access paths to the file subfile           ***
      *** WriteLine      write a line to the file subfile                    ***
      *** CheckKeyLen    check the length of the key list field              ***
      *** LoadFields     load the fields to the field subfile                ***
      *** LoadSelOmit    load the select/omit fields to the sel/omit subfile ***
      *** LoadDBR        load the list of related files                      ***
      *** s1FunctKey     handle the function keys                            ***
      *** ShowDBR        show the data base relations subfile                ***
      *** DisplayDBR     display the associated files with the key fields    ***
      *** ChangeDate     change the date to mm/dd/yyyy                       ***
      *** PrintFile      print the field list and etc.                       ***
      *** CheckHeader    see if we need to print the heading                 ***
      *** ClearSFL       clear the field subfile                             ***
      *** DOQRY          run a query on a data base relation                 ***
      *** GetNewFile     allow the user to enter a new file                  ***
      *** ShowOpenFiles  show the open files and allow selection and closing ***
      *** *INZSR         program initialization                              ***
      **************************************************************************
      ***                        FUNCTION KEYS                               ***
      ***                                                                    ***
      *** FKey Usage                                                         ***
      *** F3   exit the program                                              ***
      *** F5   switch among up to four different files - initially only one  ***
      ***      is loaded so this key will do nothing                         ***
      *** F6   show the key fields in a window                               ***
      *** F7   show the select/omit fields in a window                       ***
      *** F8   show the database relations                                   ***
      *** F9   run Query/400 (RUNQRY) on the open file with record selection ***
      *** F11  allow the user to enter another library/file to load          ***
      *** F12  cancel - exit the current window or exit the program          ***
      *** F13  if the selected file is a logical, this key will alternate    ***
      ***      between the file size and the physical file name              ***
      *** F14  show the database relations with their key fields and allow   ***
      ***      selection of a file to switch to                              ***
      *** F17  position the field list subfile to a certain field            ***
      *** F20  show the loaded files and allow switching to and closing      ***
      *** F21  command line window                                           ***
      *** F23  close the current file                                        ***
      *** F24  show additional function keys                                 ***
      ***                                                                    ***
      *** Print prints the currently displayed file                          ***
      **************************************************************************

     FDSPFLDDF  CF   E             WORKSTN INFDS(DSPFDS)
     F                                     SFILE(SUBFIL01:S1RRN)
     F                                     SFILE(SUBFIL02:S2RRN)
     F                                     SFILE(SUBFIL03:S3RRN)
     F                                     SFILE(SUBFIL04:S4RRN)
     F                                     SFILE(KEYSFL01:K1RRN)
     F                                     SFILE(KEYSFL02:K2RRN)
     F                                     SFILE(KEYSFL03:K3RRN)
     F                                     SFILE(KEYSFL04:K4RRN)
     F                                     SFILE(SELSFL01:L1RRN)
     F                                     SFILE(SELSFL02:L2RRN)
     F                                     SFILE(SELSFL03:L3RRN)
     F                                     SFILE(SELSFL04:L4RRN)
     F                                     SFILE(DBRSFL01:S9RRN1)
     F                                     SFILE(DBRSFL02:S9RRN2)
     F                                     SFILE(DBRSFL03:S9RRN3)
     F                                     SFILE(DBRSFL04:S9RRN4)
     F                                     SFILE(FILSFL01:S5RRN1)
     F                                     SFILE(FILSFL02:S5RRN2)
     F                                     SFILE(FILSFL03:S5RRN3)
     F                                     SFILE(FILSFL04:S5RRN4)

      ***
      *** The actual field list.
      ***
     FFLDLST    UF   E             DISK

      ***
      *** Access paths.
      ***
     FACCPTH    UF   E             DISK

      ***
      *** Select/omit fields.
      ***
     FSELECT    UF   E             DISK

      ***
      *** Data base relations - used in F8=Relations
      ***
     FDSPFLDL1  UF   E           K DISK
     F                                     RENAME(QWHDRDBR:DBR)

      ***
      *** Field list by field name.
      ***
     FDSPFLDL   IF   E           K DISK
     F                                     RENAME(QWHDRFFD:DSPFLD)

      ***
      *** Access paths - used in F14=Associated files.
      ***
     FACCPTH1   UF   E             DISK
     F                                     RENAME(QWHFDACP:ACCPTHD)

      ***
      *** File attributes - used in F14=Associated files
      ***
     FDSPFLDL2  UF   E           K DISK
     F                                     RENAME(QWHFDLGL:ATR)

      ***
      *** File attributes for physical if main file is logical.
      ***
     FDSPFLDL3  UF   E           K DISK
     F                                     RENAME(QWHFDPHY:ATR1)

      ***
      *** Printer file.
      ***
     FDspFldPr  O    E             PRINTER INFDS(#PRTDS)
     F                                     USROPN

      **************************************************************************
      ***                        TABLES AND ARRAYS                           ***
      **************************************************************************
     D REL             S             10    Dim(900)                             DBR FILES/LIBS
     D LIB             S             10    Dim(900)
     D KEY             S             10    Dim(99)                              KEY FIELDS
     D NBR             S              2  0 Dim(99)
     D a1Select        S             50    Dim(99)
     D a2Select        S             50    Dim(99)
     D a3Select        S             50    Dim(99)
     D a4Select        S             50    Dim(99)

     D TAB1            S              1    Dim(13) CtData PerRcd(1)
     D TAB2            S              4    Dim(13) Alt(TAB1)
     D TAB3            S              1    Dim(3) CtData PerRcd(1)
     D TAB4            S             10    Dim(3) Alt(TAB3)
     D TAB5            S              1    Dim(9) CtData PerRcd(1)
     D TAB6            S              9    Dim(9) Alt(TAB5)

      **************************************************************************
      ***                           PROGRAM PARMS                            ***
      **************************************************************************
     D DSPFLDR         PR
     D                               10
     D                               10
     D                               10
     D                               10
     D                               10
     D                               10
     D                               10
     D                               10
     D                               50
     D                               13
     D                               13
     D                               13
     D                               15  0
     D                               10
     D                               10
     D                               10
     D                               13
     D                               13
     D                               10  0
     D                               20
     D                                1

     D DSPFLDR         PI
     D  p@File                       10
     D  p@Lib                        10
     D  p@File2                      10
     D  p@Lib2                       10
     D  p@File3                      10
     D  p@Lib3                       10
     D  p@File4                      10
     D  p@Lib4                       10
     D  p@Text                       50
     D  p@CreateDate                 13
     D  p@ChangeDate                 13
     D  p@SaveDate                   13
     D  p@Size1                      15  0
     D  p@SrcFile                    10
     D  p@SrcLib                     10
     D  p@SrcMember                  10
     D  p@SrcDate                    13
     D  p@SrcChange                  13
     D  p@RecordCount                10  0
     D  p@FileLib                    20
     D  p@Print                       1

      **************************************************************************
      ***                       PROCEDURE PROTOTYPES                         ***
      **************************************************************************
      ***
      *** External function prototypes.
      ***
     D gCapStr         PR           256
     D   p@Text                     256
     D   p@Format                     1

      ***
      *** Call command line.
      ***
     D CmdLine         PR                  Extpgm('QUSCMDLN')

      ***
      *** Execute command.
      ***
     D CommandExec     PR                  Extpgm('QCMDEXC')
     D   w@Cmd                      256
     D   w@CmdLen                    15  5

      ***
     D DspFields2      PR                  Extpgm('DSPFLD2')
     D  p@File                       10
     D  p@Lib                        10
     D  p@Text                       50
     D  p@CreateDate                 13
     D  p@ChangeDate                 13
     D  p@SaveDate                   13
     D  p@Size1                      15  0
     D  p@SrcFile                    10
     D  p@SrcLib                     10
     D  p@SrcMember                  10
     D  p@SrcDate                    13
     D  p@SrcChange                  13
     D  p@RecordCount                10  0

      **************************************************************************
      ***                     FILE I/O DATA STRUCTURES                       ***
      **************************************************************************
     D DSPFDS          DS
     D  w@FunctKey           369    369
     D  w@CursLoc            370    371B 0
     D  w@SflTop             378    379B 0
      ***
     D #PRTDS          DS
     D  w@LineCount          367    368B 0

      **************************************************************************
      ***                     INTERNAL DATA STRUCTURES                       ***
      **************************************************************************
     D                 DS
     D  #DATEI                 1     13
     D  #CENT                  1      1  0
     D  #YEAR                  2      3  0
     D  #MONTH                 4      5  0
     D  #DAY                   6      7  0
     D  #TIME                  8     13  0

      ***
     D                 DS
     D  #DATEO                 1      8  0
     D  #MM                    1      2  0
     D  #DD                    3      4  0
     D  #YY                    5      8  0

      **************************************************************************
      ***                             SWITCHES                               ***
      **************************************************************************
     D n@File1         S               N
     D n@File2         S               N
     D n@File3         S               N
     D n@File4         S               N
     D n@IN43          S               N

      **************************************************************************
      ***                           WORK FIELDS                              ***
      **************************************************************************
     D w@CurrFile      S              1  0
     D w@CurrHold      S              1  0
     D w@Text          S            256
     D w@Format        S              1
     D w5HoldFile1     S             10
     D w5HoldLib1      S             10
     D w5HoldFile2     S             10
     D w5HoldLib2      S             10
     D w5HoldFile3     S             10
     D w5HoldLib3      S             10
     D w5HoldFile4     S             10
     D w5HoldLib4      S             10
     D w@Text10        S             10
     D w@Cmd           S            256
     D w@CmdLen        S             15  5
     D w@Row           S              2  0
     D w@Col           S              3  0
     D w@Len           S              2  0
     D w@Rem           S              2  0
     D w@SaveName      S             10
     D w@Records       S                   Like(s1Records)
     D w@Records1      S                   Like(s1Records)
     D w@Size          S                   Like(s1Size)
     D w@Size1         S                   Like(s1Size)
     D w@FileCount     S              4  0
     D w@PrintLines    S              2  0
     D #SFTOP          S                   Like(w@SflTop)
     D X               S              3  0

      **************************************************************************
      ***                             CONSTANTS                              ***
      **************************************************************************
     D c@Up            C                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ ')
     D c@Down          C                   CONST('abcdefghijklmnopqrstuvwxyz ')

      ***
      *** Constants for printing headings.
      ***
     D c@PrintNormal   C                   59
     D c@PrintDbr      C                   55
     D c@PrintKeys     C                   57

      ***
      *** Query on selected logical file.
      ***
     D c@Query1        C                   CONST('RUNQRY QRYFILE((')
     D c@Query2        C                   CONST(')) RCDSLT(*YES)')
     D c@Query3        C                   CONST('))')

      ***
      *** Define the possible function key values.
      ***
     D F02             C                   CONST(X'32')
     D F03             C                   CONST(X'33')
     D F04             C                   CONST(X'34')
     D F05             C                   CONST(X'35')
     D F06             C                   CONST(X'36')
     D F07             C                   CONST(X'37')
     D F08             C                   CONST(X'38')
     D F09             C                   CONST(X'39')
     D F10             C                   CONST(X'3A')
     D F11             C                   CONST(X'3B')
     D F12             C                   CONST(X'3C')
     D F13             C                   CONST(X'B1')
     D F14             C                   CONST(X'B2')
     D F15             C                   CONST(X'B3')
     D F16             C                   CONST(X'B4')
     D F17             C                   CONST(X'B5')
     D F18             C                   CONST(X'B6')
     D F19             C                   CONST(X'B7')
     D F20             C                   CONST(X'B8')
     D F21             C                   CONST(X'B9')
     D F22             C                   CONST(X'BA')
     D F23             C                   CONST(X'BB')
     D F24             C                   CONST(X'BC')
     D FENTER          C                   CONST(X'F1')
     D FPRINT          C                   CONST(X'F6')

      **************************************************************************
      ***                    CALCULATION SPECIFICATIONS                      ***
      **************************************************************************

      /Free
        Exsr ClearSfl;
        Exsr LoadControl;
        Exsr LoadKeys;
        Exsr LoadFields;
        Exsr LoadSelOmit;
        Exsr LoadAccPaths;
        Exsr LoadDBR;

        //** Load any secondary files.

        If p@File2 <> *Blanks;
          s8File = p@File2;
          s8Lib = p@Lib2;
          w@FunctKey = FEnter;
          Exsr GetNewFile;
          w@CurrFile = 1;
        EndIf;

        If p@File3 <> *Blanks;
          s8File = p@File3;
          s8Lib = p@Lib3;
          w@FunctKey = FEnter;
          Exsr GetNewFile;
          w@CurrFile = 1;
        EndIf;

        If p@File4 <> *Blanks;
          s8File = p@File4;
          s8Lib = p@Lib4;
          w@FunctKey = FEnter;
          Exsr GetNewFile;
          w@CurrFile = 1;
        EndIf;

        //** If print only, just execute PrintFile subroutine, then exit.

        If p@Print = 'Y';
          Exsr PrintFile;
        Else;

          Dou w@FunctKey = F03 or w@FunctKey = F12;
            Write SubKey01;
            Select;
              When w@CurrFile = 1;
                Exfmt SubCtl01;
              When w@CurrFile = 2;
                Exfmt SubCtl02;
              When w@CurrFile = 3;
                Exfmt SubCtl03;
              When w@CurrFile = 4;
                Exfmt SubCtl04;
              Other;
                Write Scrn12;
                Exfmt SubCtl01;
              EndSl;
            Exsr s1FunctKey;
          EndDo;

        EndIf;

        *INLR = *ON;

        //**********************************************************************
        //** SUBROUTINE:  Set up the control record fields.                  ***
        //**ÍLoadControl¹                                                    ***
        //**********************************************************************
        Begsr LoadControl;


          //** Capitalize the first letter of each word in the text.

          w@Format = 'W';
          Clear w@Text;
          %Subst(w@Text : 1 : %Len(p@Text)) = p@Text;
          w@Text = gCapStr(w@Text : w@Format);

          //** Set up the create date.

          #DateI = p@CreateDate;
          Exsr ChangeDate;
          Select;
            When w@CurrFile = 1;
              s1CrtDate = #DateO;
              s1CrtTime = #Time;
            When w@CurrFile = 2;
              s2CrtDate = #DateO;
              s2CrtTime = #Time;
            When w@CurrFile = 3;
              s3CrtDate = #DateO;
              s3CrtTime = #Time;
            When w@CurrFile = 4;
              s4CrtDate = #DateO;
              s4CrtTime = #Time;
          EndSl;

          //** Set up the change date.

          #DateI = p@ChangeDate;
          Exsr ChangeDate;
          Select;
            When w@CurrFile = 1;
              s1ChgDate = #DateO;
              s1ChgTime = #Time;
            When w@CurrFile = 2;
              s2ChgDate = #DateO;
              s2ChgTime = #Time;
            When w@CurrFile = 3;
              s3ChgDate = #DateO;
              s3ChgTime = #Time;
            When w@CurrFile = 4;
              s4ChgDate = #DateO;
              s4ChgTime = #Time;
          EndSl;

          //** Set up the save date.

          #DateI = p@SaveDate;
          Exsr ChangeDate;
          Select;
            When w@CurrFile = 1;
              s1SaveDate = #DateO;
              s1SaveTime = #Time;
            When w@CurrFile = 2;
              s2SaveDate = #DateO;
              s2SaveTime = #Time;
            When w@CurrFile = 3;
              s3SaveDate = #DateO;
              s3SaveTime = #Time;
            When w@CurrFile = 4;
              s4SaveDate = #DateO;
              s4SaveTime = #Time;
          EndSl;

          //** Set up the source date.

          #DateI = p@SrcDate;
          Exsr ChangeDate;
          Select;
            When w@CurrFile = 1;
              s1SrcDate = #DateO;
              s1SrcTime = #Time;
            When w@CurrFile = 2;
              s2SrcDate = #DateO;
              s2SrcTime = #Time;
            When w@CurrFile = 3;
              s3SrcDate = #DateO;
              s3SrcTime = #Time;
            When w@CurrFile = 4;
              s4SrcDate = #DateO;
              s4SrcTime = #Time;
          EndSl;

          //** Set up the source change date.

          #DateI = p@SrcChange;
          Exsr ChangeDate;
          Select;
            When w@CurrFile = 1;
              s1OrgSrcDt = #DateO;
              s1OrgSrcTm = #Time;
            When w@CurrFile = 2;
              s2OrgSrcDt = #DateO;
              s2OrgSrcTm = #Time;
            When w@CurrFile = 3;
              s3OrgSrcDt = #DateO;
              s3OrgSrcTm = #Time;
            When w@CurrFile = 4;
              s4OrgSrcDt = #DateO;
              s4OrgSrcTm = #Time;
          EndSl;

          //** Edit the number of records and the file size - left justify.

          Clear w@Records1;
          Clear w@Records;
          w@Records1 = %EditC(p@RecordCount : '1');
          %Subst(w@Records : 1 : %Len(%Trim(w@Records1))) = %Trim(w@Records1);

          Clear w@Size1;
          Clear w@Size;
          w@Size1 = %EditC(p@Size1 : '1');
          %Subst(w@Size : 1 : %Len(%Trim(w@Size1))) = %Trim(w@Size1);

          //** Move the edited fields to the display.

          Select;
            When w@CurrFile = 1;
              s1Records = w@Records;
              s1Size = w@Size;
              s1File = p@File;
              s1Lib = p@Lib;
              s1SrcFile = p@SrcFile;
              s1SrcLib = p@SrcLib;
              s1SrcMbr = p@SrcMember;
              s1PgmText = w@Text;

            When w@CurrFile = 2;
              s2Records = w@Records;
              s2Size = w@Size;
              s2File = p@File;
              s2Lib = p@Lib;
              s2SrcFile = p@SrcFile;
              s2SrcLib = p@SrcLib;
              s2SrcMbr = p@SrcMember;
              s2PgmText = w@Text;

            When w@CurrFile = 3;
              s3Records = w@Records;
              s3Size = w@Size;
              s3File = p@File;
              s3Lib = p@Lib;
              s3SrcFile = p@SrcFile;
              s3SrcLib = p@SrcLib;
              s3SrcMbr = p@SrcMember;
              s3PgmText = w@Text;

            When w@CurrFile = 4;
              s4Records = w@Records;
              s4Size = w@Size;
              s4File = p@File;
              s4Lib = p@Lib;
              s4SrcFile = p@SrcFile;
              s4SrcLib = p@SrcLib;
              s4SrcMbr = p@SrcMember;
              s4PgmText = w@Text;

          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Load the key fields from the ACCPTH file.          ***
        //**ÍLoadKeys¹                                                       ***
        //**********************************************************************
        Begsr LoadKeys;

          //** Clear the key fields array.

          Clear Key;

          SetLL 1 AccPth;
          Read AccPth;

          If Not %EOF(AccPth);

            //** If the field is a key field....

            If apaccp = 'K';
              If apbof <> *Blanks;
                Select;
                  When w@CurrFile = 1;
                    s1Phys = apbof;
                  When w@CurrFile = 2;
                    s2Phys = apbof;
                  When w@CurrFile = 3;
                    s3Phys = apbof;
                  When w@CurrFile = 4;
                    s4Phys = apbof;
                EndSl;
              EndIf;

              Dow Not %Eof(AccPth);

                //** Load the key fields into an array.

                X = %Lookup(' ' : Key);
                Key(X) = apkeyf;
                Nbr(X) = apkeyn;

                Chain apkeyf DspFldL;
                w@Text10 = %Subst(whftxt : 1 : 10);
                If w@Text10 = whflde or w@Text10 = whfldi;
                  Clear whftxt;
                  whftxt = %Trim(whchd1) + ' ' + %Trim(whchd2) + ' '
                     + whchd3;
                EndIf;

                //** Capitalize each word in the text.

                w@Format = 'W';
                Clear w@Text;
                %Subst(w@Text : 1 : %Len(%Trim(whftxt))) = %Trim(whftxt);
                w@Text = gCapStr(w@Text : w@Format);
                whftxt = w@Text;

                //** Move the fields to the key subfile.

                Select;
                  When w@CurrFile = 1;
                    k1KeyNbr = apkeyn;
                    k1KeyField = apkeyf;
                    k1AscDesc = apkseq;
                    k1Text = whftxt;
                    eval k1rrn = k1rrn + 1;
                    Write KeySfl01;
                    *IN65 = *ON;

                  When w@CurrFile = 2;
                    k2KeyNbr = apkeyn;
                    k2KeyField = apkeyf;
                    k2AscDesc = apkseq;
                    k2Text = whftxt;
                    eval k2rrn = k2rrn + 1;
                    Write KeySfl02;
                    *IN66 = *ON;

                  When w@CurrFile = 3;
                    k3KeyNbr = apkeyn;
                    k3KeyField = apkeyf;
                    k3AscDesc = apkseq;
                    k3Text = whftxt;
                    eval k3rrn = k3rrn + 1;
                    Write KeySfl03;
                    *IN67 = *ON;

                  When w@CurrFile = 4;
                    k4KeyNbr = apkeyn;
                    k4KeyField = apkeyf;
                    k4AscDesc = apkseq;
                    k4Text = whftxt;
                    eval k4rrn = k4rrn + 1;
                    Write KeySfl04;
                    *IN68 = *ON;

                EndSl;

                Delete AccPth;
                Read AccPth;
              EndDo;

            //** Else it's not a key field.

            Else;
              Delete AccPth;
              *IN99 = *ON;
            EndIf;

            //** Else it's not a key field.

            Select;
              When w@Currfile = 1 and *IN65;
                k1rrn = 1;
              When w@Currfile = 2 and *IN66;
                k2rrn = 1;
              When w@Currfile = 3 and *IN67;
                k3rrn = 1;
              When w@Currfile = 4 and *IN68;
                k4rrn = 1;
              When w@Currfile = 1 and Not *IN65;
                Clear k1rrn;
              When w@Currfile = 2 and Not *IN66;
                Clear k2rrn;
              When w@Currfile = 3 and Not *IN67;
                Clear k3rrn;
              When w@Currfile = 4 and Not *IN68;
                Clear k4rrn;
            EndSl;

          EndIf;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Load data base relation/key fields subfile.        ***
        //**ÍLoadAccPaths¹                                                   ***
        //**********************************************************************
        Begsr LoadAccPaths;

          //** Load the subfile.

          SetLL 1 AccPth1;
          Read AccPth1;

          //** Set up the file and library.

          Select;
            When w@CurrFile = 1;
              Clear s5rrn1;
              s5File1 = apfile;
              s5Lib1 = aplib;
            When w@CurrFile = 2;
              Clear s5rrn2;
              s5File2 = apfile;
              s5Lib2 = aplib;
            When w@CurrFile = 3;
              Clear s5rrn3;
              s5File3 = apfile;
              s5Lib3 = aplib;
            When w@CurrFile = 4;
              Clear s5rrn4;
              s5File4 = apfile;
              s5Lib4 = aplib;
          EndSl;

          Clear X;

          //** Write the first line.

          Exsr WriteLine;

          Dow Not %EOF(AccPth1);

            //** Print key list line if file or lib changes.

            If w@CurrFile = 1 and
                 (apFile <> w5HoldFile1 or apLib <> w5HoldLib1)
                 or w@CurrFile = 2 and
                    (apFile <> w5HoldFile2 or apLib <> w5HoldLib2)
                 or w@CurrFile = 3 and
                    (apFile <> w5HoldFile3 or apLib <> w5HoldLib3)
                 or w@CurrFile = 4 and
                    (apFile <> w5HoldFile4 or apLib <> w5HoldLib4);

              Select;
                When w@CurrFile = 1;
                  s5rrn1 = s5rrn1 + 1;
                  If s5Text1 = 'Key:';
                    s5Text1 = %Trim(s5Text1) + ' *NONE';
                  EndIf;
                  Write FilSfl01;
                  *IN71 = *ON;
                  s5File1 = apfile;
                  s5Lib1 = aplib;

                When w@CurrFile = 2;
                  s5rrn2 = s5rrn2 + 1;
                  If s5Text2 = 'Key:';
                    s5Text2 = %Trim(s5Text2) + ' *NONE';
                  EndIf;
                  Write FilSfl02;
                  *IN72 = *ON;
                  s5File2 = apfile;
                  s5Lib2 = aplib;

                When w@CurrFile = 3;
                  s5rrn3 = s5rrn3 + 1;
                  If s5Text3 = 'Key:';
                    s5Text3 = %Trim(s5Text3) + ' *NONE';
                  EndIf;
                  Write FilSfl03;
                  *IN73 = *ON;
                  s5File3 = apfile;
                  s5Lib3 = aplib;

                When w@CurrFile = 4;
                  s5rrn4 = s5rrn4 + 1;
                  If s5Text4 = 'Key:';
                    s5Text4 = %Trim(s5Text4) + ' *NONE';
                  EndIf;
                  Write FilSfl04;
                  *IN74 = *ON;
                  s5File4 = apfile;
                  s5Lib4 = aplib;
              EndSl;

              Exsr WriteLine;

              Select;
                When w@CurrFile = 1;
                  s5Text1 = 'Key: ' + apkeyf;
                When w@CurrFile = 2;
                  s5Text2 = 'Key: ' + apkeyf;
                When w@CurrFile = 3;
                  s5Text3 = 'Key: ' + apkeyf;
                When w@CurrFile = 4;
                  s5Text4 = 'Key: ' + apkeyf;
              EndSl;

            Else;

              //** Otherwise, start accumulating the key fields.

              Exsr CheckKeyLen;
            EndIf;

            Delete AccPth1;
            Read AccPth1;
          EndDo;

          //** Show *NONE if there are no key fields.

          Select;
            When w@CurrFile = 1 and s5Text1 = 'Key:';
              s5Text1 = 'Key: ' + '*NONE';
            When w@CurrFile = 2 and s5Text2 = 'Key:';
              s5Text2 = 'Key: ' + '*NONE';
            When w@CurrFile = 3 and s5Text3 = 'Key:';
              s5Text3 = 'Key: ' + '*NONE';
            When w@CurrFile = 4 and s5Text4 = 'Key:';
              s5Text4 = 'Key: ' + '*NONE';
          EndSl;

          //** Write the last line.

          Select;
            When w@CurrFile = 1;
              s5rrn1 = s5rrn1 + 1;
              Write FilSfl01;
              *IN71 = *On;
              s5rrn1 = 1;
            When w@CurrFile = 2;
              s5rrn2 = s5rrn2 + 1;
              Write FilSfl02;
              *IN72 = *On;
              s5rrn2 = 1;
            When w@CurrFile = 3;
              s5rrn3 = s5rrn3 + 1;
              Write FilSfl03;
              *IN73 = *On;
              s5rrn3 = 1;
            When w@CurrFile = 4;
              s5rrn4 = s5rrn4 + 1;
              Write FilSfl04;
              *IN74 = *On;
              s5rrn4 = 1;
          EndSl;

          //** Load the Select/Omit fields.

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Write a line to the file subfile.                  ***
        //**ÍWriteLine¹                                                      ***
        //**********************************************************************
        Begsr WriteLine;

          //** Clear the color indicators.

          Clear *IN36;
          Clear *IN37;
          Clear *IN38;

          Select;
            When w@CurrFile = 1;
              s5rrn1 = s5rrn1 + 1;

            When w@CurrFile = 2;
              s5rrn2 = s5rrn2 + 1;

            When w@CurrFile = 3;
              s5rrn3 = s5rrn3 + 1;

            When w@CurrFile = 4;
              s5rrn4 = s5rrn4 + 1;
          EndSl;

          //** Get the text for the file from either the ATR(logicals)
          //** file...

          Chain AtrKey ATR;
          If %Found;
            Select;
              When w@CurrFile = 1;
                s5Text1 = lgtxt;
              When w@CurrFile = 2;
                s5Text2 = lgtxt;
              When w@CurrFile = 3;
                s5Text3 = lgtxt;
              When w@CurrFile = 4;
                s5Text4 = lgtxt;
            EndSl;
            Delete Atr;

          Else;

            //** ...or the ATR1(physicals) file.

            Chain AtrKey Atr1;
            If %Found;
              Select;
                When w@CurrFile = 1;
                  s5Text1 = phtxt;
                When w@CurrFile = 2;
                  s5Text2 = phtxt;
                When w@CurrFile = 3;
                  s5Text3 = phtxt;
                When w@CurrFile = 4;
                  s5Text4 = phtxt;
              EndSl;
              Delete Atr1;
            EndIf;
          EndIf;

          //** Write the subfile line and save the key fields.

          Select;
            When w@CurrFile = 1;
              Write FilSfl01;
              *IN71 = *On;
              w5HoldFile1 = apfile;
              w5HoldLib1 = aplib;
              Clear s5File1;
              Clear s5Lib1;
              Clear s5Text1;

            When w@CurrFile = 2;
              Write FilSfl02;
              *IN72 = *On;
              w5HoldFile2 = apfile;
              w5HoldLib2 = aplib;
              Clear s5File2;
              Clear s5Lib2;
              Clear s5Text2;

            When w@CurrFile = 3;
              Write FilSfl03;
              *IN73 = *On;
              w5HoldFile3 = apfile;
              w5HoldLib3 = aplib;
              Clear s5File3;
              Clear s5Lib3;
              Clear s5Text3;

            When w@CurrFile = 4;
              Write FilSfl04;
              *IN74 = *On;
              w5HoldFile4 = apfile;
              w5HoldLib4 = aplib;
              Clear s5File4;
              Clear s5Lib4;
              Clear s5Text4;
          EndSl;

          //** Set the color indicators on.

          *IN36 = *ON;
          *IN37 = *ON;
          *IN38 = *ON;

          //** Set up the first key field line.

          Select;
            When w@CurrFile = 1;
              s5File1 = 'Format:';
              s5Lib1 = whname;
              s5Text1 = 'Key:';
            When w@CurrFile = 2;
              s5File2 = 'Format:';
              s5Lib2 = whname;
              s5Text2 = 'Key:';
            When w@CurrFile = 3;
              s5File3 = 'Format:';
              s5Lib3 = whname;
              s5Text3 = 'Key:';
            When w@CurrFile = 4;
              s5File4 = 'Format:';
              s5Lib4 = whname;
              s5Text4 = 'Key:';
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Close the current file.                            ***
        //**ÍCloseFile¹                                                      ***
        //**********************************************************************
        Begsr CloseFile;

          n@IN43 = *IN43;
          *IN43 = *OFF;
          *IN42 = *ON;
          Select;
            When w@CurrFile = 1;
              Clear s5Opt1;
              Write SubCtl01;
              Write KeyCtl01;
              Write SelCtl01;
              Write FilCtl01;
              Write DbrCtl01;

              Clear SubCtl01;
              Clear KeyCtl01;
              Clear SelCtl01;
              Clear FilCtl01;
              Clear DbrCtl01;

              Clear *IN44;
              Clear *IN65;
              Clear *IN65;
              Clear *IN51;
              Clear *IN71;
              Clear *IN81;
              Clear n@File1;

            When w@CurrFile = 2;
              Clear s5Opt2;
              Write SubCtl02;
              Write KeyCtl02;
              Write SelCtl02;
              Write FilCtl02;
              Write DbrCtl02;
              Clear SubCtl02;
              Clear KeyCtl02;
              Clear SelCtl02;
              Clear FilCtl02;
              Clear DbrCtl02;

              Clear *IN48;
              Clear *IN66;
              Clear *IN52;
              Clear *IN72;
              Clear *IN82;
              Clear n@File2;

            When w@CurrFile = 3;
              Clear s5Opt3;
              Write SubCtl03;
              Write KeyCtl03;
              Write SelCtl03;
              Write FilCtl03;
              Write DbrCtl03;
              Clear SubCtl03;
              Clear KeyCtl03;
              Clear SelCtl03;
              Clear FilCtl03;
              Clear DbrCtl03;

              Clear *IN50;
              Clear *IN67;
              Clear *IN53;
              Clear *IN73;
              Clear *IN83;
              Clear n@File3;

            When w@CurrFile = 4;
              Clear s5Opt4;
              Write SubCtl04;
              Write KeyCtl04;
              Write SelCtl04;
              Write FilCtl04;
              Write DbrCtl04;
              Clear SubCtl04;
              Clear KeyCtl04;
              Clear SelCtl04;
              Clear FilCtl04;
              Clear DbrCtl04;

              Clear *IN56;
              Clear *IN68;
              Clear *IN54;
              Clear *IN74;
              Clear *IN84;
              Clear n@File4;
          EndSl;

          Clear *IN42;
          *IN43 = n@IN43;

          //** Set the current file to the first file.

          Select;
            When s1File <> *Blanks;
              w@CurrFile = 1;
            When s2File <> *Blanks;
              w@CurrFile = 2;
            When s3File <> *Blanks;
              w@CurrFile = 3;
            When s4File <> *Blanks;
              w@CurrFile = 4;
          EndSl;

          //** Reduce the file counter by one.

          w@FileCount = w@FileCount - 1;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Check the length of the key list field.            ***
        //**ÍCheckKeyLen¹                                                    ***
        //**********************************************************************

        Begsr CheckKeyLen;

          Select;
            When w@CurrFile = 1;

              //** If the last ten characters of the text, which holds the
              //** key fields, is not blank then write the text, clear the
              //** fields and start the new key field line in the same
              //** position as the key fields in the previous line.

              If %Subst(s5Text1 : 41 : 10) <> *Blanks;
                s5rrn1 = s5rrn1 + 1;
                Write FilSfl01;
                *IN71 = *On;
                Clear s5File1;
                Clear s5Lib1;
                Clear s5Text1;
                %Subst(s5Text1 : 6 : 10) = apkeyf;

              //** Otherwise, just add the key field to the end.

              Else;
                s5Text1 = %TrimR(s5Text1) + ' ' + apkeyf;
              EndIf;

            When w@CurrFile = 2;
              If %Subst(s5Text2 : 41 : 10) <> *Blanks;
                s5rrn2 = s5rrn2 + 1;
                Write FilSfl02;
                *IN72 = *On;
                Clear s5File2;
                Clear s5Lib2;
                Clear s5Text2;
                %Subst(s5Text2 : 6 : 10) = apkeyf;
              Else;
                s5Text2 = %TrimR(s5Text2) + ' ' + apkeyf;
              EndIf;

            When w@CurrFile = 3;
              If %Subst(s5Text3 : 41 : 10) <> *Blanks;
                s5rrn3 = s5rrn3 + 1;
                Write FilSfl03;
                *IN73 = *On;
                Clear s5File3;
                Clear s5Lib3;
                Clear s5Text3;
                %Subst(s5Text3 : 6 : 10) = apkeyf;
              Else;
                s5Text3 = %TrimR(s5Text3) + ' ' + apkeyf;
              EndIf;

            When w@CurrFile = 4;
              If %Subst(s5Text4 : 41 : 10) <> *Blanks;
                s5rrn4 = s5rrn4 + 1;
                Write FilSfl04;
                *IN74 = *On;
                Clear s5File4;
                Clear s5Lib4;
                Clear s5Text4;
                %Subst(s5Text4 : 6 : 10) = apkeyf;

              //** Otherwise, just add the key field to the end.

              Else;
                s5Text4 = %TrimR(s5Text4) + ' ' + apkeyf;
              EndIf;

          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Load all of the fields in the file.                ***
        //**ÍLoadFields¹                                                     ***
        //**********************************************************************

        Begsr LoadFields;

          //** Clear the relative record number.

          Select;
            When w@CurrFile = 1;
              Clear s1rrn;
            When w@CurrFile = 2;
              Clear s2rrn;
            When w@CurrFile = 3;
              Clear s3rrn;
            When w@CurrFile = 4;
              Clear s4rrn;
          EndSl;

          *IN43 = *ON;

          SetLL 1 FldLst;
          Read FldLst;

          //** Set up the format name.

          If Not %EOF(FldLst);
            Select;
              When w@CurrFile = 1;
                s1Format = whName;
                w@Records1 = %EditC(whfldn : '1');
                %Subst(h1Fields : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
                w@Records1 = %EditC(whrlen : '1');
                %Subst(h1RecLen : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
              When w@CurrFile = 2;
                s2Format = whName;
                w@Records1 = %EditC(whfldn : '1');
                %Subst(h2Fields : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
                w@Records1 = %EditC(whrlen : '1');
                %Subst(h2RecLen : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
              When w@CurrFile = 3;
                s3Format = whName;
                w@Records1 = %EditC(whfldn : '1');
                %Subst(h3Fields : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
                w@Records1 = %EditC(whrlen : '1');
                %Subst(h3RecLen : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
              When w@CurrFile = 4;
                s4Format = whName;
                w@Records1 = %EditC(whfldn : '1');
                %Subst(h4Fields : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
                w@Records1 = %EditC(whrlen : '1');
                %Subst(h4RecLen : 1 : %Len(%Trim(w@Records1)))
                       = %Trim(w@Records1);
            EndSl;
          EndIf;

          //** Loop through, reading the records and writing the fields
          //** to the subfile.

          Dow Not %EOF(FldLst);

            Select;
              When w@CurrFile = 1;
                s1Field = whflde;

                //** Set the field length.

                If whfldd > whfldb;
                  s1Length = whfldd;
                Else;
                  s1Length = whfldb;
                EndIf;

                s1Decimal = %EditC(whfldp : '1');

                If whfldt = 'A' or whfldt = 'H';
                  Clear s1Decimal;
                Else;
                  If s1Decimal > '00' and s1Decimal < '10';
                    %Subst(s1Decimal : 1 : 1) = ' ';
                  EndIf;
                EndIf;

                s1Type = %TLookup(whfldt : Tab1 : Tab2);
                s1Type = Tab2;
                h1Type = whfldt;

                w@Text10 = %Subst(whftxt : 1 : 10);
                If w@Text10 = whflde or w@Text10 = whfldi;
                  Clear s1Text;
                  s1Text = %Trim(whchd1) + ' ' + %Trim(whchd2) + ' '
                         + %Trim(whchd3);
                Else;
                  s1Text = whftxt;
                EndIf;

                w@Format = 'W';
                Clear w@Text;
                %Subst(w@Text : 1 : %Len(s1Text)) = s1Text;
                s1Text = gCapStr(w@Text : w@Format);

                X = 1;
                whflde = %Xlate(c@Down : c@Up : whflde);
                X = %Lookup(whflde : Key);
                If X > *Zeros;
                  s1Key = %Char(Nbr(X));
                Else;
                  Clear s1Key;
                EndIf;

                h1Start = whfobo;
                s1rrn = s1rrn + 1;
                Write SubFil01;
                *IN44 = *ON;

              When w@CurrFile = 2;
                s2Field = whflde;

                //** Set the field length.

                If whfldd > whfldb;
                  s2Length = whfldd;
                Else;
                  s2Length = whfldb;
                EndIf;

                s2Decimal = %EditC(whfldp : '1');

                If whfldt = 'A' or whfldt = 'H';
                  Clear s2Decimal;
                Else;
                  If s2Decimal > '00' and s2Decimal < '10';
                    %Subst(s2Decimal : 1 : 1) = ' ';
                  EndIf;
                EndIf;

                s2Type = %TLookup(whfldt : Tab1 : Tab2);
                s2Type = Tab2;
                h2Type = whfldt;

                w@Text10 = %Subst(whftxt : 1 : 10);
                If w@Text10 = whflde or w@Text10 = whfldi;
                  Clear s2Text;
                  s2Text = %Trim(whchd1) + ' ' + %Trim(whchd2) + ' '
                         + %Trim(whchd3);
                Else;
                  s2Text = whftxt;
                EndIf;

                w@Format = 'W';
                Clear w@Text;
                %Subst(w@Text : 1 : %Len(s2Text)) = s2Text;
                s2Text = gCapStr(w@Text : w@Format);

                X = 1;
                whflde = %Xlate(c@Down : c@Up : whflde);
                X = %Lookup(whflde : Key);
                If X > *Zeros;
                  s2Key = %Char(Nbr(X));
                Else;
                  Clear s2Key;
                EndIf;

                h2Start = whfobo;
                s2rrn = s2rrn + 1;
                Write SubFil02;
                *IN48 = *ON;

              When w@CurrFile = 3;
                s3Field = whflde;

                //** Set the field length.

                If whfldd > whfldb;
                  s3Length = whfldd;
                Else;
                  s3Length = whfldb;
                EndIf;

                s3Decimal = %EditC(whfldp : '1');

                If whfldt = 'A' or whfldt = 'H';
                  Clear s3Decimal;
                Else;
                  If s3Decimal > '00' and s3Decimal < '10';
                    %Subst(s3Decimal : 1 : 1) = ' ';
                  EndIf;
                EndIf;

                s3Type = %TLookup(whfldt : Tab1 : Tab2);
                s3Type = Tab2;
                h3Type = whfldt;

                w@Text10 = %Subst(whftxt : 1 : 10);
                If w@Text10 = whflde or w@Text10 = whfldi;
                  Clear s3Text;
                  s3Text = %Trim(whchd1) + ' ' + %Trim(whchd2) + ' '
                         + %Trim(whchd3);
                Else;
                  s3Text = whftxt;
                EndIf;

                w@Format = 'W';
                Clear w@Text;
                %Subst(w@Text : 1 : %Len(s3Text)) = s3Text;
                s3Text = gCapStr(w@Text : w@Format);

                X = 1;
                whflde = %Xlate(c@Down : c@Up : whflde);
                X = %Lookup(whflde : Key);
                If X > *Zeros;
                  s3Key = %Char(Nbr(X));
                Else;
                  Clear s3Key;
                EndIf;

                h3Start = whfobo;
                s3rrn = s3rrn + 1;
                Write SubFil03;
                *IN50 = *ON;

              When w@CurrFile = 4;
                s4Field = whflde;

                //** Set the field length.

                If whfldd > whfldb;
                  s4Length = whfldd;
                Else;
                  s4Length = whfldb;
                EndIf;

                s4Decimal = %EditC(whfldp : '1');

                If whfldt = 'A' or whfldt = 'H';
                  Clear s4Decimal;
                Else;
                  If s4Decimal > '00' and s4Decimal < '10';
                    %Subst(s4Decimal : 1 : 1) = ' ';
                  EndIf;
                EndIf;

                s4Type = %TLookup(whfldt : Tab1 : Tab2);
                s4Type = Tab2;
                h4Type = whfldt;

                w@Text10 = %Subst(whftxt : 1 : 10);
                If w@Text10 = whflde or w@Text10 = whfldi;
                  Clear s4Text;
                  s4Text = %Trim(whchd1) + ' ' + %Trim(whchd2) + ' '
                         + %Trim(whchd3);
                Else;
                  s4Text = whftxt;
                EndIf;

                w@Format = 'W';
                Clear w@Text;
                %Subst(w@Text : 1 : %Len(s4Text)) = s4Text;
                s4Text = gCapStr(w@Text : w@Format);

                X = 1;
                whflde = %Xlate(c@Down : c@Up : whflde);
                X = %Lookup(whflde : Key);
                If X > *Zeros;
                  s4Key = %Char(Nbr(X));
                Else;
                  Clear s4Key;
                EndIf;

                h4Start = whfobo;
                s4rrn = s4rrn + 1;
                Write SubFil04;
                *IN56 = *ON;
            EndSl;

            Delete FldLst;
            Read FldLst;
          EndDo;

          //** Set the relative record numbers to one if records were found.

          Select;
            When w@Currfile = 1 And *IN44;
              s1rrn = 1;
            When w@Currfile = 2 And *IN48;
              s2rrn = 1;
            When w@Currfile = 3 And *IN50;
              s3rrn = 1;
            When w@Currfile = 4 And *IN56;
              s4rrn = 1;
            When w@Currfile = 1 And Not *IN44;
              Clear s1rrn;
            When w@Currfile = 2 And Not *IN48;
              Clear s1rrn;
            When w@Currfile = 3 And Not *IN50;
              Clear s1rrn;
            When w@Currfile = 4 And Not *IN56;
              Clear s1rrn;
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Load the select/omit fields into the subfile.      ***
        //**ÍLoadSelOmit¹                                                    ***
        //**********************************************************************

        Begsr LoadSelOmit;

          //** Load the subfile.

          X = 0;
          SetLL 1 Select;
          Read Select;
          Dow Not %EOF(Select);

            //** Check for the field text being the same as the field name.

            If (soRule = '0' and soComp = 'AL') or soComp = *Blanks;
            Else;
              Select;
                When w@CurrFile = 1;
                  s1sofld = sofld;
                  s1soRule = soRule;
                  s1soComp = soComp;
                  s1sovalu = soValu;
                  l1rrn = l1rrn + 1;
                  Write SelSfl01;
                  *IN51 = *On;

                  //** Load the select/omit into the array.
                  X = X + 1;
                  Select;
                    When SoRule = 'S';
                      a1Select(X) = 'Select: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'A';
                      a1Select(X) = '   And: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'O';
                      a1Select(X) = '  Omit: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                  EndSl;

                When w@CurrFile = 2;
                  s2sofld = sofld;
                  s2soRule = soRule;
                  s2soComp = soComp;
                  s2sovalu = soValu;
                  l2rrn = l2rrn + 1;
                  Write SelSfl02;
                  *IN52 = *On;

                  //** Load the select/omit into the array.
                  X = X + 1;
                  Select;
                    When SoRule = 'S';
                      a2Select(X) = 'Select: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'A';
                      a2Select(X) = '   And: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'O';
                      a2Select(X) = '  Omit: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                  EndSl;

                When w@CurrFile = 3;
                  s3sofld = sofld;
                  s3soRule = soRule;
                  s3soComp = soComp;
                  s3sovalu = soValu;
                  l3rrn = l3rrn + 1;
                  Write SelSfl03;
                  *IN53 = *On;

                  //** Load the select/omit into the array.
                  X = X + 1;
                  Select;
                    When SoRule = 'S';
                      a3Select(X) = 'Select: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'A';
                      a3Select(X) = '   And: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'O';
                      a3Select(X) = '  Omit: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                  EndSl;

                When w@CurrFile = 4;
                  s4sofld = sofld;
                  s4soRule = soRule;
                  s4soComp = soComp;
                  s4sovalu = soValu;
                  l4rrn = l4rrn + 1;
                  Write SelSfl04;
                  *IN54 = *On;

                  //** Load the select/omit into the array.
                  X = X + 1;
                  Select;
                    When SoRule = 'S';
                      a4Select(X) = 'Select: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'S';
                      a4Select(X) = '   And: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                    When SoRule = 'O';
                      a4Select(X) = '  Omit: ' + %Trim(SoFld) + ' '
                           + %Trim(soComp) + ' ' + %Trim(soValu);
                  EndSl;

              EndSl;
            EndIf;

            Delete Select;
            Read Select;
          EndDo;

          Select;
            When w@CurrFile = 1 and *IN51;
              l1rrn = 1;
            When w@CurrFile = 2 and *IN52;
              l2rrn = 1;
            When w@CurrFile = 3 and *IN53;
              l3rrn = 1;
            When w@CurrFile = 4 and *IN54;
              l4rrn = 1;
            When w@CurrFile = 1 and Not *IN51;
              Clear l1rrn;
            When w@CurrFile = 2 and Not *IN52;
              Clear l2rrn;
            When w@CurrFile = 3 and Not *IN53;
              Clear l3rrn;
            When w@CurrFile = 4 and Not *IN54;
              Clear l4rrn;
          EndSl;

        Endsr;


        //**********************************************************************
        //** SUBROUTINE:  Load the database relations into the subfile.      ***
        //**ÍLoadDBR¹                                                        ***
        //**********************************************************************

        Begsr LoadDBR;

        //** Load the subfile.

          SetLL *Loval Dbr;
          Read Dbr;
          Dow Not %EOF(dspfldl1);
            If Whrefi <> *Blanks;
              Select;
                When w@CurrFile = 1;
                  s5File1 = whrefi;
                  s5lib1 = whreli;
                  s9rrn1 = s9rrn1 + 1;
                  Write DbrSfl01;

                When w@CurrFile = 2;
                  s5File2 = whrefi;
                  s5lib2 = whreli;
                  s9rrn2 = s9rrn2 + 1;
                  Write DbrSfl02;

                When w@CurrFile = 3;
                  s5File3 = whrefi;
                  s5lib3 = whreli;
                  s9rrn3 = s9rrn3 + 1;
                  Write DbrSfl03;

                When w@CurrFile = 4;
                  s5File4 = whrefi;
                  s5lib4 = whreli;
                  s9rrn4 = s9rrn4 + 1;
                  Write DbrSfl04;
              EndSl;
            EndIf;

            Delete Dbr;
            Read Dbr;
          EndDo;

          Select;
            When w@CurrFile = 1;
              If s9rrn1 > *Zeros;
                s9rrn1 = 1;
                *IN81 = *On;
              EndIf;

            When w@CurrFile = 2;
              If s9rrn2 > *Zeros;
                s9rrn2 = 1;
                *IN82 = *On;
              EndIf;

            When w@CurrFile = 3;
              If s9rrn3 > *Zeros;
                s9rrn3 = 1;
                *IN83 = *On;
              EndIf;

            When w@CurrFile = 4;
              If s9rrn4 > *Zeros;
                s9rrn4 = 1;
                *IN84 = *On;
              EndIf;
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Handle the function keys.                          ***
        //**Ís1FunctKey¹                                                     ***
        //**********************************************************************
        Begsr s1FunctKey;

          Select;

            //** Switch files.

            When w@FunctKey = F05;
              Exsr s1SwitchFiles;

            //** Show key fields window.

            When w@FunctKey = F06;
              Select;
                When w@CurrFile = 1;
                  Exfmt KeyCtl01;
                When w@CurrFile = 2;
                  Exfmt KeyCtl02;
                When w@CurrFile = 3;
                  Exfmt KeyCtl03;
                When w@CurrFile = 4;
                  Exfmt KeyCtl04;
              EndSl;

            //** Show select/omit window.

            When w@FunctKey = F07;
              Select;
                When w@CurrFile = 1;
                  Exfmt SelCtl01;
                When w@CurrFile = 2;
                  Exfmt SelCtl02;
                When w@CurrFile = 3;
                  Exfmt SelCtl03;
                When w@CurrFile = 4;
                  Exfmt SelCtl04;
              EndSl;

            //** Show data base relations window.

            When w@FunctKey = F08;
              Exsr ShowDBR;

            //** Run query on file.

            When w@FunctKey = F09 or w@FunctKey = F10;
              If w@CurrFile <> 0;
                Exsr DOQRY;
              EndIf;

            //** Display another file.

            When w@FunctKey = F11;
              Exfmt Scrn08;
              If s8File <> *Blanks;
                Exsr GetNewFile;
              EndIf;

            //** Toggle physical file name/file size.

            When w@FunctKey = F13;
              If Not *IN39 and s1Phys <> *Blanks;
                *IN39 = *On;
              Else;
                Clear *IN39;
              EndIf;

            //** Show the database relations.

            When w@FunctKey = F14;
              If w@CurrFile <> 0;
                Exsr DisplayDBR;
              EndIf;

            //** Position the subfile to a certain field.

            When w@FunctKey = F17;
              Exsr s1PositionTo;

            //** Show open file window.

            When w@FunctKey = F20;
              Exsr ShowOpenFiles;

            //** Show command line.

            When w@FunctKey = F21;
              CmdLine();

            //** Close the current file.

            When w@FunctKey = F23;
              If w@FileCount > 1;
                Exsr CloseFile;
              EndIf;

            //** Show additional function keys.

            When w@FunctKey = F24;
              Select;
                When Not *IN24 and Not *IN25;
                  *IN24 = *On;
                When *IN24;
                  *IN24 = *Off;
                  *IN25 = *On;
                When *IN25;
                  *IN25 = *Off;
              EndSl;

            //** Print the file specs.

            When w@FunctKey = FPrint;
              Exsr PrintFile;

            //** Enter is pressed - set the subfile to display the same page ***

            When w@FunctKey = FEnter;
              Select;
                When w@CurrFile = 1;
                  s1rrn = w@SflTop;
                When w@CurrFile = 2;
                  s2rrn = w@SflTop;
                When w@CurrFile = 3;
                  s3rrn = w@SflTop;
                When w@CurrFile = 4;
                  s4rrn = w@SflTop;
              EndSl;
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE: Switch to the next available sequential file.       ***
        //**Ís1SwitchFiles¹                                                  ***
        //**********************************************************************

        Begsr s1SwitchFiles;

          Select;
            When w@CurrFile = 1;
              Select;
                When s2File <> *Blanks;
                  w@CurrFile = 2;
                When s3File <> *Blanks;
                  w@CurrFile = 3;
                When s4File <> *Blanks;
                  w@CurrFile = 4;
              EndSl;

            When w@CurrFile = 2;
              Select;
                When s3File <> *Blanks;
                  w@CurrFile = 3;
                When s4File <> *Blanks;
                  w@CurrFile = 4;
                When s1File <> *Blanks;
                  w@CurrFile = 1;
              EndSl;

            When w@CurrFile = 3;
              Select;
                When s4File <> *Blanks;
                  w@CurrFile = 4;
                When s1File <> *Blanks;
                  w@CurrFile = 1;
                When s2File <> *Blanks;
                  w@CurrFile = 2;
              EndSl;

            When w@CurrFile = 4;
              Select;
                When s1File <> *Blanks;
                  w@CurrFile = 1;
                When s2File <> *Blanks;
                  w@CurrFile = 2;
                When s3File <> *Blanks;
                  w@CurrFile = 3;
              EndSl;
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE: Position the list to a particular field.            ***
        //**Ís1PositinoTo¹                                                   ***
        //**********************************************************************

        Begsr s1PositionTo;

          //** Display the position-to window.

          #SFTOP = w@SflTop;
          Clear s6PosTo;
          Exfmt Scrn06;

          If w@FunctKey = FEnter and s6PosTo <> *Blanks;
            Select;
              When w@CurrFile = 1;

                //** Clear the field highlighting.

                If *IN45;
                  Chain s1rrn SubFil01;
                  If %Found;
                    Clear *IN45;
                    Update SubFil01;
                  EndIf;
                EndIf;

                //** Look through the subfile for the field name.

                Clear X;
                Dou s1Field = s6PosTo or Not %Found;
                  X = X + 1;
                  Chain X SubFil01;
                EndDo;

                //** If the field name is found then that field will be
                //** displayed automatically because of the s1rrn field.  If
                //** it was not found then just re-display the same screen.

                If s1Field <> s6PosTo;
                  s1rrn = #SFTop;
                  Exfmt Scrn13;
                Else;
                  *IN45 = *On;
                  Update SubFil01;
                EndIf;

              When w@CurrFile = 2;

                //** Clear the field highlighting.

                If *IN45;
                  Chain s1rrn SubFil02;
                  If %Found;
                    Clear *IN45;
                    Update SubFil02;
                  EndIf;
                EndIf;

                //** Look through the subfile for the field name.

                Clear s2Rrn;
                Dou s2Field = s6PosTo or Not %Found;
                  s2Rrn = s2Rrn + 1;
                  Chain s2Rrn SubFil02;
                EndDo;

                //** If the field name is found then that field will be
                //** displayed automatically because of the s1rrn field.  If
                //** it was not found then just re-display the same screen.

                If s2Field <> s6PosTo;
                  s2rrn = #SFTop;
                  Exfmt Scrn13;
                Else;
                  *IN45 = *On;
                  Update SubFil02;
                EndIf;

              When w@CurrFile = 3;

                //** Clear the field highlighting.

                If *IN45;
                  Chain s3rrn SubFil03;
                  If %Found;
                    Clear *IN45;
                    Update SubFil03;
                  EndIf;
                EndIf;

                //** Look through the subfile for the field name.

                Clear s3rrn;
                Dou s3Field = s6PosTo or Not %Found;
                  s3rrn = s3rrn + 1;
                  Chain s3rrn SubFil03;
                EndDo;

                //** If the field name is found then that field will be
                //** displayed automatically because of the s1rrn field.  If
                //** it was not found then just re-display the same screen.

                If s3Field <> s6PosTo;
                  s3rrn = #SFTop;
                  Exfmt Scrn13;
                Else;
                  *IN45 = *On;
                  Update SubFil03;
                EndIf;

              When w@CurrFile = 4;

                //** Clear the field highlighting.

                If *IN45;
                  Chain s3rrn SubFil04;
                  If %Found;
                    Clear *IN45;
                    Update SubFil04;
                  EndIf;
                EndIf;

                //** Look through the subfile for the field name.

                Clear s4rrn;
                Dou s4Field = s6PosTo or Not %Found;
                  s4rrn = s4rrn + 1;
                  Chain s4rrn SubFil04;
                EndDo;

                //** If the field name is found then that field will be
                //** displayed automatically because of the s1rrn field.  If
                //** it was not found then just re-display the same screen.

                If s4Field <> s6PosTo;
                  s4rrn = #SFTop;
                  Exfmt Scrn13;
                Else;
                  *IN45 = *On;
                  Update SubFil04;
                EndIf;

            EndSl;
            Clear w@FunctKey;
          EndIf;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Show the database relations window and allow       ***
        //**ÍSHoWDBR¹     querying of any file shown.                        ***
        //**********************************************************************

        Begsr ShowDBR;

          Select;
            When w@CurrFile = 1;
              Exfmt DbrCtl01;
            When w@CurrFile = 2;
              Exfmt DbrCtl02;
            When w@CurrFile = 3;
              Exfmt DbrCtl03;
            When w@CurrFile = 4;
              Exfmt DbrCtl04;
          EndSl;

          //** Handle the function keys.

          Select;

            //** F9 = query on database selected with cursor position.

            When w@FunctKey = F09;
              w@Row = %Div(w@CursLoc : 256);
              w@Col = %Rem(w@CursLoc : 256);
              w@Row = w@Row - 15 + w@SflTop;

              Select;
                When w@CurrFile = 1;
                  Chain w@Row DbrSfl01;
                When w@CurrFile = 2;
                  Chain w@Row DbrSfl02;
                When w@CurrFile = 3;
                  Chain w@Row DbrSfl03;
                When w@CurrFile = 4;
                  Chain w@Row DbrSfl04;
              EndSl;

              //** If the cursor was on a row with a file name in it...

              If (w@CurrFile = 1 and s5File1 <> *Blanks)
                   or (w@Currfile =2 and s5File2 <> *Blanks)
                   or (w@Currfile =3 and s5File3 <> *Blanks)
                   or (w@Currfile =4 and s5File4 <> *Blanks);
                Clear w@Cmd;

                //** Set up the command line.

                Select;
                  When w@CurrFile = 1;
                    w@Cmd = c@Query1 + %Trim(s5Lib1) + '/' + %Trim(s5File1);
                  When w@CurrFile = 2;
                    w@Cmd = c@Query1 + %Trim(s5Lib2) + '/' + %Trim(s5File2);
                  When w@CurrFile = 3;
                    w@Cmd = c@Query1 + %Trim(s5Lib3) + '/' + %Trim(s5File3);
                  When w@CurrFile = 4;
                    w@Cmd = c@Query1 + %Trim(s5Lib4) + '/' + %Trim(s5File4);
                EndSl;

                w@Cmd = %Trim(w@Cmd) + c@Query2;
                w@CmdLen = %Len(%Trim(w@Cmd));
                Callp(E) CommandExec(w@Cmd : w@CmdLen);
              EndIf;

            //** Change file to file under cursor.

            When w@FunctKey = F10;
              w@Row = %Div(w@CursLoc : 256);
              w@Col = %Rem(w@CursLoc : 256);
              w@Row = w@Row - 15 + w@SflTop;

              Select;
                When w@CurrFile = 1;
                  Chain w@Row DbrSfl01;
                When w@CurrFile = 2;
                  Chain w@Row DbrSfl02;
                When w@CurrFile = 3;
                  Chain w@Row DbrSfl03;
                When w@CurrFile = 4;
                  Chain w@Row DbrSfl04;
              EndSl;

              If (w@CurrFile = 1 and s5File1 <> *Blanks)
                   or (w@Currfile =2 and s5File2 <> *Blanks)
                   or (w@Currfile =3 and s5File3 <> *Blanks)
                   or (w@Currfile =4 and s5File4 <> *Blanks);
                Clear p@FileLib;
                Select;
                  When w@CurrFile = 1;
                    p@FileLib = s5File1 + s5Lib1;
                  When w@CurrFile = 2;
                    p@FileLib = s5File2 + s5Lib2;
                  When w@CurrFile = 3;
                    p@FileLib = s5File3 + s5Lib3;
                  When w@CurrFile = 4;
                    p@FileLib = s5File4 + s5Lib4;
                EndSl;

                s8File = %Subst(p@FileLib : 1 : 10);
                s8Lib = %Subst(p@FileLib : 11 : 10);
                w@FunctKey = FEnter;
                Exsr GetNewFile;
              EndIf;
          EndSl;

        Endsr;

        //**********************************************************************
        //** SUBROUTINE: Display the files associated with the main file and ***
        //**ÍDisplayDBR¹ and their key fields.  Allow the user to select a   ***
        //** different file to display, such as a logical.  This will allow  ***
        //** the user to see different aspects of a logical, such as         ***
        //** such as select/omit, etc.                                       ***
        //**********************************************************************

        Begsr DisplayDBR;

          //** Read changed records in the subfile until either EOF or a
          //** non-blank option has been found.

          Select;
            When w@CurrFile = 1;
              Exfmt FilCtl01;
              Readc FilSfl01;
              Dow Not %EOF and s5Opt1 = *Blanks;
                Readc FilSfl01;
              Enddo;

              //** If a non-blank option was found, close the current file
              //** and open the selected file.

              If s5Opt1 <> *Blanks;
                s8File = s5File1;
                s8Lib = s5Lib1;
                Exsr CloseFile;
                w@FunctKey = FEnter;
                Exsr GetNewFile;
              EndIf;

            When w@CurrFile = 2;
              Exfmt FilCtl02;
              Readc FilSfl02;
              Dow Not %EOF and s5Opt2 = *Blanks;
                Readc FilSfl02;
              Enddo;
              If s5Opt2 <> *Blanks;
                s8File = s5File2;
                s8Lib = s5Lib2;
                Exsr CloseFile;
                w@FunctKey = FEnter;
                Exsr GetNewFile;
              EndIf;

            When w@CurrFile = 3;
              Exfmt FilCtl03;
              Readc FilSfl03;
              Dow Not %EOF and s5Opt3 = *Blanks;
                Readc FilSfl03;
              Enddo;
              If s5Opt3 <> *Blanks;
                s8File = s5File3;
                s8Lib = s5Lib3;
                Exsr CloseFile;
                w@FunctKey = FEnter;
                Exsr GetNewFile;
              EndIf;

            When w@CurrFile = 4;
              Exfmt FilCtl04;
              Readc FilSfl04;
              Dow Not %EOF and s5Opt4 = *Blanks;
                Readc FilSfl04;
              Enddo;
              If s5Opt4 <> *Blanks;
                s8File = s5File4;
                s8Lib = s5Lib4;
                Exsr CloseFile;
                w@FunctKey = FEnter;
                Exsr GetNewFile;
              EndIf;
          EndSl;

       EndSr;

        //**********************************************************************
        //** SUBROUTINE: Change the date around.                             ***
        //**ÍChangeDate¹                                                     ***
        //**********************************************************************

        Begsr ChangeDate;

          If #DateI <> *All'0';
            #MM = #Month;
            #DD = #Day;
            If #Cent = 0;
              #YY = 1900 + #Year;
            Else;
              #YY = 2000 + #Year;
            EndIf;
          Else;
            Clear #DateO;
            Clear #Time;
          EndIf;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Print the file specs.                              ***
        //**ÍPrintFile¹                                                      ***
        //**********************************************************************

        Begsr PrintFile;

          #SFTop = w@SflTop;

          Clear Scrn14;
          Exfmt Scrn14;

          Open DspFldPr;
          w@LineCount = 99;

          Select;
            When w@CurrFile = 1;

              //** Set up the heading fields.

              r@File = s1File;
              r@SrcFile = s1SrcFile;
              r@CrtDate = s1CrtDate;
              r@CrtTime = s1CrtTime;
              r@Lib = s1Lib;
              r@SrcLib = s1SrcLib;
              r@ChgDate = s1ChgDate;
              r@ChgTime = s1ChgTime;
              r@Type = s1Type;
              r@SrcMbr = s1SrcMbr;
              r@SaveDate = s1SaveDate;
              r@SaveTime = s1SaveTime;
              r@Format = s1Format;
              r@SrcDate = s1SrcDate;
              r@SrcTime = s1SrcTime;
              r@NbrField = h1Fields;
              r@OrgSrcDt = s1OrgSrcDt;
              r@OrgSrcTm = s1OrgSrcTm;
              r@RecLen = h1RecLen;
              r@Size = s1Size;
              r@RecCount = s1Records;
              r@Text = s1PgmText;

              If s14Fields <> *Blanks;

                //** Now read the subfile.

                X = 1;
                Chain X SubFil01;
                Dow %Found;

                  //** Print secondary headings for a new record format.

                  If whname <> w@SaveName;
                    If %Tlookup(whftyp : Tab3 : Tab4);
                      s1Type = Tab4;
                    Else;
                      s1Type = whftyp;
                    EndIf;

                    Clear w@SaveName;
                    w@SaveName = whname;
                    If w@LineCount >= 54;
                      Write MainHeader;
                    EndIf;

                    Write SubHeader1;
                  EndIf;

                  //** Print the data type.

                  If %Tlookup(h1Type : Tab5 : Tab6);
                    r1Type = Tab6;
                  Else;
                    Clear r1Type;
                  EndIf;

                  r1Field = s1Field;
                  r1Start = h1Start;
                  r1Length = s1Length;
                  r1Decimal = s1Decimal;
                  r1Text = s1Text;

                  w@PrintLines = c@PrintNormal;
                  Exsr CheckHeader;
                  Write FielDetail;
                  X = X + 1;
                  Chain X SubFil01;
                EndDo;
              Else;
                Write MainHeader;
                Write SubHeader1;
              EndIf;

            When w@CurrFile = 2;

              //** Set up the heading fields.

              r@File = s2File;
              r@SrcFile = s2SrcFile;
              r@CrtDate = s2CrtDate;
              r@CrtTime = s2CrtTime;
              r@Lib = s2Lib;
              r@SrcLib = s2SrcLib;
              r@ChgDate = s2ChgDate;
              r@ChgTime = s2ChgTime;
              r@Type = s2Type;
              r@SrcMbr = s2SrcMbr;
              r@SaveDate = s2SaveDate;
              r@SaveTime = s2SaveTime;
              r@Format = s2Format;
              r@SrcDate = s2SrcDate;
              r@SrcTime = s2SrcTime;
              r@NbrField = h2Fields;
              r@OrgSrcDt = s2OrgSrcDt;
              r@OrgSrcTm = s2OrgSrcTm;
              r@RecLen = h2RecLen;
              r@Size = s2Size;
              r@RecCount = s2Records;
              r@Text = s2PgmText;

              If s14Fields <> *Blanks;

                //** Now read the subfile.

                X = 1;
                Chain X SubFil02;
                Dow %Found;

                  //** Print secondary headings for a new record format.

                  If whname <> w@SaveName;
                    If %Tlookup(whftyp : Tab3 : Tab4);
                      s2Type = Tab4;
                    Else;
                      s2Type = whftyp;
                    EndIf;

                    Clear w@SaveName;
                    w@SaveName = whname;
                    If w@LineCount >= 54;
                      Write MainHeader;
                    EndIf;

                    Write SubHeader1;
                  EndIf;

                  //** Print the data type.

                  If %Tlookup(h2Type : Tab5 : Tab6);
                    r1Type = Tab6;
                  Else;
                    Clear r1Type;
                  EndIf;

                  r1Field = s2Field;
                  r1Start = h2Start;
                  r1Length = s2Length;
                  r1Decimal = s2Decimal;
                  r1Text = s2Text;

                  w@PrintLines = c@PrintNormal;
                  Exsr CheckHeader;
                  Write FielDetail;
                  X = X + 1;
                  Chain X SubFil02;
                EndDo;

              Else;
                Write MainHeader;
                Write SubHeader1;
              EndIf;

            When w@CurrFile = 3;

              //** Set up the heading fields.

              r@File = s3File;
              r@SrcFile = s3SrcFile;
              r@CrtDate = s3CrtDate;
              r@CrtTime = s3CrtTime;
              r@Lib = s3Lib;
              r@SrcLib = s3SrcLib;
              r@ChgDate = s3ChgDate;
              r@ChgTime = s3ChgTime;
              r@Type = s3Type;
              r@SrcMbr = s3SrcMbr;
              r@SaveDate = s3SaveDate;
              r@SaveTime = s3SaveTime;
              r@Format = s3Format;
              r@SrcDate = s3SrcDate;
              r@SrcTime = s3SrcTime;
              r@NbrField = h3Fields;
              r@OrgSrcDt = s3OrgSrcDt;
              r@OrgSrcTm = s3OrgSrcTm;
              r@RecLen = h3RecLen;
              r@Size = s3Size;
              r@RecCount = s3Records;
              r@Text = s3PgmText;

              If s14Fields <> *Blanks;

                //** Now read the subfile.

                X = 1;
                Chain X SubFil03;
                Dow %Found;

                  //** Print secondary headings for a new record format.

                  If whname <> w@SaveName;
                    If %Tlookup(whftyp : Tab3 : Tab4);
                      s3Type = Tab4;
                    Else;
                      s3Type = whftyp;
                    EndIf;

                    Clear w@SaveName;
                    w@SaveName = whname;
                    If w@LineCount >= 54;
                      Write MainHeader;
                    EndIf;

                    Write SubHeader1;
                  EndIf;

                  //** Print the data type.

                  If %Tlookup(h3Type : Tab5 : Tab6);
                    r1Type = Tab6;
                  Else;
                    Clear r1Type;
                  EndIf;

                  r1Field = s3Field;
                  r1Start = h3Start;
                  r1Length = s3Length;
                  r1Decimal = s3Decimal;
                  r1Text = s3Text;

                  w@PrintLines = c@PrintNormal;
                  Exsr CheckHeader;
                  Write FielDetail;
                  X = X + 1;
                  Chain X SubFil03;
                EndDo;

              Else;
                Write MainHeader;
                Write SubHeader1;
              EndIf;

            When w@CurrFile = 4;

              //** Set up the heading fields.

              r@File = s4File;
              r@SrcFile = s4SrcFile;
              r@CrtDate = s4CrtDate;
              r@CrtTime = s4CrtTime;
              r@Lib = s4Lib;
              r@SrcLib = s4SrcLib;
              r@ChgDate = s4ChgDate;
              r@ChgTime = s4ChgTime;
              r@Type = s4Type;
              r@SrcMbr = s4SrcMbr;
              r@SaveDate = s4SaveDate;
              r@SaveTime = s4SaveTime;
              r@Format = s4Format;
              r@SrcDate = s4SrcDate;
              r@SrcTime = s4SrcTime;
              r@NbrField = h4Fields;
              r@OrgSrcDt = s4OrgSrcDt;
              r@OrgSrcTm = s4OrgSrcTm;
              r@RecLen = h4RecLen;
              r@Size = s4Size;
              r@RecCount = s4Records;
              r@Text = s4PgmText;

              If s14Fields <> *Blanks;

                //** Now read the subfile.

                X = 1;
                Chain X SubFil04;
                Dow %Found;

                  //** Print secondary headings for a new record format.

                  If whname <> w@SaveName;
                    If %Tlookup(whftyp : Tab3 : Tab4);
                      s4Type = Tab4;
                    Else;
                      s4Type = whftyp;
                    EndIf;

                    Clear w@SaveName;
                    w@SaveName = whname;
                    If w@LineCount >= 54;
                      Write MainHeader;
                    EndIf;

                    Write SubHeader1;
                  EndIf;

                  //** Print the data type.

                  If %Tlookup(h4Type : Tab5 : Tab6);
                    r1Type = Tab6;
                  Else;
                    Clear r1Type;
                  EndIf;

                  r1Field = s4Field;
                  r1Start = h4Start;
                  r1Length = s4Length;
                  r1Decimal = s4Decimal;
                  r1Text = s4Text;

                  w@PrintLines = c@PrintNormal;
                  Exsr CheckHeader;
                  Write FielDetail;
                  X = X + 1;
                  Chain X SubFil04;
                EndDo;

              Else;
                Write MainHeader;
                Write SubHeader1;
              EndIf;

          EndSl;


          //***********************************
          //** Print the key fields.
          //***********************************

          If s14Keys <> *Blanks;

            Select;
              When w@CurrFile = 1;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If k1rrn > *Zeros;
                  Exsr CheckHeader;
                  Write KeysHeader;
                  X = 1;
                  Chain X KeySfl01;
                  Dow %Found;
                    r3Sequence = k1KeyNbr;
                    r3KeyField = k1KeyField;
                    r3Direct = k1AscDesc;
                    r3Descript = k1Text;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write KeysDetail;
                    X = X + 1;
                    Chain X KeySfl01;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write NoKeyFlds;
                EndIf;

              When w@CurrFile = 2;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If k2rrn > *Zeros;
                  Exsr CheckHeader;
                  Write KeysHeader;
                  X = 1;
                  Chain X KeySfl02;
                  Dow %Found;
                    r3Sequence = k2KeyNbr;
                    r3KeyField = k2KeyField;
                    r3Direct = k2AscDesc;
                    r3Descript = k2Text;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write KeysDetail;
                    X = X + 1;
                    Chain X KeySfl02;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write NoKeyFlds;
                EndIf;

              When w@CurrFile = 3;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If k3rrn > *Zeros;
                  Exsr CheckHeader;
                  Write KeysHeader;
                  X = 1;
                  Chain X KeySfl03;
                  Dow %Found;
                    r3Sequence = k3KeyNbr;
                    r3KeyField = k3KeyField;
                    r3Direct = k3AscDesc;
                    r3Descript = k3Text;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write KeysDetail;
                    X = X + 1;
                    Chain X KeySfl03;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write NoKeyFlds;
                EndIf;

              When w@CurrFile = 4;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If k4rrn > *Zeros;
                  Exsr CheckHeader;
                  Write KeysHeader;
                  X = 1;
                  Chain X KeySfl04;
                  Dow %Found;
                    r3Sequence = k4KeyNbr;
                    r3KeyField = k4KeyField;
                    r3Direct = k4AscDesc;
                    r3Descript = k4Text;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write KeysDetail;
                    X = X + 1;
                    Chain X KeySfl04;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write NoKeyFlds;
                EndIf;
            EndSl;
          EndIf;


          //***********************************
          //** Print the select/omit fields.
          //***********************************

          If s14Select <> *Blanks;

            Select;
              When w@CurrFile = 1;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If l1Rrn > *Zeros;
                  Exsr CheckHeader;
                  Write SelHead;
                  X = 1;
                  Chain X SelSfl01;
                  Dow %Found;
                    r4SelField = s1SOFld;
                    r4SelOmit = s1SORule;
                    r4Compare = s1SOComp;
                    r4Value = s1SOValu;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write SelDetail;
                    X = X + 1;
                    Chain X SelSfl01;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write SelHead;
                  Write NoSelFlds;
                EndIf;

              When w@CurrFile = 2;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If l2Rrn > *Zeros;
                  Exsr CheckHeader;
                  Write SelHead;
                  X = 1;
                  Chain X SelSfl02;
                  Dow %Found;
                    r4SelField = s2SOFld;
                    r4SelOmit = s2SORule;
                    r4Compare = s2SOComp;
                    r4Value = s2SOValu;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write SelDetail;
                    X = X + 1;
                    Chain X SelSfl02;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write SelHead;
                  Write NoSelFlds;
                EndIf;

              When w@CurrFile = 3;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If l3Rrn > *Zeros;
                  Exsr CheckHeader;
                  Write SelHead;
                  X = 1;
                  Chain X SelSfl03;
                  Dow %Found;
                    r4SelField = s3SOFld;
                    r4SelOmit = s3SORule;
                    r4Compare = s3SOComp;
                    r4Value = s3SOValu;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write SelDetail;
                    X = X + 1;
                    Chain X SelSfl03;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write SelHead;
                  Write NoSelFlds;
                EndIf;

              When w@CurrFile = 4;

                //** Write the first key field line - includes "Key Fields:"
                //** which the secondary key field line does not.

                If l4Rrn > *Zeros;
                  Exsr CheckHeader;
                  Write SelHead;
                  X = 1;
                  Chain X SelSfl04;
                  Dow %Found;
                    r4SelField = s4SOFld;
                    r4SelOmit = s4SORule;
                    r4Compare = s4SOComp;
                    r4Value = s4SOValu;
                    w@PrintLines = c@PrintKeys;
                    Exsr CheckHeader;
                    Write SelDetail;
                    X = X + 1;
                    Chain X SelSfl04;
                  EndDo;

                //** Write no key fields if there are none.

                Else;
                  Exsr CheckHeader;
                  Write SelHead;
                  Write NoSelFlds;
                EndIf;
            EndSl;
          EndIf;


          //***********************************
          //** Print the data base relations.
          //***********************************

          If s14DBR <> *Blanks;

            w@PrintLines = c@PrintDbr;
            Exsr CheckHeader;
            Write DbrHeader;
            X = X + 1;

            Select;
              When w@CurrFile = 1;
                Chain X FilSfl01;
                Dow %Found;
                  r5File = s5File1;
                  r5Lib = s5Lib1;
                  r5Text = s5Text1;
                  If w@LineCount > 58;
                    Write MainHeader;
                    Write DbrHeader;
                  EndIf;

                  Write DbrDetail;
                  X = X + 1;
                  Chain X FilSfl01;
                EndDo;

              When w@CurrFile = 2;
                Chain X FilSfl02;
                Dow %Found;
                  r5File = s5File2;
                  r5Lib = s5Lib2;
                  r5Text = s5Text2;
                  If w@LineCount > 58;
                    Write MainHeader;
                    Write DbrHeader;
                  EndIf;

                  Write DbrDetail;
                  X = X + 1;
                  Chain X FilSfl02;
                EndDo;

              When w@CurrFile = 3;
                Chain X FilSfl03;
                Dow %Found;
                  r5File = s5File3;
                  r5Lib = s5Lib3;
                  r5Text = s5Text3;
                  If w@LineCount > 58;
                    Write MainHeader;
                    Write DbrHeader;
                  EndIf;

                  Write DbrDetail;
                  X = X + 1;
                  Chain X FilSfl03;
                EndDo;

              When w@CurrFile = 4;
                Chain X FilSfl04;
                Dow %Found;
                  r5File = s5File4;
                  r5Lib = s5Lib4;
                  r5Text = s5Text4;
                  If w@LineCount > 58;
                    Write MainHeader;
                    Write DbrHeader;
                  EndIf;

                  Write DbrDetail;
                  X = X + 1;
                  Chain X FilSfl04;
                EndDo;
            EndSl;
          EndIf;

          Close DspFldPr;

          //** Set the subfile back to where it was.

          Select;
            When w@CurrFile = 1;
              s1rrn = #SfTop;
            When w@CurrFile = 2;
              s2rrn = #SfTop;
            When w@CurrFile = 3;
              s3rrn = #SfTop;
            When w@CurrFile = 4;
              s4rrn = #SfTop;
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Print headings if necessary.                       ***
        //**ÍCheckHeader¹                                                    ***
        //**********************************************************************

        Begsr CheckHeader;

          If w@Linecount >= w@PrintLines;
            Write MainHeader;
            If w@PrintLines <> c@PrintDbr;
              Write SubHeader1;
            EndIf;
          EndIf;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Clear all of the subfiles.                         ***
        //**ÍClearSFL¹                                                       ***
        //**********************************************************************

        Begsr ClearSFL;

          //** Set on the subfile clear indicators.

          *IN32 = *On;
          *IN42 = *On;

          //** Write all of the subfile control records.

          Write SubCtl01;
          Write SubCtl02;
          Write SubCtl03;
          Write SubCtl04;
          Write KeyCtl01;
          Write KeyCtl02;
          Write KeyCtl03;
          Write KeyCtl04;
          Write SelCtl01;
          Write SelCtl02;
          Write SelCtl03;
          Write SelCtl04;
          Write DbrCtl01;
          Write DbrCtl02;
          Write DbrCtl03;
          Write DbrCtl04;
          Write FilCtl01;
          Write FilCtl02;
          Write FilCtl03;
          Write FilCtl04;

          //** Clear the subfile clear indicators.

          Clear *IN32;
          Clear *IN42;

          //** Clear the record numbers.

          Clear s1rrn;
          Clear s2rrn;
          Clear s3rrn;
          Clear s4rrn;
          Clear k1rrn;
          Clear k2rrn;
          Clear k3rrn;
          Clear k4rrn;
          Clear l1rrn;
          Clear l2rrn;
          Clear l3rrn;
          Clear l4rrn;
          Clear s5rrn1;
          Clear s5rrn2;
          Clear s5rrn3;
          Clear s5rrn4;
          Clear s9rrn1;
          Clear s9rrn2;
          Clear s9rrn3;
          Clear s9rrn4;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Query the file being displayed.                    ***
        //**ÍDOQRY¹                                                          ***
        //**********************************************************************
        Begsr DOQRY;

          //** Set upt he query command to run based on which screen is
          //** showing.

          Clear w@Cmd;
          Select;
            When w@CurrFile = 1;
              w@Cmd = c@Query1 + %Trim(s1Lib) + '/' + %Trim(s1File);
            When w@CurrFile = 2;
              w@Cmd = c@Query1 + %Trim(s2Lib) + '/' + %Trim(s2File);
            When w@CurrFile = 3;
              w@Cmd = c@Query1 + %Trim(s3Lib) + '/' + %Trim(s3File);
            When w@CurrFile = 4;
              w@Cmd = c@Query1 + %Trim(s4Lib) + '/' + %Trim(s4File);
          EndSl;

          //** If F09 use RCDSLT, otherwise don't.

          If w@FunctKey = F09;
            w@Cmd = %Trim(w@Cmd) + c@Query2;
          Else;
            w@Cmd = %Trim(w@Cmd) + c@Query3;
          EndIf;

          w@CmdLen = %Len(%Trim(w@Cmd));
          Callp(E) CommandExec(w@Cmd : w@CmdLen);

        EndSr;

        //**********************************************************************
        //** SUBROUTINE: Get the data for a new file.                        ***
        //**Í%etNEwFile¹                                                     ***
        //**********************************************************************

        Begsr GetNewFile;

          //** Save the current values.

          w@CurrHold = w@CurrFile;

          //** See if we have an empty slot.

          n@File1 = s1File = *Blanks;
          n@File2 = s2File = *Blanks;
          n@File3 = s3File = *Blanks;
          n@File4 = s4File = *Blanks;

          //** Reduce it to just one indicator.

          Select;
            When n@File1;
              Clear n@File2;
              Clear n@File3;
              Clear n@File4;
            When n@File2;
              Clear n@File3;
              Clear n@File4;
            When n@File3;
              Clear n@File4;
          EndSl;

          //** Set the current file to the first empty slot.

          Select;
            When n@File1;
              w@CurrFile = 1;
            When n@File2;
              w@CurrFile = 2;
            When n@File3;
              w@CurrFile = 3;
            When n@File4;
              w@CurrFile = 4;

            //** Tell the user no empty slots.

            Other;
              Exfmt Scrn11;
          EndSl;

          //** Set up the file request window.

          If n@File1 or n@File2 or n@File3 or n@File4;

            //** Only do this if Enter is pressed.

            If w@FunctKey = FEnter and s8File <> ' ';

              //** Add '*LIBL' to the library if it is blank.

              If s8Lib = *Blanks;
                s8Lib = '*LIBL';
              EndIf;

              //** Set the parameters to the entered items.

              p@File = s8File;
              p@Lib = s8Lib;

              //** Clear the other parameters.

              Clear p@Text;
              Clear p@CreateDate;
              Clear p@ChangeDate;
              Clear p@Savedate;
              Clear p@Size1;
              Clear p@SrcFile;
              Clear p@SrcLib;
              Clear p@SrcMember;
              Clear p@SrcDate;
              Clear p@SrcChange;
              Clear p@RecordCount;

              //** Call the CL program to load the files.

              DspFields2(p@File : p@Lib : p@Text : p@CreateDate :
                    p@ChangeDate : p@SaveDate : p@Size1 : p@SrcFile :
                    p@SrcLib : p@SrcMember : p@SrcDate : p@SrcChange :
                    p@RecordCount);

              //** Load the information to the display.

              If p@File <> ' ';
                w@FileCount = w@FileCount + 1;
                Exsr LoadControl;
                Exsr LoadKeys;
                Exsr LoadFields;
                Exsr LoadAccPaths;
                Exsr LoadSelOmit;
                Exsr LoadDBR;
              Else;
                Exfmt Scrn09;
                Select;
                  When w@CurrFile = 1;
                    Clear n@File1;
                  When w@CurrFile = 2;
                    Clear n@File2;
                  When w@CurrFile = 3;
                    Clear n@File3;
                  When w@CurrFile = 4;
                    Clear n@File4;
                EndSl;
                w@CurrFile = w@CurrHold;
              EndIf;

            Else;
              w@CurrFile = w@CurrHold;
            EndIf;

          Else;
            w@CurrFile = w@CurrHold;
          EndIf;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE: Show the open files and allow the user either       ***
        //**ÍShowOpenFiles¹delete them or select one to switch to.           ***
        //**********************************************************************

        Begsr ShowOpenFiles;

          //** Set up the file name list.

          s10File1 = s1File;
          s10File2 = s2File;
          s10File3 = s3File;
          s10File4 = s4File;

          //** Set the indicator to allow selection if a file is present.

          *IN75 = s10File1 <> *Blanks;
          *IN76 = s10File2 <> *Blanks;
          *IN77 = s10File3 <> *Blanks;
          *IN78 = s10File4 <> *Blanks;

          //** Display the file list.

          Exfmt Scrn10;

          //** Delete any files that were selected for deletion.

          If s10Sel1 = 'D';
            w@CurrFile = 1;
            Exsr CloseFile;
          EndIf;

          If s10Sel2 = 'D';
            w@CurrFile = 2;
            Exsr CloseFile;
          EndIf;

          If s10Sel3 = 'D';
            w@CurrFile = 3;
            Exsr CloseFile;
          EndIf;

          If s10Sel4 = 'D';
            w@CurrFile = 4;
            Exsr CloseFile;
          EndIf;

          //** Change to the selected file.

          Select;
            When s10Sel1 = 'S';
              w@CurrFile = 1;
            When s10Sel2 = 'S';
              w@CurrFile = 2;
            When s10Sel3 = 'S';
              w@CurrFile = 3;
            When s10Sel4 = 'S';
              w@CurrFile = 4;

            //** If none was selected, make sure we show an open file.

            Other;
              Select;
                When s1File = *Blanks and s2File = *Blanks
                       and s3File = *Blanks and s4File = *Blanks;
                  w@CurrFile = 0;
                When w@CurrFile = 1 and s1File = *Blanks;
                  Select;
                    When s2File <> *Blanks;
                      w@CurrFile = 2;
                    When s3File <> *Blanks;
                      w@CurrFile = 3;
                    When s4File <> *Blanks;
                      w@CurrFile = 4;
                  EndSl;

                When w@CurrFile = 2 and s2File = *Blanks;
                  Select;
                    When s3File <> *Blanks;
                      w@CurrFile = 3;
                    When s4File <> *Blanks;
                      w@CurrFile = 4;
                    When s1File <> *Blanks;
                      w@CurrFile = 1;
                  EndSl;

                When w@CurrFile = 3 and s3File = *Blanks;
                  Select;
                    When s4File <> *Blanks;
                      w@CurrFile = 4;
                    When s1File <> *Blanks;
                      w@CurrFile = 1;
                    When s2File <> *Blanks;
                      w@CurrFile = 2;
                  EndSl;

                When w@CurrFile = 4 and s4File = *Blanks;
                  Select;
                    When s1File <> *Blanks;
                      w@CurrFile = 1;
                    When s2File <> *Blanks;
                      w@CurrFile = 2;
                    When s3File <> *Blanks;
                      w@CurrFile = 3;
                  EndSl;
              EndSl;
          EndSl;

        EndSr;

        //**********************************************************************
        //** SUBROUTINE:  Entry parameters, key lists, define and            ***
        //**Í*INZSR¹      initialize variables, etc.                         ***
        //**********************************************************************

        Begsr *INZSR;

          w@Text = p@Text;

          //** Program housekeeping.

          X = 1;
          w@CurrFile = 1;
          w@FileCount = 1;
          n@File1 = *On;

      /End-Free

      ***
      *** Key Lists.
      ***
     C     ATRKEY        KLIST
     C                   KFLD                    APLIB
     C                   KFLD                    APFILE
      ***
     C                   ENDSR
      **************************************************************************
**
AChar
BBin
EDBei
FFlt
GDBgr
HHex
JDBon
LDate
ODBop
PPack
SZone
TTime
ZTmSt
** File type
DDevice
PPhysical
LLogical
** Data type
ACharacter
BBinary
FFloating
HHex
LDate
PPacked
SZoned
TTime
ZTimestamp