Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB7.ZIP/PTOOL1.BOX

Text File | 1985-01-01 | 56.4 KB | 1,596 lines

{ PTOOL1.BOX     Copyright 1985  R D Ostrander                   Version 1.0
                                 Ostrander Data Services
                                 5437 Honey Manor Dr
                                 Indianapolis  IN  46241

 These Turbo Pascal functions and procedures are a combination of PTOOLDAT.INC
 PTOOLENT.INC and PTOOLSCR.INC with Gregorian and Julian date (D & J) entry
 options added to PTOOLENT and PTOOLSCR. See the individual subroutines for
 details about each. These must be included together since the date checking
 of PTOOLDAT is necessary for date field entries.

 This program has been placed in the Public Domain by the author and copies
 may be freely made for non-commercial, demonstration, or evaluation purposes.
 Use of these subroutines in a program for sale or for commercial purposes in
 a place of business requires a $40 fee be paid to the author at the address
 above.  Personal non-commercial users may also elect to pay the $40 fee to
 encourage further development of this and similar programs. With payment you
 will be able to receive update notices, diskettes and printed documentation
 of this and other PTOOLs from Ostrander Data Services.

 PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services

 Turbo Pascal is a Copyright of Borland International Inc.                  }


{ PTOOLDAT portion of PTOOL1.BOX begins here ****************************** }



{ Constants and Parameters Begin Here ************************************* }


TYPE

     PTOOLDAT_Str_21   = String [21];                    {Gregorian Dates    }
     PTOOLDAT_Str_3    = String [3];                     {Order of elements  }
     PTOOLDAT_Str_9    = String [9];                     {Day of Week        }
     PTOOLDAT_Elements = Array [1..3]  of String [21];   {Parsing elements   }
     PTOOLDAT_Numbers  = Array [1..3]  of Integer;       {Parsing numbers    }
     PTOOLDAT_Months   = Array [1..12] of String [9];    {Months Names       }
     PTOOLDAT_Days     = Array [1..7]  of PTOOLDAT_Str_9;{Days of the Week   }


