{ **************************************************************************
  *                                                                        *
  *    HAMGRAM - A message generator for standard ARRL NTS Traffic         *
  *              Uses dBase compatible file structures for storing all     *
  *              elements of the message.  Automatically creates a plain   *
  *              text message with the proper preamble.  Word count in     *
  *              the text of the message is generated by the program.      *
  *                                                                        *
  *              Includes ON-LINE help and PICK-MENUS for certain data     *
  *              elements.                                                 *
  *                                                                        *
  *              This program uses UNITS from TOPAZ a product sold by      *
  *                  The Research Group                                    *
  *                  100 Valley Drive                                      *
  *                  Brisbane, CA 94005                                    *
  *                  (800) HOTWARE                                         *
  *                                                                        *
  *    Author    W1HKJ  Dave Freese                                        *
  *                     29 N. Ravenwood Drive                              *
  *                     Cape May Court House, NJ 08210                     *
  *                     (609)624-0076                                      *
  *                                                                        *
  *    THIS PROGRAM IS PUBLIC DOMAIN SOFTWARE, USE AND DISTRIBUTE FREELY   *
  *    IF YOU MODIFY THE SOURCE CODE PLEASE DO NOT DISTRIBUTE UNDER THE    *
  *    NAME 'HAMGRAM'.                                                     *
  *                                                                        *
  *    Version 1.02    1 September 1989  corrected word count problem      *
  *                                      increased STATION size to 10      *
  *                                      deleted HX in text output if not  *
  *                                      specified in data base            *
  ************************************************************************** }
PROGRAM AmateurRadioGram;

USES CRT,DBF4,SAYGET4,BROWSE4,PICK,VIDPOP,TIMEDATE;

CONST Version = '1.02';
TYPE
    HamGram_record = RECORD
      Deleted     : Boolean;
      _MSG_NBR    : String[ 4];
      _PRECEDENCE : String[ 1];
      _HANDLING   : String[ 1];
      _HANDL_EXT  : String[ 5];
      _STATION    : String[10];
      _ORIGIN     : String[15];
      _FILE_TIME  : String[ 4];
      _FILE_MONTH : String[ 3];
      _FILE_DAY   : String[ 2];
      _ADDRESSEE  : String[25];
      _ADDR1      : String[25];
      _ADDR2      : String[25];
      _CITY       : String[25];
      _STATE      : String[ 2];
      _ZIP        : String[ 5];
      _PHONE      : String[13];
      _TEXT_1     : String[65];
      _TEXT_2     : String[65];
      _TEXT_3     : String[65];
      _SIGN       : String[25];
      _SIGN_ADR1  : String[25];
      _SIGN_ADR2  : String[25];
      _SIGN_CITY  : String[25];
      _SIGN_ST    : String[ 2];
      _SIGN_ZIP   : String[ 5];
      _SIGN_PHN   : String[13];
    END;

VAR
    HamGram : HamGram_record;
    m_MSG_NBR : String[4];
    m_Found : Boolean;
    Choice : Char;
    AddMode : Boolean;
    EditMode : Boolean;
    MRecNo : LongInt;
    OurWorkArea : Byte;
    BrowseFields : String[100];
    dBaseFile : String[64];
    Extension : String[3];
    WordCount : integer;
    OldColors : Byte;
    VidBuffer : array[1..4000] of byte;
    VidX, VidY : byte;

PROCEDURE SayGetColors;
begin
  Set_Color_To(Yellow,Blue,Red,LightGray);
end;

PROCEDURE SaveEntryScreen;
begin
  Writeln('HAMGRAM version  ',version,'  Public Domain Software');
  Writeln('        by W1HKJ Dave Freese');
  Writeln('                 29 N. Ravenwood Drive');
  Writeln('                 Cape May Court House, NJ  08210');
  Writeln('                 (609) 624 0076');
  FillPage(@VidBuffer);
  VidX := WhereX;
  VidY := WhereY;
  OldColors := TextAttr;
end;

PROCEDURE RestoreEntryScreen;
begin
  DisplayPage(@VidBuffer);
  GotoXY(VidX,VidY);
  TextAttr := OldColors;