CONST

   { Gregorian Date      A string expression of up to 21 characters.
     --------------      example:  02/15/50  or  February 2, 1950

                         The order and style to display the elements
                         (Month, Day, Year) are determined by the
                         parameters below.

                         As an argument, the date is passed as a string
                         expression with 3 elements in the same order as
                         displayed separated by at least one of the
                         characters  / - , . ' ; : ( ) · or a space.      }

                                           {    Gregorian Date parameters    }
                                           {*********************************}
 PTOOLDAT_G_YrDisp  : Byte        = 2;     { # of Display Chars for Year     }
                                           {     2    = 50                   }
                                           {     4    = 1950                 }
 PTOOLDAT_G_MoDisp  : Byte        = 2;     { # of Display Chars for Month    }
                                           {     2    = 02                   }
                                           {     3    = Feb                  }
                                           {     9    = February             }
 PTOOLDAT_G_DaDisp  : Byte        = 2;     { # of Display Chars for Day      }
                                           {     2    = 15                   }
 PTOOLDAT_G_Order   : String [3]  = 'MDY'; { Order of Display                }
                                           {     MDY  = 02 15 50             }
 PTOOLDAT_G_Sep1    : String [3]  = '/';   { 1st Separation Character        }
                                           {     /    = 02/15 50             }
 PTOOLDAT_G_Sep2    : String [3]  = '/';   { 2nd Separation Character        }
                                           {     /    = 02/15/50             }
 PTOOLDAT_G_ZeroSup : Boolean     = True;  { Zero Suppress Display?          }
                                           {     True =  2/15/50             }
                                           {*********************************}

   { The 2nd Gregorian Date is used solely as input for
     the conversion function PTDGtoG                    }

                                           {  2nd Gregorian Date parameters  }
                                           {*********************************}
 PTOOLDAT_G2_Order  : String [3]  = 'MDY'; { Order of Input                  }
                                           {*********************************}

   { Julian Date      A Real number in either of three formats:
     -----------      A = ANSI Date (YYDDD)  YY is the year within century
                                            DDD is the day of the year
                      B = ANSI Date (YYYYDDD) YYYY is the year
                                              DDD  is the day of the year
                      E = Elapsed days since January 1 of the base year below.
                               Note that this may result in a negative number
                               if the date is previous to the base year
                          CAUTION - If the base year below is changed, this
                               value becomes meaningless.



                                           {      Julian Date parameter      }
                                           {*********************************}
 PTOOLDAT_J_Type    : Char        = 'A';   { Julian Date Type                }
                                           {     A    = ANSI Date (YYDDD)    }
                                           {                      (50046)    }
                                           {     B    = ANSI DATE (YYYYDDD)  }
                                           {                      (1950046)  }
                                           {     E    = Days since January   }
                                           {                1st of base year }
                                           {                      (7350)     }
                                           {*********************************}

   { Short Date      An integer value representing the number of days since
     ----------      January 1 of the base year below minus 32765. USE WITH
                     CAUTION, dates earlier than the base year or later than
                     179 years after the base year cannot be calculated (date
                     returned is -32766). This date is useful for saving disk
                     or table storage only - it must be changed back to
                     another form to be used.

     Day of Week      A String expression of up to 9 characters
     -----------      The format depends on the parameter below:

                1 = 1      2      3       4         5        6      7
                3 = Sun    Mon    Tue     Wed       Thr      FrI    Sat
                9 = Sunday Monday Tuesday Wednesday Thursday Friday Saturday }

                                           {      Day of Week parameter      }
                                           {*********************************}
 PTOOLDAT_Day_Type  : Byte        = 3;     { Day of week Type                }
                                           {     1    = 4                    }
                                           {     2    = We                   }
                                           {     3    = Wed                  }
                                           {     9    = Wednesday            }
                                           {*********************************}

    {Base Year        This is used for dates in Julian Type B format, for
     ---------           conversion of dates entered without a century, and
                         for Short format dates.
                      If Base Year is 1930 then the year 50 will be calculated
                         as 1950, the year 29 will be calculated as 2029.    }

 PTOOLDAT_BaseYear  : Integer     = 1930;

{*****   PTOOLDAT Internal usage fields follow:  *****}

 PTOOLDAT_Element   : PTOOLDAT_Elements = (' ', ' ', ' ');
 PTOOLDAT_Number    : PTOOLDAT_Numbers  = (0, 0, 0);
 PTOOLDAT_ElY       : String [9] = '         ';
 PTOOLDAT_ElM       : String [9] = '         ';
 PTOOLDAT_ElD       : String [9] = '         ';
 PTOOLDAT_NumY      : Integer = 0;
 PTOOLDAT_NumM      : Integer = 0;
 PTOOLDAT_NumD      : Integer = 0;

 PTOOLDAT_Mon   : PTOOLDAT_Months    = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
                                        'Jun', 'Jul', 'Aug', 'Sep', 'Oct',
                                        'Nov', 'Dec');
 PTOOLDAT_Month : PTOOLDAT_Months    = ('January', 'February', 'March',
                                        'April', 'May', 'June', 'July',
                                        'August', 'September', 'October',
                                        'November', 'December');
 PTOOLDAT_Day   : PTOOLDAT_Days      = ('Sun', 'Mon', 'Tue', 'Wed', 'Thr',
                                        'Fri', 'Sat');
 PTOOLDAT_DayOW : PTOOLDAT_Days      = ('Sunday', 'Monday', 'Tuesday',
                                        'Wednesday', 'Thursday', 'Friday',
                                        'Saturday');


{ Internal Functions Begin Here ******************************************* }


Procedure PTOOLDAT_Parse (VAR Test               : PTOOLDAT_Str_21;
                          VAR Number_of_Elements : Integer);

Var
   I, J, E : Byte;                             { Get elements of input }
                                               { Any of the characters }
Begin                                          { below may seperate    }
     I := 1;                                   { the elements.         }
     For E := 1 to 3 do
         Begin
              While (Test [I] in
                          ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' '])
                and (I <= Length (Test)) do
                    I := I + 1;
              J := 1;
              While (not (Test [I] in
                          ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' ']))
                and (I <= Length (Test)) do
                    Begin
                         PTOOLDAT_Element [E] [J] := Test [I];
                         J := J + 1;
                         I := I + 1;
                         Number_of_Elements := E;
                         PTOOLDAT_Element [E] [0] := Char (J - 1);
                    End;
         End;
     While (Test [I] in ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' '])
       and (I <= Length (Test)) do
           I := I + 1;
     If (not (Test [I] in ['/', '-', ',', '.', ';', ':', '(', ')', '·', ' ']))
       and (I <= Length (Test)) then
           Number_of_Elements := 4;
End;


Function PTOOLDAT_Set_Century (InYear : Integer) : Integer;

Var                                   { Add correct century based on Base }
   Century : Integer;                 { Year - if less than then next     }
                                      { century else same.                }
Begin
     Century := Trunc (Int ( PTOOLDAT_BaseYear / 100)) * 100;
     If InYear >= PTOOLDAT_BaseYear - Century
     then PTOOLDAT_Set_Century := Century + InYear
     else PTOOLDAT_Set_Century := Century + InYear + 100;
End;


Function PTOOLDAT_GetNum (Test : PTOOLDAT_Str_21; MDY : Char) : Integer;

Var
   Number    : Integer;                         { Get the number of the }
   Code      : Integer;                         { Month, Day, or Year   }
   I, J      : Byte;
   Year      : Integer;
   Century   : Integer;
   Ch        : Char;
   TestMon   : String [3];
   TestMonth : String [9];

Begin
     PTOOLDAT_GetNum := 0;
     Number := 0;
     Val (Test, Number, Code);
     Case MDY of
      'M' : If (Code = 0)
           and (Number in [1..12]) then
               PTOOLDAT_GetNum := Number
            else
               Begin
                    For I := 1 to 21 do
                        Begin
                             Ch := Test [I];
                             Test [I] := UpCase (Ch);
                        End;
                    For I := 1 to 12 do
                        Begin
                             For J := 1 to 3 do
  { Check for    }               Begin
  { alphabetic   }                    Ch := PTOOLDAT_Mon [I] [J];
  { month inputs }                    TestMon [J] := UpCase (Ch);
                                 End;
                             For J := 1 to 9 do
                                 Begin
                                      Ch := PTOOLDAT_Month [I] [J];
                                      TestMonth [J] := UpCase (Ch);
                                 End;
                             TestMon [0] := PTOOLDAT_Mon [I] [0];
                             TestMonth [0] := PTOOLDAT_Month [I] [0];
                             If (Test = TestMon)
                             or (Test = TestMonth) then
                                PTOOLDAT_GetNum := I;
                        End;
               End;
      'D' : If Code = 0 then
               If Number in [1..31] then PTOOLDAT_GetNum := Number;
      'Y' : If Code = 0 then
               If Number > 99 then PTOOLDAT_GetNum := Number
                 else
                  PTOOLDAT_GetNum := PTOOLDAT_Set_Century (Number);
      End; {Case}
End;


Function PTOOLDAT_Leap_Year (InYear : Integer) : Boolean;

Var                                          { Find out if it's a Leap Year }
   Century : Integer;
   Year    : Integer;

Begin
     If InYear < 100 then
        InYear := PTOOLDAT_Set_Century (InYear);
     Century := Trunc (Int (InYear / 100));
     Year := InYear - (Century * 100);
     PTOOLDAT_Leap_Year := True;
     If Year <> (Trunc (Int (Year / 4)) * 4) then PTOOLDAT_Leap_Year := False;
     If (Year = 0) and
        (Century = (Trunc (Int (Century / 4)) * 4)) and
        (Century <> (Trunc (Int (Century / 10)) * 10)) then
           PTOOLDAT_Leap_Year := False;
End;


Function PTOOLDAT_G_Check (Test : PTOOLDAT_Str_21;
                           OrderIn : PTOOLDAT_Str_3)
                          : Boolean;

Var                                      { Find out if the Element areas    }
   Num_of_El : Integer;                  { represent a valid Gregorian date }
   E         : Byte;                     { and set Number areas             }
   Ok        : Boolean;

Begin
     Ok := True;
     PTOOLDAT_Parse (Test, Num_of_El);
     If Num_of_El <> 3 then
        Ok := False;
     For E := 1 to 3 do
         Begin
              PTOOLDAT_Number [E] := PTOOLDAT_GetNum (PTOOLDAT_Element [E],
                                                      OrderIn [E]);
              If PTOOLDAT_Number [E] = 0 then Ok := False;
         End;
     If Ok = True then
        Begin
             For E := 1 to 3 do
                 Case OrderIn [E] of
                  'Y' : PTOOLDAT_NumY := PTOOLDAT_Number [E];
                  'M' : PTOOLDAT_NumM := PTOOLDAT_Number [E];
                  'D' : PTOOLDAT_NumD := PTOOLDAT_Number [E];
                  End; {Case}
             If PTOOLDAT_NumD > 30 then
                If not (PTOOLDAT_NumM in [1, 3, 5, 7, 8, 10, 12]) then
                   Ok := False;
             If (PTOOLDAT_NumD > 29) and
                (PTOOLDAT_NumM = 2) then Ok := False;
             If (PTOOLDAT_NumD > 28) and
                (PTOOLDAT_NumM = 2) and
                (PTOOLDAT_Leap_Year (PTOOLDAT_NumY) = False) then
                Ok := False;
        End;
     PTOOLDAT_G_Check := Ok;
End;


Function PTOOLDAT_Make_G : PTOOLDAT_Str_21;

Var                              { Transform the Number & Element areas }
   E      : Byte;                { into a Gregorian date                }
   Output : String [21];

Begin
     If PTOOLDAT_G_YrDisp = 2 then
        Str (PTOOLDAT_NumY - (Trunc (Int (PTOOLDAT_NumY / 100)) * 100):2,
             PTOOLDAT_ElY)
     else
        Str (PTOOLDAT_NumY:4, PTOOLDAT_ElY);
     If PTOOLDAT_ElY [1] = ' ' then PTOOLDAT_ElY [1] := '0';
     Case PTOOLDAT_G_MoDisp of
      2 : Begin
               Str (PTOOLDAT_NumM:2, PTOOLDAT_ElM);
               If PTOOLDAT_ElM [1] = ' ' then
                  If PTOOLDAT_G_ZeroSup then Delete (PTOOLDAT_ElM, 1, 1)
                                        else PTOOLDAT_ElM [1] := '0';
          End;
      3 : PTOOLDAT_ElM := PTOOLDAT_Mon [PTOOLDAT_NumM];
      9 : PTOOLDAT_ElM := PTOOLDAT_Month [PTOOLDAT_NumM];
     End; {Case}
     Str (PTOOLDAT_NumD:2, PTOOLDAT_ElD);
     If PTOOLDAT_ElD [1] = ' ' then
        If PTOOLDAT_G_ZeroSup then Delete (PTOOLDAT_ElD, 1, 1)
                              else PTOOLDAT_ElD [1] := '0';
     Output := '';
     For E := 1 to 3 do
         Begin
              Case PTOOLDAT_G_Order [E] of
               'Y' : Output := Output + PTOOLDAT_ElY;
               'M' : Output := Output + PTOOLDAT_ElM;
               'D' : Output := Output + PTOOLDAT_ElD;
               End; {Case}
              Case E of
               1 : Output := Output + PTOOLDAT_G_Sep1;
               2 : Output := Output + PTOOLDAT_G_Sep2;
               End; {Case}
         End;
     PTOOLDAT_Make_G := Output;
End;


Function PTOOLDAT_G_Convert (Test  : PTOOLDAT_Str_21;
                             OrderIn, OrderOut : PTOOLDAT_Str_3)
                            : PTOOLDAT_Str_21;

Begin                                               { Transform date formats }
     PTOOLDAT_G_Convert := ' ';
     If PTOOLDAT_G_Check (Test, OrderIn) then
        PTOOLDAT_G_Convert := PTOOLDAT_Make_G;
End;


Function PTOOLDAT_Day_of_Year : Integer;

Var                                           { Get Day of Year }
   Result : Integer;

Const
     Days : Array [1..12] of Integer = (0, 31, 59, 90, 120, 151, 181, 212,
                                        243, 273, 304, 334);

Begin
      Result := Days [PTOOLDAT_NumM] + PTOOLDAT_NumD;
      If (PTOOLDAT_NumM > 2) and
         (PTOOLDAT_Leap_Year (PTOOLDAT_NumY)) then
         Result := Result + 1;
      PTOOLDAT_Day_of_Year := Result;
End;


Function PTOOLDAT_J_Type_E : Real;

Var                                        { Get 'E' type Julian Date from }
   Accum : Real;                           { Number area                   }
   I, J  : Integer;

Begin
     If PTOOLDAT_BaseYear <= PTOOLDAT_NumY then
        Begin
             J := Trunc ( Int((PTOOLDAT_NumY - PTOOLDAT_BaseYear) / 4));
             Accum := Int (J) * 1461;
             I := PTOOLDAT_BaseYear + (J * 4);
             While I < PTOOLDAT_NumY do
                   Begin
                        If PTOOLDAT_Leap_Year (I) then Accum := Accum + 366
                                                  else Accum := Accum + 365;
                        I := I + 1;
                  End;
             PTOOLDAT_J_Type_E := Accum + PTOOLDAT_Day_of_Year - 1;
        End
     else
        Begin
             If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then
                Accum := 367 - PTOOLDAT_Day_of_Year
             else
                Accum := 366 - PTOOLDAT_Day_of_Year;
             J := Trunc ( Int ((PTOOLDAT_BaseYear - PTOOLDAT_NumY) / 4));
             Accum := Accum + (Int (J) * 1461);
             I := PTOOLDAT_NumY + 1 + (J * 4);
             While I < PTOOLDAT_BaseYear do
                   Begin
                        If PTOOLDAT_Leap_Year (I) then Accum := Accum + 366
                                                  else Accum := Accum + 365;
                        I := I + 1;
                   End;
             PTOOLDAT_J_Type_E := Accum * -1;
        End;
End;


Procedure PTOOLDAT_Set_M_D (Input : Real);

Var                                               { Get Month & Day }
   InInt    : Integer;                            { from DDD        }
   I        : Byte;
   J        : Integer;
   DayTest  : Array [1..12] of Integer;

Const
     Days : Array [1..12] of Integer = (0, 31, 59, 90, 120, 151, 181, 212,
                                        243, 273, 304, 334);

Begin
     InInt := Trunc (Input - ((Int (Trunc (Input / 1000))) * 1000));
     Move (Days, DayTest, 24);
     If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then
        For I := 3 to 12 do
            DayTest [I] := DayTest [I] + 1;
     For I := 1 to 12 do
         If InInt > DayTest [I] then
            Begin
                 PTOOLDAT_NumM := I;
                 J := DayTest [I];
            End;
     PTOOLDAT_NumD := InInt - J;
End;


Procedure PTOOLDAT_J_E_Eval (Input : Real);
                                                { Convert a Julian type 'E' }
Var                                             { date to Number area       }
   Years, Days  : Integer;
   I            : Byte;
   Test         : Integer;

Begin
     If Input >= 0 then
        Begin
             Years := Trunc (Input / 1461);
             Days := Trunc (Input - (Int (Years) * 1461)) + 1;
             PTOOLDAT_NumY := PTOOLDAT_BaseYear;
             For I := 1 to 4 do
                 Begin
                      If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Test := 366
                                                            else Test := 365;
                      If Days > Test then
                         Begin
                              Days := Days - Test;
                              PTOOLDAT_NumY := PTOOLDAT_NumY + 1;
                         End;
                 End;
             PTOOLDAT_NumY := PTOOLDAT_NumY + (Years * 4);
        End
     else
        Begin
             Input := Input * -1;
             Years := Trunc (Input / 1461);
             Days := Trunc (Input - (Int (Years) * 1461));
             PTOOLDAT_NumY := PTOOLDAT_BaseYear - 1;
             For I := 1 to 4 do
                 Begin
                      If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Test := 366
                                                            else Test := 365;
                      If Days > Test then
                         Begin
                              Days := Days - Test;
                              PTOOLDAT_NumY := PTOOLDAT_NumY - 1;
                         End;
                 End;
             PTOOLDAT_NumY := PTOOLDAT_NumY - (Years * 4);
             If PTOOLDAT_Leap_Year (PTOOLDAT_NumY) then Days := 367 - Days
                                                   else Days := 366 - Days;
        End;
     PTOOLDAT_Set_M_D (Days);
End;


Procedure PTOOLDAT_J_AB_Set_Y (Input : Real);     { Put Year in Number area }
                                                  { From YYmmm              }
Begin
     PTOOLDAT_NumY := Trunc (Input / 1000);
     If PTOOLDAT_NumY < 100 then
        PTOOLDAT_NumY := PTOOLDAT_Set_Century (PTOOLDAT_NumY);
End;


Function PTOOLDAT_Get_Jul : Real;
                                          { Get Julian Date from Number area }
Begin
     Case PTOOLDAT_J_Type of
      'A' : PTOOLDAT_Get_Jul := (Int (PTOOLDAT_NumY) * 1000)
                              - (Int (PTOOLDAT_NumY / 100) * 100000.0)
                              + Int (PTOOLDAT_Day_of_Year);
      'B' : PTOOLDAT_Get_Jul := (Int (PTOOLDAT_NumY) * 1000)
                              + Int (PTOOLDAT_Day_of_Year);
      'E' : PTOOLDAT_Get_Jul := PTOOLDAT_J_Type_E;
      End; {Case}
End;


Function PTOOLDAT_Get_S : Integer;
                                      { Get Short date from Number area }
Var
   Julian : Real;

Const
     MaxJul : Real = 65532.0;

Begin
     Julian := PTOOLDAT_J_Type_E;
     If (Julian >= 0) and
        (Julian <= MaxJul) then PTOOLDAT_Get_S := Trunc (Julian - 32765)
                           else PTOOLDAT_Get_S := -32766;
End;


Function PTOOLDAT_DOW (Day : Integer) : PTOOLDAT_Str_9;

Var
   Hold_DOW : PTOOLDAT_Str_9;                     { Convert 1 - 7 to day }
                                                  { of week verbage      }
Begin
     Case PTOOLDAT_Day_Type of
      1 : Begin
               Str (Day:1, Hold_DOW);
               PTOOLDAT_DOW := Hold_DOW;
          End;
      3 : PTOOLDAT_DOW := PTOOLDAT_Day [Day];
      9 : PTOOLDAT_DOW := PTOOLDAT_DayOW [Day];
      End; {Case}
End;


Function PTOOLDAT_Get_Date : PTOOLDAT_Str_21;

Type                                         { BIOS call to get current date }
    BiosCall = Record
               Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
               End;

Var
    BiosRec          : BiosCall;
    Year, Month, Day : String [4];

Begin
     With BiosRec do
          Begin
               Ax := $2a shl 8;
          End;
     MsDos (BiosRec);
     With BiosRec do
          Begin
               Str (Cx, Year);
               Str (Dx mod 256, Day);
               Str (Dx shr 8, Month);
          End;
     PTOOLDAT_Get_Date := Year + ' ' + Month + ' ' + Day;
End;


{Called Functions Begin Here ******************************************** }


FUNCTION PTDGValid (Test : PTOOLDAT_Str_21) : Boolean;

BEGIN

     PTDGValid := PTOOLDAT_G_Check (Test, PTOOLDAT_G_Order);

END;


FUNCTION PTDJValid (Test : Real) : Boolean;

VAR

   Year   : Integer;
   Day    : Integer;
   Ok     : Boolean;

BEGIN

     Ok := True;
     Case PTOOLDAT_J_Type of
      'A' : If (Test < 1.0) or
               (Test > 99365.0) then Ok := False;
      'B' : If (Test < 1.0) or
               (Test > 9999365.0) then Ok := False;
      End; {Case}
     PTDJValid := Ok;
     If (Ok = True) and
        (PTOOLDAT_J_Type <> 'E') then
        Begin
             Year := Trunc (Test / 1000);
             Day := Trunc (Test - (Int (Year) * 1000));
             If (Day > 366)
             or ((Day = 366) and
                 (PTOOLDAT_Leap_Year (Year) = False))
             or (Day = 0) then
                PTDJValid := False;
        End;

END;


FUNCTION PTDSValid (Short : Integer) : Boolean;

BEGIN

     If Short <> -32766 then PTDSValid := True
                        else PTDSValid := False

END;


FUNCTION PTDGtoJ (Input : PTOOLDAT_Str_21) : Real;

BEGIN

     If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
        PTDGtoJ := PTOOLDAT_Get_Jul;

END;


FUNCTION PTDJtoG (Input : Real) : PTOOLDAT_Str_21;

BEGIN

     PTDJtoG := ' ';
     If PTOOLDAT_J_Type = 'E' then PTOOLDAT_J_E_Eval (Input)
     else
        Begin
             PTOOLDAT_J_AB_Set_Y (Input);
             PTOOLDAT_NumY := Trunc (Input / 1000);
             If PTOOLDAT_NumY < 100 then
                PTOOLDAT_NumY := PTOOLDAT_Set_Century (PTOOLDAT_NumY);
             PTOOLDAT_Set_M_D (Input);
        End;
     PTDJtoG := PTOOLDAT_Make_G;

END;


FUNCTION PTDGtoG (Input : PTOOLDAT_Str_21) : PTOOLDAT_Str_21;

BEGIN

     If PTOOLDAT_G_Check (Input, PTOOLDAT_G2_Order) then
        PTDGtoG := PTOOLDAT_Make_G
     else
        PTDGtoG := ' ';

END;


FUNCTION PTDGtoS (Input : PTOOLDAT_Str_21) : Integer;

BEGIN

     If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
        PTDGtoS := PTOOLDAT_Get_S
     else
        PTDGtoS := -32766;

END;


FUNCTION PTDStoG (Short : Integer) : PTOOLDAT_Str_21;

BEGIN

     If PTDSValid (Short) = False then PTDStoG := ' '
     else
        Begin
             PTOOLDAT_J_E_Eval (Int (Short) + 32765);
             PTDStoG := PTOOLDAT_Make_G;
        End

END;


FUNCTION PTDJtoS (Input : Real) : Integer;

CONST

     MaxJul : Real = 65532.0;

BEGIN

     PTDJtoS := -32766;
     If PTOOLDAT_J_TYPE in ['A', 'B'] then
        Begin
             PTOOLDAT_J_AB_Set_Y (Input);
             PTOOLDAT_Set_M_D (Input);
             PTDJtoS := PTOOLDAT_Get_S;
        End
     else
        If (Input >= 0) and
           (Input <= MaxJul) then PTDJtoS := Trunc (Input - 32765);

END;


FUNCTION PTDStoJ (Short : Integer) : Real;

VAR

   Julian_E : Real;

BEGIN

     Julian_E := Int (Short) + 32765;
     If PTDSValid (Short) then
        If PTOOLDAT_J_Type = 'E' then
           PTDStoJ := Julian_E
        else
           Begin
                PTOOLDAT_J_E_Eval (Julian_E);
                PTDStoJ := PTOOLDAT_Get_Jul;
           End;

END;


FUNCTION PTDGAdd (Input : PTOOLDAT_Str_21;
                  Number : Integer) : PTOOLDAT_Str_21;

BEGIN

     If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
        Begin
             PTOOLDAT_J_E_Eval (PTOOLDAT_J_Type_E + Int (Number));
             PTDGAdd := PTOOLDAT_Make_G;
        End;

END;


FUNCTION PTDJAdd (Input : Real; Number : Integer) : Real;

BEGIN

     If PTOOLDAT_J_Type = 'E' then
        PTDJAdd := (Input + Int (Number))
    else
        Begin
             PTOOLDAT_J_AB_Set_Y (Input);
             PTOOLDAT_Set_M_D (Input);
             PTOOLDAT_J_E_Eval (PTOOLDAT_J_Type_E + Int (Number));
             PTDJAdd := PTOOLDAT_Get_Jul;
        End;

END;


FUNCTION PTDGComp (Minuend, Subtrahend : PTOOLDAT_Str_21) : Real;

VAR
   Hold_Jul_Type : Char;

BEGIN

     Hold_Jul_Type := PTOOLDAT_J_Type;
     PTOOLDAT_J_Type := 'E';
     PTDGComp := PTDGtoJ (Minuend) - PTDGtoJ (Subtrahend);
     PTOOLDAT_J_Type := Hold_Jul_Type;

END;

FUNCTION PTDJComp (Minuend, Subtrahend : Real) : Real;

VAR

   Hold_Jul : Real;

BEGIN

     If PTOOLDAT_J_Type = 'E' then PTDJComp := Minuend - Subtrahend
     else
        Begin
             PTOOLDAT_J_AB_Set_Y (Minuend);
             PTOOLDAT_Set_M_D (Minuend);
             Hold_Jul := (PTOOLDAT_J_Type_E);
             PTOOLDAT_J_AB_Set_Y (Subtrahend);
             PTOOLDAT_Set_M_D (Subtrahend);
             PTDJComp := Hold_Jul - (PTOOLDAT_J_Type_E);
        End;

END;


FUNCTION PTDGLeap (Input : PTOOLDAT_Str_21) : Boolean;

BEGIN

     If PTOOLDAT_G_Check (Input, PTOOLDAT_G_Order) then
        PTDGLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY)
     else
        PTDGLeap := False;

END;


FUNCTION PTDJLeap (Input : Real) : Boolean;

BEGIN

     If PTOOLDAT_J_Type = 'E' then
        PTOOLDAT_J_E_Eval (Input)
     else
        PTOOLDAT_J_AB_Set_Y (Input);
     PTDJLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY);