end;

{$F+} PROCEDURE AutoHelp;
begin
  ClearEOL(10,24);
  case SGFieldCode of
       1 : AT(10,24,'Enter message number');
       2 : AT(10,24,'Precedence : Routine, Priority, Welfare, Emergency');
       3 : AT(10,24,'Handling Instructions: A, B, C, D, E, F, G <F10> for list');
       4 : AT(10,24,'Extension required for A, B, and F handling instructions');
       5 : AT(10,24,'Originating station');
       6 : AT(10,24,'Place of origin ie: Cape May NJ');
       7 : AT(10,24,'File time ... <F10> for system time');
       8 : AT(10,24,'File month');
       9 : AT(10,24,'File day  1..31');
       10: AT(10,24,'Addressee name');
       11: AT(10,24,'Addressee address #1');
       12: AT(10,24,'Addressee address #2');
       13: AT(10,24,'Addressee city');
       14: AT(10,24,'Addressee State  <F10> for list');
       15: AT(10,24,'Addressee Zip Code');
       16: AT(10,24,'Addressee phone number');
       17: AT(10,24,'HamGram line #1');
       18: AT(10,24,'HamGram line #2');
       19: AT(10,24,'HamGram line #3');
       20: AT(10,24,'Sendee name');
       21: AT(10,24,'Sendee address #1');
       22: AT(10,24,'Sendee address #2');
       23: AT(10,24,'Sendee city');
       24: AT(10,24,'Sendee State <F10> for list');
       25: AT(10,24,'Sendee Zip Code');
       26: AT(10,24,'Sendee phone number');
   end;
end;
{$F-}

{$F+} FUNCTION StateName(Var n : integer): String;
begin
  case n of
    1 : StateName := 'Alabama';
    2 : StateName := 'Alaska';
    3 : StateName := 'Arizona';
    4 : StateName := 'Arkansas';
    5 : StateName := 'California';
    6 : StateName := 'Colorado';
    7 : StateName := 'Connecticut';
    8 : StateName := 'Delaware';
    9 : StateName := 'Dist. of Col.';
   10 : StateName := 'Florida';
   11 : StateName := 'Georgia';
   12 : StateName := 'Hawaii';
   13 : StateName := 'Idaho';
   14 : StateName := 'Illinois';
   15 : StateName := 'Indiania';
   16 : StateName := 'Iowa';
   17 : StateName := 'Kansas';
   18 : StateName := 'Kentucky';
   19 : StateName := 'Louisiana';
   20 : StateName := 'Maine';
   21 : StateName := 'Maryland';
   22 : StateName := 'Mass.';
   23 : StateName := 'Michigan';
   24 : StateName := 'Minnesota';
   25 : StateName := 'Mississippi';
   26 : StateName := 'Missouri';
   27 : StateName := 'Montana';
   28 : StateName := 'Nebraska';
   29 : StateName := 'Nevada';
   30 : StateName := 'New Hampshire';
   31 : StateName := 'New Jersey';
   32 : StateName := 'New Mexico';
   33 : StateName := 'New York';
   34 : StateName := 'North Carolina';
   35 : StateName := 'North Dakota';
   36 : StateName := 'Ohio';
   37 : StateName := 'Oklahoma';
   38 : StateName := 'Oregon';
   39 : StateName := 'Pennsylvania';
   40 : StateName := 'Rhode Island';
   41 : StateName := 'South Carolina';
   42 : StateName := 'South Dakota';
   43 : StateName := 'Tennessee';
   44 : StateName := 'Texas';
   45 : StateName := 'Utah';
   46 : StateName := 'Vermont';
   47 : StateName := 'Virginia';
   48 : StateName := 'Washington';
   49 : StateName := 'West Virginia';
   50 : StateName := 'Wisconsin';
   51 : StateName := 'Wyoming';
   52 : StateName := 'Puerto Rico';
  end;
end;
{$F-}

{$F+} PROCEDURE StatePickList;
var i : integer;
begin
  Set_PickWindow_To(60,4,79,22,2,'Select State');
  i := PickList(@StateName,1,51,1);
  case i of
    0 : ;
    1 : SGBuffer^ := 'AL';
    2 : SGBuffer^ := 'AK';
    3 : SGBuffer^ := 'AZ';
    4 : SGBuffer^ := 'AR';
    5 : SGBuffer^ := 'CA';
    6 : SGBuffer^ := 'CO';
    7 : SGBuffer^ := 'CT';
    8 : SGBuffer^ := 'DE';
    9 : SGBuffer^ := 'DC';
   10 : SGBuffer^ := 'FL';
   11 : SGBuffer^ := 'GA';
   12 : SGBuffer^ := 'HA';
   13 : SGBuffer^ := 'ID';
   14 : SGBuffer^ := 'IL';
   15 : SGBuffer^ := 'IN';
   16 : SGBuffer^ := 'IO';
   17 : SGBuffer^ := 'KA';
   18 : SGBuffer^ := 'KY';
   19 : SGBuffer^ := 'LA';
   20 : SGBuffer^ := 'ME';
   21 : SGBuffer^ := 'MD';
   22 : SGBuffer^ := 'MA';
   23 : SGBuffer^ := 'MI';
   24 : SGBuffer^ := 'MN';
   25 : SGBuffer^ := 'MS';
   26 : SGBuffer^ := 'MO';
   27 : SGBuffer^ := 'MN';
   28 : SGBuffer^ := 'NE';
   29 : SGBuffer^ := 'NV';
   30 : SGBuffer^ := 'NH';
   31 : SGBuffer^ := 'NJ';
   32 : SGBuffer^ := 'NM';
   33 : SGBuffer^ := 'NY';
   34 : SGBuffer^ := 'NC';
   35 : SGBuffer^ := 'ND';
   36 : SGBuffer^ := 'OH';
   37 : SGBuffer^ := 'OK';
   38 : SGBuffer^ := 'OR';
   39 : SGBuffer^ := 'PA';
   40 : SGBuffer^ := 'RI';
   41 : SGBuffer^ := 'SC';
   42 : SGBuffer^ := 'SD';
   43 : SGBuffer^ := 'TN';
   44 : SGBuffer^ := 'TX';
   45 : SGBuffer^ := 'UT';
   46 : SGBuffer^ := 'VT';
   47 : SGBuffer^ := 'VI';
   48 : SGBuffer^ := 'WA';
   49 : SGBuffer^ := 'WV';
   50 : SGBuffer^ := 'WI';
   51 : SGBuffer^ := 'WY';
   52 : SGBuffer^ := 'PR';
  end;
end;

{$F+} FUNCTION HandlingInst(var n: integer): String;
begin
  case n of
   1 : HandlingInst := 'A - Collect landline delivery authorized ... miles';
   2 : HandlingInst := 'B - Cancel if not delivered with ... hrs of filing';
   3 : HandlingInst := 'C - Report date & time of delivery to originator';
   4 : HandlingInst := 'D - Report receiver, relay, date, time & method';
   5 : HandlingInst := 'E - Get reply & originate message back';
   6 : HandlingInst := 'F - Hold delivery until .... date';
   7 : HandlingInst := 'G - Delivery by mail or toll not required';
  end;
end;
{$F-}

{$F+} PROCEDURE HandlingPickList;
var i : integer;
begin
  Set_PickWindow_To(15,10,67,18,2,'Valid Handling Instructions');
  i := PickList(@HandlingInst,1,7,1);
  case i of
    0 : ;
    1 : SGBuffer^ := 'A';
    2 : SGBuffer^ := 'B';
    3 : SGBuffer^ := 'C';
    4 : SGBuffer^ := 'D';
    5 : SGBuffer^ := 'E';
    6 : SGBuffer^ := 'F';
    7 : SGBuffer^ := 'G';
  end;
end;
{$F-}

{$F+} PROCEDURE EnterSystemTime;
var TimeStr : string[8];
begin
  TimeStr := SystemTime;
  TimeStr[3] := TimeStr[4];
  TimeStr[4] := TimeStr[5];
  TimeStr[0] := chr(4);
  SGBuffer^ := TimeStr;
end;
{$F-}