END;


FUNCTION PTDSLeap (Input : Integer) : Boolean;

BEGIN

     If PTDSValid (Input) = False then PTDSLeap := False
     else
        Begin
             PTOOLDAT_J_E_Eval (Int (Input) + 32765);
             PTDSLeap := PTOOLDAT_Leap_Year (PTOOLDAT_NumY);
        End;

END;


FUNCTION PTDYLeap (Input : Integer) : Boolean;

BEGIN

     PTDYLeap := PTOOLDAT_Leap_Year (Input);

END;


FUNCTION PTDGDay (Input : PTOOLDAT_Str_21) : PTOOLDAT_Str_9;

VAR

   Hold_Base_Year : Integer;
   Hold_Jul_Type    : Char;
   Day            : Integer;

BEGIN

     Hold_Base_Year := PTOOLDAT_BaseYear;
     PTOOLDAT_BaseYear := 0100;
     Hold_Jul_Type := PTOOLDAT_J_Type;
     PTOOLDAT_J_Type := 'E';
     Day := Trunc (Frac (PTDGtoJ (Input) / 7) * 7.001) + 1;
     PTDGDay := PTOOLDAT_DOW (Day);
     PTOOLDAT_BaseYear := Hold_Base_Year;
     PTOOLDAT_J_Type := Hold_Jul_Type;