{$F+} PROCEDURE F10Help;
begin
  case SGFieldCode of
    3 : HandlingPickList;
    7 : EnterSystemTime;
    14, 24 : StatePickList;
  end;
end;
{$F-}

{$F+} PROCEDURE CountWords;
var i, wds : integer;
    wrdend : boolean;
begin
  wds := 0;
  with HamGram do
    begin
      wrdend := TRUE;
      for i := 1 to Length(_TEXT_1) do
      begin
        if (wrdend = TRUE) AND
           (_TEXT_1[i] in ['A'..'z','0'..'9']) then
          begin
            inc(wds);
            wrdend := FALSE;
          end;
        if _TEXT_1[i] = ' ' then
            wrdend := TRUE;
      end;
      wrdend := TRUE;
      for i := 1 to Length(_TEXT_2) do
      begin
        if (wrdend = TRUE) AND
           (_TEXT_2[i] in ['A'..'z','0'..'9']) then
          begin
            inc(wds);
            wrdend := FALSE;
          end;
        if _TEXT_2[i] = ' ' then
            wrdend := TRUE;
      end;
      wrdend := TRUE;
      for i := 1 to Length(_TEXT_3) do
      begin
        if (wrdend = TRUE) AND
           (_TEXT_3[i] in ['A'..'z','0'..'9']) then
          begin
            inc(wds);
            wrdend := FALSE;
          end;
        if _TEXT_3[i] = ' ' then
            wrdend := TRUE;
      end;
    end;
  gotoxy(67,21);
  WordCount := wds;
  write(WordCount:3);
end;
{$F-}

{$F+} PROCEDURE HelpScreen;
{ Displays a list of menu commands when <F1> or "H" is pressed }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
  FillPage(@ScreenBuffer); { save contents of current screen }
  Window(5,4,75,23);
  Set_Color_To(Black,LightGray,Black,LightGray);
  ClrScr;
  WriteLn('                         Menu Commands');
  WriteLn;
  WriteLn('  N - Next      Skips to and displays next record in file');
  WriteLn('  P - Prev      Skips back one and displays prior record');
  WriteLn('  T - Top       Displays first record in file');
  WriteLn('  O - Bottom    Displays last record in file');
  WriteLn('  G - Go        Positions database on selected record by number');
  WriteLn('  S - Search    Allows searching for imbedded string in key field');
  WriteLn('  E - Edit      Allows modification of currently displayed record');
  WriteLn('  A - Add       Allows input and appends a new record into database');
  WriteLn('  D - Delete    Marks or unmarks current record for deletion by Pack');
  WriteLn('  B - Browse    Spreadsheet-like view of database');
  WriteLn('  C - Pack      Purges database of all records marked for deletion');
  WriteLn('  W - Write     Write standard ARRL HamGram Format for this record');
  WriteLn('  Q - Quit      Quit viewing of database');
  WriteLn;
  Wait('                        Press any key to return...');
  Window(1,1,80,25);
  DisplayPage(@ScreenBuffer); { restore prior screen }
  SayGetColors;
END;   { HelpScreen }
{$F-}

{$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
{ Displays a help screen when <F1> is pressed while editing }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
  FillPage(@ScreenBuffer); { save contents of current screen }
  Set_Color_To(Black,LightGray,Black,LightGray);
  Window(5,3,75,23);
  ClrScr;
  WriteLn('                          Editing Commands');
  WriteLn;
  WriteLn('      <Ctrl-R> or <PgUp>  Move to beginning of first field');
  WriteLn('      <Ctrl-C>  Move to beginning of last field');
  WriteLn('      <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
  WriteLn('      <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
  WriteLn('      <Ctrl-V> or <Ins>  Toggle insert/overwrite mode');
  WriteLn('      <Ctrl-G> or <Del>  Delete character at cursor');
  WriteLn('      <Ctrl-T>  Delete word to right of cursor ');
  WriteLn('      <Ctrl-Y>  Delete all characters to right of cursor');
  WriteLn('      <Ctrl-U>  Restore prior data (Undo)');
  WriteLn('      <Ctrl-S> or <Lft Arrow> Move cursor left one character');
  WriteLn('      <Ctrl-D> or <Rt Arrow> Move cursor right one character');
  WriteLn('      <Ctrl-W> or <PgDn> Exit edit session');
  WriteLn('      <Esc>     Abandon edit');
  WriteLn('      <Home>    Move cursor to first character in field');
  WriteLn('      <End>     Move cursor to last charcter in field');
  WriteLn;
  Wait('                        Press any key to return...');
  Window(1,1,80,25);
  DisplayPage(@ScreenBuffer); { restore prior screen }
  SayGetColors;
END;   { EditHelp }
{$F-}

PROCEDURE Search_MSG_NBR;
 { Sequential search of entire file to find m_MSG_NBR in MSG_NBR }
 { Searches faster if no index is active. }
BEGIN
  SayGet(1,25,' Enter MSG_NBR to locate: ',m_MSG_NBR,_S,4,0);
    Picture('@!');
  Set_Repaint_Off;  { leave field in reverse video on screen }
  ReadGets;
  Set_Repaint_On;   { restore default setting }
  IF EditResult > 0 THEN
    BEGIN
      ClearEOL(1,25);
      Exit;
    END;
  IF M_MSG_NBR <> '' THEN
    BEGIN
      MRecNo := RecNo; { save current position }
      m_Found := False;
      GoTop;            { start at top of file (omit as desired) }
      REPEAT
        IF m_MSG_NBR = HamGram._MSG_NBR THEN
           m_Found := True
        ELSE Skip(1);
        AT(75,25,SInteger(RecNo,0));
      UNTIL m_Found OR dEOF;
      IF Not m_Found THEN
        BEGIN
          GO(MRecNo); { re-position file }
          ClearEOL(1,25);
          Wait(M_MSG_NBR + ' not found.  Press any key...');
        END;
    END;
  ClearEOL(1,25);
END;   { Search_MSG_NBR }


PROCEDURE WriteStatusLine;
BEGIN
  IF AddMode THEN
  AT(2,2,'Record # '+SInteger(RecNo+1,4)+' of '+SInteger(RecCount+1,4)+'      File: '+DBF+'      Last Update: '+LUpdate)
  ELSE
  AT(2,2,'Record # '+SInteger(RecNo,4)+' of '+SInteger(RecCount,4)+'      File: '+DBF+'      Last Update: '+LUpdate);
  IF dBOF OR dEOF THEN RingBell;
END;   { WriteStatusLine }

PROCEDURE HamGramFormat;
begin
  At(6, 4,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵ HAMGRAM VER '+Version+' ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  At(6, 5,'º  Nbr  P  Handling Inst  OrigSta   Place of Origin    Time Mon Day º');
  At(6, 6,'ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
  At(6, 7,'º           HX                                                      º');
  At(6, 8,'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
  At(6, 9,'º   To:                                Phone # (   )   -            º');
  At(6,10,'º                                                                   º');
  At(6,11,'º                                                                   º');
  At(6,12,'º                                                                   º');
  At(6,13,'ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
  At(6,14,'º                                                                   º');
  At(6,15,'º                                                                   º');
  At(6,16,'º                                                                   º');
  At(6,17,'ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
  At(6,18,'º From:                                Phone # (   )   -            º');
  At(6,19,'º                                                                   º');
  At(6,20,'º                                              ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
  At(6,21,'º                                              ³Word Count :        º');
  At(6,22,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵ W 1 H K J ÆÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
end;

PROCEDURE DoGetsWith_HamGram;
BEGIN
  ClrScr;
  WriteStatusLine;
  CountWords;
  IF EditMode OR AddMode THEN ClearEOL(1,23);
  IF AddMode THEN ClearRecord;
  HamGramFormat;
  WITH HamGram DO
    BEGIN
      IF deleted THEN AT(10,3,'DELETED')
      ELSE AT(10,3,'       ');

      Set_FKEY(F10, @F10Help);

      SayGet( 8, 7,'', _MSG_NBR,    _S, 4, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14, 7,'', _PRECEDENCE, _S, 1, 0);
        Picture('!');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(20, 7,'', _HANDLING,   _S, 1, 0);
        Picture('!');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(23, 7,'', _HANDL_EXT,  _S, 5, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(30, 7,'', _STATION,    _S,10, 0);
        Picture('@!');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(42, 7,'', _ORIGIN,     _S, 15, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(61, 7,'', _FILE_TIME,  _S, 4, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(66, 7,'', _FILE_MONTH, _S, 3, 0);
        Picture('@!');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(70, 7,'', _FILE_DAY,   _S, 2, 0);
        Set_AutoHelp_To(@AutoHelp);

      SayGet(14, 9,'', _ADDRESSEE, _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14,10,'', _ADDR1,     _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14,11,'', _ADDR2,     _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14,12,'', _CITY,      _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(41,12,'', _STATE,     _S, 2, 0);
        Picture('AA');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(45,12,'', _ZIP,       _S, 5, 0);
        Picture('99999');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(53, 9,'', _PHONE,     _S, 13, 0);
        Picture('(999)999-9999');
        Set_AutoHelp_To(@AutoHelp);

      SayGet(8,14,'', _TEXT_1, _S, 65, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(8,15,'', _TEXT_2, _S, 65, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(8,16,'', _TEXT_3, _S, 65, 0);
        Set_AutoHelp_To(@AutoHelp);

      SayGet(14,18,'', _SIGN,      _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14,19,'', _SIGN_ADR1, _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14,20,'', _SIGN_ADR2, _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(14,21,'', _SIGN_CITY, _S, 25, 0);
        Set_AutoHelp_To(@AutoHelp);
      SayGet(41,21,'', _SIGN_ST,   _S, 2, 0);
        Picture('AA');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(45,21,'', _SIGN_ZIP,  _S, 5, 0);
        Picture('99999');
        Set_AutoHelp_To(@AutoHelp);
      SayGet(53,18,'', _SIGN_PHN,  _S, 13, 0);
        Picture('(999)999-9999');
        Set_AutoHelp_To(@AutoHelp);

      IF EditMode OR AddMode THEN
        BEGIN
          ReadGets;  { edit the fields defined with SayGet() }
          IF EditResult <= 0 THEN
            BEGIN
              IF AddMode THEN
                BEGIN
                  Append;
                  AddMode := False;
                  WriteStatusLine;
                END
              ELSE Replace;
            END
        END
      ELSE ClearGets; { just display the fields }
    END;
    CountWords;
  ClearEOL(1,24);
END;       { DoGetsWith_HamGram }


PROCEDURE MakeFile(NewFile : String);
VAR
    DataBase  : DbfRecord;
    FieldList : FieldArray;
BEGIN
  WriteLn('Creating '+NewFile+'...');
  FillChar(FieldList,SizeOf(FieldList), 0);
  FieldList[1].Name := 'MSG_NBR';
  FieldList[1].Typ  := 'C';
  FieldList[1].Len  := 4;
  FieldList[2].Name := 'PRECEDENCE';
  FieldList[2].Typ  := 'C';
  FieldList[2].Len  := 1;
  FieldList[3].Name := 'HANDLING';
  FieldList[3].Typ  := 'C';
  FieldList[3].Len  := 1;
  FieldList[4].Name := 'HANDL_EXT';
  FieldList[4].Typ  := 'C';
  FieldList[4].Len  := 5;
  FieldList[5].Name := 'STATION';
  FieldList[5].Typ  := 'C';
  FieldList[5].Len  := 10;
  FieldList[6].Name := 'ORIGIN';
  FieldList[6].Typ  := 'C';
  FieldList[6].Len  := 15;
  FieldList[7].Name := 'FILE_TIME';
  FieldList[7].Typ  := 'C';
  FieldList[7].Len  := 4;
  FieldList[8].Name := 'FILE_MONTH';
  FieldList[8].Typ  := 'C';
  FieldList[8].Len  := 3;
  FieldList[9].Name := 'FILE_DAY';
  FieldList[9].Typ  := 'C';
  FieldList[9].Len  := 2;
  FieldList[10].Name := 'ADDRESSEE';
  FieldList[10].Typ  := 'C';
  FieldList[10].Len  := 25;
  FieldList[11].Name := 'ADDR1';
  FieldList[11].Typ  := 'C';
  FieldList[11].Len  := 25;
  FieldList[12].Name := 'ADDR2';
  FieldList[12].Typ  := 'C';
  FieldList[12].Len  := 25;
  FieldList[13].Name := 'CITY';
  FieldList[13].Typ  := 'C';
  FieldList[13].Len  := 25;
  FieldList[14].Name := 'STATE';
  FieldList[14].Typ  := 'C';
  FieldList[14].Len  := 2;
  FieldList[15].Name := 'ZIP';
  FieldList[15].Typ  := 'C';
  FieldList[15].Len  := 5;
  FieldList[16].Name := 'PHONE';
  FieldList[16].Typ  := 'C';
  FieldList[16].Len  := 13;
  FieldList[17].Name := 'TEXT_1';
  FieldList[17].Typ  := 'C';
  FieldList[17].Len  := 65;
  FieldList[18].Name := 'TEXT_2';
  FieldList[18].Typ  := 'C';
  FieldList[18].Len  := 65;
  FieldList[19].Name := 'TEXT_3';
  FieldList[19].Typ  := 'C';
  FieldList[19].Len  := 65;
  FieldList[20].Name := 'SIGN';
  FieldList[20].Typ  := 'C';
  FieldList[20].Len  := 25;
  FieldList[21].Name := 'SIGN_ADR1';
  FieldList[21].Typ  := 'C';
  FieldList[21].Len  := 25;
  FieldList[22].Name := 'SIGN_ADR2';
  FieldList[22].Typ  := 'C';
  FieldList[22].Len  := 25;
  FieldList[23].Name := 'SIGN_CITY';
  FieldList[23].Typ  := 'C';
  FieldList[23].Len  := 25;
  FieldList[24].Name := 'SIGN_ST';
  FieldList[24].Typ  := 'C';
  FieldList[24].Len  :=  2;
  FieldList[25].Name := 'SIGN_ZIP';
  FieldList[25].Typ  := 'C';
  FieldList[25].Len  :=  5;
  FieldList[26].Name := 'SIGN_PHN';
  FieldList[26].Typ  := 'C';
  FieldList[26].Len  := 13;
  CreateDBF(DataBase, NewFile, 26, @FieldList);
END;

PROCEDURE WriteHamGram;
var txt : text;
begin
  Assign(txt,'MSG'+TRIM(HamGram._MSG_NBR)+'.'+Extension);
  ReWrite(txt);
  with HamGram do
  begin
    write(txt,_MSG_NBR:4,
              _PRECEDENCE:2);
    if TRIM(_HANDL_EXT) <> '' then
      write(txt,' HX', _HANDLING:1);
    if TRIM(_HANDL_EXT) <> '' then
      write(txt,_HANDL_EXT:6);
    writeln(txt,_STATION:11,
                WordCount:4,
                _ORIGIN:16,
                _FILE_TIME:5,
                _FILE_MONTH:4,
                _FILE_DAY:3);
    writeln(txt);
    writeln(txt,_ADDRESSEE);
    if TRIM(_ADDR1) <> '' then
      writeln(txt,_ADDR1);
    if TRIM(_ADDR2) <> '' then
      writeln(txt,_ADDR2);
    if TRIM(_CITY) <> '' then
      write(txt,_CITY);
    if TRIM(_STATE) <> '' then
      write(txt,' ',_STATE);
    if TRIM(_ZIP) <> '' then
      write(txt,' ',_ZIP);
    writeln(txt);
    if TRIM(_PHONE) <> '' then
      writeln(txt,_PHONE);
    writeln(txt);
    if TRIM(_TEXT_1) <> '' then
      writeln(txt,_TEXT_1);
    if TRIM(_TEXT_2) <> '' then
      writeln(txt,_TEXT_2);
    if TRIM(_TEXT_3) <> '' then
      writeln(txt,_TEXT_3);
    writeln(txt);
    writeln(txt,_SIGN);
    if TRIM(_SIGN_ADR1) <> '' then
      writeln(txt,_SIGN_ADR1);
    if TRIM(_SIGN_ADR2) <> '' then
      writeln(txt,_SIGN_ADR2);
    if TRIM(_SIGN_CITY) <> '' then
      write(txt,_SIGN_CITY);
    if TRIM(_SIGN_ST) <> '' then
      write(txt,' ',_SIGN_ST);
    if TRIM(_SIGN_ZIP) <> '' then
      write(txt,' ',_SIGN_ZIP);
    writeln(txt);
    if TRIM(_SIGN_PHN) <> '' then
      writeln(txt,_SIGN_PHN);
    close(txt);
  end;
end;

PROCEDURE INITIALIZE;
BEGIN
  Set_Escape_On;   { affects SayGet commands }
  Set_Safety_Off;  { affects Pack command }
  Set_BrowseWindow_TO(15,5,75,19,2,'');
  SayGetColors;
  ClrScr;
  Select(0);       { choose first available work area }
  OurWorkArea := CurrentArea;
  IF NOT FileExists(dBaseFile)
     THEN MakeFile(dBaseFile);
  USE(dBaseFile, @HamGram, SizeOf(HamGram)); { open the file }
  IF RecCount = 0 THEN Append; { don't allow an empty database }
  EditMode := False;
  AddMode  := False;
  m_MSG_NBR := '';
END;  { Initialize }

BEGIN
  SaveEntryScreen;
  if ParamCount < 1
    then Extension := 'DBF'
    else if Length(ParamStr(1)) > 3
            then Extension := 'DBF'
            else Extension := Upper(ParamStr(1));
  dBaseFile := 'HAMGRAM.'+Extension;
  Initialize;
  Select(OurWorkArea);
  Set_FKey(F1,@EditHelp);
  ClrScr;
  Set_Cursor_Off;
  REPEAT
    DoGetsWith_HamGram;  { display (or edit) the current record }
    AT(3,23,'N)ext P)rev T)op B(O)t G)o S)rch E)dit A)dd D)el B)row Pa(C)k W)rite Q)uit');
    AT(34,24,'<F1> for HELP');
    REPEAT
      Choice := ReadKey;       { get user request }
      IF Choice = CHR(0) THEN  { user pressed a special key }
        BEGIN
          Choice := ReadKey;
          Case Choice Of
            'P' : Choice := 'N';  { map down-arrow to "Next"   }
            'H' : Choice := 'P';  { map up-arrow to "Previous" }
            ';' : Choice := 'H';  { map F1 to "Help" }
            ELSE Choice := ' ';   { ignore other special keys  }
          END;
        END;
      Choice := UpCase(Choice);
    UNTIL POS(Choice,'ABCDEGNOPQSTHW') > 0;
    EditMode := False;
    AddMode  := False;
    CASE Choice OF
      'N' : BEGIN
              Skip(1);
              IF dEOF THEN GoBottom;
            END;
      'P' : Skip(-1);
      'E' : EditMode := True;
      'A' : AddMode  := True;
      'H' : HelpScreen;
      'D' : { toggle the "Deleted" flag }
            IF HamGram.Deleted THEN RecallRec ELSE DeleteRec;
      'T' : GoTop;     { position database at first record }
      'O' : GoBottom;  { position database at last record }
      'B' : BEGIN
              Browse(
                'FIELDS [MSG_NBR "Nbr", ADDRESSEE "To", SIGN "From"] NOMODIFY');
              ClrScr;
            END;
      'S' : Search_MSG_NBR;
      'G' : BEGIN  { GO }
              MRecNO := 1;
              SayGet(1,25,' Enter record number: ',MRecNo,_LI,6,0);
              Range('1',SInteger(RecCount,0));
              Set_Repaint_Off;
              ReadGets;
              Set_Repaint_On;
              IF EditResult <= 0 THEN GO(MRecNo);
              AT(1,25,Space(78));
             END;
      'C' : BEGIN  { Pack }
              ClrScr;
              WriteLn('Removing deleted records...');
              Set_Talk_On;
              Pack;
              GoTop;
              ClrScr;
             END;
      'W' : WriteHamGram;
    END; { Case }
  UNTIL choice = 'Q';
  Set_Cursor_On;
  CloseDatabases;
  RestoreEntryScreen;
END.