END;


FUNCTION PTDJDay (Input : Real) : PTOOLDAT_Str_9;

BEGIN

     PTDJDay := PTDGDay (PTDJtoG (Input));

END;


FUNCTION PTDSDay (Input : Integer) : PTOOLDAT_Str_9;

BEGIN

     PTDSDay := PTDGDay (PTDStoG (Input));

END;


FUNCTION PTDGCurr : PTOOLDAT_Str_21;

BEGIN

     PTDGCurr := PTOOLDAT_G_Convert (PTOOLDAT_Get_Date,
                                     'YMD', PTOOLDAT_G_Order);

END;


FUNCTION PTDJCurr : Real;

BEGIN

     PTDJCurr := PTDGtoJ (PTDGCurr);

END;


FUNCTION PTDSCurr : Integer;

BEGIN

     PTDSCurr := PTDGtoS (PTDGCurr);

END;



{ PTOOLENT portion of PTOOL1.BOX begins here *************************** }


Procedure PTOOLENT (VAR Data;                  { Note - Untyped           }
                        TypeData   : Char;     { Must be I, R, S, G, or J }
                        Size,                  { Must be 1 to 80          }
                        Decimals   : Integer;  { Only for type R          }
                    VAR OutEndCode : Integer); { Return Code              }


Var

   PassI        : Integer       absolute Data;  { Initial Data               }
   PassR        : Real          absolute Data;
   PassS        : String [80]   absolute Data;
   Ch, Ch2      : Char;                         { Keyboard Input             }
   CurrS, SaveS : String [80];                  { Working Data               }
   I, J         : Integer;                      { Position Pointers          }
   DispX, DispY : Integer;                      { Initial Cursor Location    }
   Done         : Boolean;                      { Switch for end of edit     }
   ErrCode      : Integer;                      { Used for String to Numeric }
   Dot          : Char;                         { Space character on screen  }
   InputType    : Char;


Const

   InsertKey : Boolean = False;                   { Insert On/Off Switch    }
   PrevS     : String [80] = 'No data available'; { Holding area for Ctrl-P }


Function PowerOf (Number, Power : Integer) : Real;  { Exponentiation Routine }

     Var
        J    : Integer;
        Work : Real;

     Begin
          Work := Number;
          For J := 1 to Power - 1 do
              Work := Work * 10;
          PowerOf := Work;
     End;


Function LowCase (Ch : Char) : Char;      { Convert Upper to Lower Case }

     Begin
          If Ord (Ch) in [65 .. 90] then
             LowCase := Char (Ord (Ch) + 32)
          else
             LowCase := Ch;
     End;


Procedure Beep;                   { Make a short sound }

     Begin
          Sound (880);
          Delay (150);
          NoSound;
     End;

Procedure Display;                 { Display the Current Data }

     Begin
          Gotoxy (DispX, DispY);
          CurrS [0] := Char(Size);
          Write (CurrS);
     End;

Procedure AddASpace;              { Put a Dot at the Right end of the Data }

     Begin
          Insert (Dot, CurrS, Size + 1);
     End;

Procedure LeftJustify;                  { Left Justify the data }

     Begin
          For J := 1 to Size do
              If CurrS [1] = Dot then
                 Begin
                      Delete (CurrS, 1, 1);
                      AddASpace;
                 End;
     End;

Procedure InsertSwitch;         { Turn Insert On or Off (Toggle) }

type
    BiosCall = Record
               Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
               End;
    XferArea = Record
               Case Boolean of
                    True  : (Lo, Hi : Byte);
                    False : (I : Integer);
               End;

var
    BiosRec            : BiosCall;
    XferRec            : XferArea;


Begin                                              { Begin of InsertSwitch }
     If InsertKey = True then InsertKey := False
                         else InsertKey := True;

     XferRec.Lo := 0;                 { This calls IBM DOS BIOS to }
     XferRec.Hi := 1;                 { alter the cursor mode.     }
     BiosRec.Ax := XferRec.I;
     XferRec.Lo := 7;
     If InsertKey = True then XferRec.Hi := 4
                         else XferRec.Hi := 6;
     BiosRec.Cx := XferRec.I;
     Intr(16, BiosRec);
End;


Label

     DisplayPoint;     { If there are errors in numeric data the program
                         returns to DisplayPoint.                        }

BEGIN                              { Begin of PTOOLENT Procedure }

     Dot     := Char (250);        { A Little tiny Dot }
     Done    := False;
     ErrCode := 0;
     DispX   := WhereX;
     DispY   := WhereY;
     FillChar (CurrS, Size + 1, Dot);
     InputType := TypeData;
     Case TypeData of
          'J' : TypeData := 'R';
          'G' : TypeData := 'S';
          End; {Case}
     Case TypeData of                                                { Move  }
          'I' : If PassI <> 0 then Str (PassI:Size, CurrS);          { input }
          'R' : If PassR <> 0 then Str (PassR:Size:Decimals, CurrS); { data  }
          'S' : CurrS := PassS;                                      { to    }
          End; {Case}                                                { CurrS }
     If (TypeData = 'I') or (TypeData = 'R') then    { Left Justify }
          For I := 1 to Size do                      { Numeric Data }
              If CurrS [1] = ' ' then
                 Begin
                      Delete (CurrS, 1, 1);
                      AddASpace;
                 End;
     For I := 1 to Size do
         If CurrS [I] = ' ' then CurrS [I] := Dot;
     CurrS [0] := Char (Size);
     I := 1;
     SaveS := CurrS;
  DisplayPoint:
     Display;
     While NOT Done Do                      { Main editing loop }
           Begin
                If I < 1 then                       { Check cursor position }
                   Begin
                        I := 1;
                        Beep;
                   End;
                If I > Size then
                   Begin
                        I := Size;
                        Beep;
                   End;
                Gotoxy (DispX + I - 1, DispY);
                Ch  := Char(00);                    { Get Keyboard input    }
                Ch2 := Char(00);                    { This handles extended }
                Read (KBD, Ch);                     { Keystrokes            }
                If Keypressed then Read (KBD, Ch2);
                If Ord(Ch) = 27 then                { If CH is 027 then     }
                   Case Ord(Ch2) of                 { check second part     }
       {Back Tab       }  15 : Begin
                                    I := I - 1;
                                    While ((CurrS [I] = Dot) or
                                           (CurrS [I] = '.'))
                                      and (I > 1) do
                                          I := I - 1;
                                    While (CurrS [I] <> Dot)
                                      and (CurrS [I] <> '.')
                                      and (I > 1) do
                                          I := I - 1;
                                    If (CurrS [I] = Dot) or
                                       (CurrS [I] = '.') then I := I + 1;
                               End;
       {Left Arrow     }  75 : I := I -1;
       {Right Arrow    }  77 : I := I +1;
       {Ins            }  82 : InsertSwitch;
       {Del            }  83 : Begin
                                    Delete (CurrS, I, 1);
                                    AddASpace;
                                    Display;
                               End;
       {Ctrl-LeftArrow } 115 : If I = 1 then Beep
                                        else I := 1;
       {Ctrl-RightArrow} 116 : Begin
                                    I := Size;
                                    While (CurrS [I] = Dot)
                                      and (I > 0) do
                                          I := I - 1;
                                    If I < Size then
                                       I := I + 1;
                               End;
                          else Begin
                                    Done := True;
                                    OutEndCode := Ord(Ch2);
                               End;
                        End {Case}
                    else
                   Begin                       { If not 027 the check first }
                        If Ord (Ch) = 32 then
                           Ch := Dot;            { Make space bar a dot }
                        Case Ord(Ch) of
       {Ctrl-C  End    }      3 : Begin
                                       Done := True;
                                       OutEndCode := 3;
                                  End;
       {Ctrl-D  LowCase}      4 : Begin
                                       For J := 1 to Size do
                                           CurrS [J] := LowCase (CurrS [J]);
                                       Display;
                                  End;
       {Ctrl-E  Erase  }      5 : Begin
                                       PrevS := CurrS;
                                       FillChar (CurrS [1], Size, Dot);
                                       Display;
                                       I := 1;
                                  End;
       {Ctrl-F  Fill   }      6 : Begin
                                       If I > 1 then J := I - 1
                                                else J := 1;
                                       FillChar (CurrS [J + 1], Size - J,
                                                 CurrS [J]);
                                       Display;
                                  End;
       {Backspace      }      8 : If I > 1 then
                                     Begin
                                          Delete (CurrS, I - 1, 1);
                                          AddASpace;
                                          Display;
                                          I := I - 1;
                                     End
                                     else Beep;
       {Tab            }      9 : Begin
                                       While (CurrS [I] <> Dot)
                                         and (CurrS [I] <> '.')
                                         and (I < Size) do
                                             I := I + 1;
                                       While ((CurrS [I] = Dot) or
                                              (CurrS [I] = '.'))
                                         and (I < Size) do
                                             I := I + 1;
                                  End;
       {Ctrl-L  L-Just }     12 : Begin
                                       LeftJustify;
                                       Display;
                                       I := 1;
                                  End;
       {C/R    End     }     13 : Begin
                                       Done := True;
                                       OutEndCode := 1;
                                  End;
       {Ctrl-N  Quit   }     14 : Begin
                                       CurrS := SaveS;
                                       Done := True;
                                       OutEndCode := 1;
                                  End;
       {Ctrl-P  Prev.  }     16 : Begin
                                       For I := 1 to Size do
                                           CurrS [I] := PrevS [I];
                                       I := 1;
                                       Display;
                                  End;
       {Ctrl-Q  Quit   }     17 : Begin
                                       CurrS := SaveS;
                                       Done := True;
                                       OutEndCode := 1;
                                  End;
       {Ctrl-R  R-Just }     18 : Begin
                                       I := Size;
                                       While (CurrS [I] = Dot)
                                         and (I > 0) do
                                             I := I - 1;
                                       If I < Size then
                                          Begin
                                               J := Size - I;
                                               For I := 1 to J do
                                                   Insert (Dot, CurrS, 1);
                                          End;
                                       I := 1;
                                       While CurrS [I] = Dot do
                                             I := I + 1;
                                       Display
                                  End;
       {Ctrl-S  Restart}     19 : Begin
                                       CurrS := SaveS;
                                       I := 1;
                                       Goto DisplayPoint;
                                  End;
       {Ctrl-T  CurrDate}    20 : Begin
                                       If InputType = 'G' then
                                           CurrS := PTDGCurr
                                       else
                                          If InputType = 'J' then
                                             Str (PTDJCurr:Size:0, CurrS);
                                       Display;
                                  End;
       {Ctrl-U  UpCase }     21 : Begin
                                       For J := 1 to Size do
                                           CurrS [J] := UpCase (CurrS [J]);
                                       Display;
                                  End;
       {Ctrl-X  ClrEol }     24 : Begin
                                       FillChar (CurrS [I], Size - I + 1,
                                                 Dot);
                                       Display;
                                  End;
                        else If InsertKey = False then
                                Begin
                                     Write (Ch);
                                     CurrS [I] := Ch;
                                     I := I + 1;
                                     If I > Size then
                                        Begin
                                             Done := True;
                                             OutEndCode := 2;
                                        End;
                                End
                                 else
                                Begin
                                     Insert (Ch, CurrS, I);
                                     I := I + 1;
                                     Display;
                                     If I > Size then
                                        Begin
                                             Done := True;
                                             OutEndCode := 2;
                                        End;
                                End;
                        End; {Case}
                   End;
           End;

    If (TypeData = 'I')                { Left Justify Numeric data and }
    or (TypeData = 'R') then           { check for imbedded spaces     }
       Begin
            LeftJustify;
            I := 1;
            While (CurrS [I] <> Dot)
              and (I <= Size) do
                  I := I + 1;
            For J := I to Size do
                If CurrS [J] <> Dot then
                   Begin
                        Beep;
                        I := J - 1;
                        Done := False;
                        Goto DisplayPoint;
                   End;
            CurrS [0] := Char (I - 1);
       End;
    If InsertKey = True then InsertSwitch;       { Turn off insert }
    ErrCode := 0;
    If TypeData = 'I' then
       Val (CurrS, PassI, ErrCode);
    If TypeData = 'R' then                    { Check size of Real data -    }
       Begin                                  { must leave room for decimals }
            Val (CurrS, PassR, ErrCode);
            If Decimals > 0 then
               If (PassR >= PowerOf (10, Size - Decimals - 1))
               or (PassR <= PowerOf (10, Size - Decimals - 2) * -1) then
                  Begin
                       Beep;
                       I := 1;
                       Done := False;
                       Goto DisplayPoint;
                  End;
       End;
    If ErrCode <> 0 then            { If numeric data errors, transfer }
       Begin                        { back to re-edit data.            }
            Beep;
            Done := False;
            I := ErrCode;
            Goto DisplayPoint;
       End;
    If InputType = 'J' then
       If not (PTDJValid (PassR)) then
          Begin
               Beep;
               Done := False;
               I := 1;
               Goto DisplayPoint;
          End;
    If InputType = 'G' then
       For I := 1 to Size do
           If CurrS [I] <> Dot then
              If not (PTDGValid (CurrS)) then
                 Begin
                      Beep;
                      Done := False;
                      I := 1;
                      Goto DisplayPoint;
                 End;
    If TypeData = 'S' then                    { Move String data }
       Begin
            For I := 1 to Size do
                If CurrS [I] = Dot then CurrS [I] := ' ';
            CurrS [0] := Char (Size);
            PassS := CurrS;
       End;
    If InputType = 'G' then CurrS := PTDGtoG (CurrS);
    FillChar (PrevS, 80, Dot);                 { Save data }
    PrevS := CurrS;
    Gotoxy (DispX, DispY);                     { Display data }
    Case TypeData of
         'S' : Write (PassS);
         'I' : Write (PassI:Size);
         'R' : Write (PassR:Size:Decimals);
         End; {case}
    Gotoxy (DispX, DispY);                     { Reset cursor }

END;



{ PTOOLSCR portion of PTOOL1.BOX begins here ****************************** }


TYPE

     PTOOLSCR_Field_Array = String [55];

              { Char  1    = Field Type   B = Byte             - 1 byte
                                          C = Char             - 1 byte
                                          D = Dummy            - for display
                                                                 text only
                                          M = Message          - message only
                                          I = Integer          - 2 bytes
                                          R = Real             - 6 bytes
                                          J = Real Julian Date - 6 bytes
                                          S = String  - String length
                                                        plus 1 byte
                                          G = String Gregorian Date
                Char  2-3  = X position of display text
                Char  4-5  = Y position of display text
                Char  6-45 = Up to 40 characters of display text
                Char 46-48 = 1 relative position of field in record
                Char 49-50 = X position of field display verbage
                Char 51-52 = Y position of field display verbage
                Char 53-54 = Display size of field
                Char 55    = Number of decimal places for field type R }


{ Called Procedure Begins Here ******************************************** }


Procedure PTOOLSCR (VAR Record_Area,
                        Table_Area;
                        Num_Fields   : Integer;
                    VAR ReturnCode   : Integer;
                    VAR LastField    : Integer;
                        Display_Only : Char;
                        Paint_Screen : Char;
                        First_Field  : Integer);

VAR

   I             : Integer;
   RecChar       : Array [1..2] of Char                 absolute Record_Area;
   Table         : Array [1..2] of PTOOLSCR_Field_Array absolute Table_Area;
   TableHold     : PTOOLSCR_Field_Array;

   WorkArea      : String [80];
   WByte         : Byte         Absolute WorkArea;
   WInteger      : Integer      Absolute WorkArea;
   WReal         : Real         Absolute WorkArea;
   XorkArea      : String [80];
   XByte         : Byte         Absolute XorkArea;
   XInteger      : Integer      Absolute XorkArea;
   XReal         : Real         Absolute XorkArea;

   TypeData      : Char;
   DescX, DescY  : Byte;
   Desc          : String [40];
   Position      : Integer;
   DispX, DispY  : Byte;
   DispSize      : Integer;
   Decimals      : Integer;

   EditType      : Char;
   SpaceString   : String [80];


Procedure Set_Table (I : Integer);
Var
     TableEntry : PTOOLSCR_Field_Array;
     TableChar  : Array [1..55] of Char absolute TableEntry;
     X          : Byte;
Begin
     TableEntry := Table [I];
     TypeData   := TableChar [2];
     DescX      := ((Ord (TableChar [3]) - 48) * 10)
                  + (Ord (TableChar [4]) - 48);
     DescY      := ((Ord (TableChar [5]) - 48) * 10)
                  + (Ord (TableChar [6]) - 48);
     Move (TableChar [7], Desc [1], 40);
     X := 40;
     While (Desc [X] = ' ') and (X > 1) do
           X := X - 1;
     Desc [0]   := Char (X);
     Position   := ((Ord (TableChar [47]) - 48) * 100)
                 + ((Ord (TableChar [48]) - 48) * 10)
                 +  (Ord (TableChar [49]) - 48);
     DispX      := ((Ord (TableChar [50]) - 48) * 10)
                  + (Ord (TableChar [51]) - 48);
     DispY      := ((Ord (TableChar [52]) - 48) * 10)
                  + (Ord (TableChar [53]) - 48);
     DispSize   := ((Ord (TableChar [54]) - 48) * 10)
                  + (Ord (TableChar [55]) - 48);
     Decimals   :=  (Ord (TableChar [56]) - 48);
End;



BEGIN

For I := 1 to 80 do
    SpaceString [I] := ' ';
If Paint_Screen <> 'X' then
   For I := 1 to Num_Fields do
       Begin
            Set_Table (I);
            If (Paint_Screen <> 'N') and (Desc <> ' ') then
               Begin
               Gotoxy (DescX, DescY);
               Write  (Desc);
               End;
            If TypeData <> 'D' then
               Begin
               Move (RecChar [Position], WorkArea [0], 81);
               Gotoxy (DispX, DispY);
               Case TypeData of
                'B' : Write (Wbyte:DispSize);
                'C' : Write (RecChar [Position]);
                'I' : Write (WInteger:DispSize);
           'J', 'R' : Write (WReal:DispSize:Decimals);
                'M' : Begin
                      SpaceString [0] := Char (DispSize);
                      Write (SpaceString);
                      Gotoxy (DispX, DispY);
                      Write (WorkArea);
                      End;
           'G', 'S' : Write (WorkArea);
                End; {Case}
               End;
       End;
If not (Display_Only in ['D', 'M']) then
   Begin
   I := First_Field;
   While I <= Num_Fields do
         Begin
         Set_Table (I);
         If TypeData in ['D', 'M'] then
            I := I + 1
         else
            Begin
            Move (RecChar [Position], WorkArea [0], 81);
            Gotoxy (DispX, DispY);
            EditType := TypeData;
            Case TypeData of
             'B' : Begin
                   EditType := 'I';
                   XInteger := WByte;
                   End;
             'C' : Begin
                   XorkArea [1] := RecChar [Position];
                   XorkArea [0] := Char (1);
                   EditType     := 'S';
                   End;
             'I' : Xinteger := WInteger;
        'J', 'R' : XReal    := WReal;
        'G', 'S' : XorkArea := WorkArea;
             End; {Case}
            PTOOLENT (XorkArea,
                      EditType,
                      DispSize,
                      Decimals,
                      ReturnCode);
            LastField := I;
            Case TypeData of
             'B' : Begin
                   WByte := XInteger;
                   Move (WByte, RecChar [Position], 1);
                   End;
             'C' : Move (XorkArea [1], RecChar [Position], 1);
             'I' : Move (XorkArea, RecChar [Position], 2);
        'J', 'R' : Move (XorkArea, RecChar [Position], 6);
        'G', 'S' : Move (XorkArea, RecChar [Position],
                         Ord (XorkArea [0]) + 1);
             End; {Case}
            Case ReturnCode of
              1, 2, 80 : Begin
                         I := I + 1;
                         ReturnCode := 1;
                         End;
              71       : I := 1;
              72       : Begin
                         I := I - 1;
                         TableHold := Table [I];
                         While (I >= 1) and (TableHold [1] in ['D', 'M']) do
                               Begin
                               I := I - 1;
                               TableHold := Table [I];
                               End;
                         If I <= 0 then I := 1;
                         End;
               79      : Begin
                         I := Num_Fields;
                         TableHold := Table [I];
                         While (I >= 1) and (TableHold [1] in ['D', 'M']) do
                               Begin
                               I := I - 1;
                               TableHold := Table [I];
                               End;
                         If I <= 0 then I := 1;
                         End;
               else      I := Num_Fields + 1;
            End; {Case}
            End;
         End;
   End;

END;