Program GMOD;
{=============================================================================}
{  Version 2.0     1991-02-27 RD                                              }
{   - Looks through all occurrences of a field                                }
{   - If old string is [empty] creates field and fills it with new string     }
{   - If the result field after replacement is [empty] deletes field          }
{   - Scans whole field and replaces multiple occurences of oldstring by new  }
{   - Operates on MFN range or records found in last search                   }
{   - Scans for exact old string or matches regardless of old string case     }
{=============================================================================}
var dbname,stag,olds,news  :  string;
    upoldfld     : string;    { oldfld upshifted }
    oldfld,newfld:string;
    l,k,d,m:real;
    fmfn,lmfn,mfn,tag,nc,tags,curmfn  :  real;
    occread,occupd : real;  { occurrences read and updated }
    recread,recupd : real;  { records read and updated     }
    updflag : real;
    searchstr : string;
    setno, rc : real;
    garb : string;       { garbage }
    caseresp : string;   { response re case sensitivity }

procedure updrec(recmfn:real);
{-------------------------------------------------------------------}
{  Updates a specific record whose MFN is passed as a parameter.    }
{-------------------------------------------------------------------}
begin
    if record(recmfn) = 0
    then begin
       updflag := 0;
       recread := recread + 1;
       tags := nocc (tag);
       if olds = ''
          then tags := 1;
       m := 1;
       repeat { All occurences of tag (tag)}
          l := record (recmfn);
          oldfld := field(fieldn(tag,m));
          upoldfld := oldfld;
          if caseresp = 'N' then
             uc(upoldfld);
          l := size (oldfld);
          newfld := '';
          d := 1;
          repeat { All occurences in field (tag,tags) }
            k := position (upoldfld,olds,d);
            if (k <> 0)
            or (olds = '')
            then begin
                updflag := 1;
                occupd := occupd + 1;
                newfld := newfld | substr (oldfld,d,k-d) | news;
                d := k + size(olds);
            end else
                newfld := newfld | substr (oldfld,d,l-d+1);
          until (k = 0);
          if (olds = '') and (newfld <> '') then
             begin
               nc := fldadd (tag,nfields+1,newfld);
               updflag := 1;
             end
          else begin
             if newfld <> '' then
               begin
                 nc:= fldrep(fieldn(tag,m),newfld);
               end;
             if (newfld = '') and (tags <> 0) then
               begin
                 nc := flddel (fieldn(tag,m));
                 m := m - 1;
                 tags := tags - 1;
                 updflag := 1;
               end;
          end;
          if nc=0
          then begin
              update;
          end;
          occread:=occread+1;
          m := m + 1;
       until m > tags;
       if updflag = 1 then
         begin
           recupd := recupd + 1;
         end;
     end; { return code record = 0 }
     cursor(19,8);
     write(recread:6,'          ',recupd:6,'            ',occread:5,
'             ',occupd:5,'   ');
end; {procedure updrec}

{-------------------------------------------------------------------}
{  Main Body                                                        }
{-------------------------------------------------------------------}
begin
  recread := 0;
  recupd := 0;
  occread := 0;
  occupd := 0;

  clear;
  write('GLOBAL CHANGE Version 2.0':69);
  clearbox(2,2,3,20,0);
  box(2,2,3,20,1);  cursor(3,4);
  write('Database: '); readln(dbname);
  open(dbname);
  clear;          { repeat to wipe out poss ISIS messages }
  write('GLOBAL CHANGE Version 2.0':69);
  clearbox (2,2,3,20,0);
  box(2,2,3,20,1);  cursor(3,4);
  write('Database: ',dbname);

  repeat begin
    clearbox(2,30,3,13,0);
    box(2,30,3,13,1); cursor(3,32);
    write('Tag : '); readln(stag);
    tag:=val(stag);
  end until tag>0;

  repeat
    clearbox(5,2,3,35,0);
    box(5,2,3,35,1); cursor(6,4);
    write('Case sensitive search (Y/N?): '); readln(caseresp); uc(caseresp);
  until (caseresp = 'Y') or (caseresp = 'N');

  clearbox (8,2,3,78,0);
  box(8,2,3,78,1); cursor(9,4);
  write('Old string: '); readln(olds);
  if caseresp = 'N' then uc(olds);

  clearbox (11,2,3,78,0);
  box(11,2,3,78,1); cursor(12,4);
  write('New string: '); readln(news);

  repeat
    clearbox(14,2,3,80,0);
    box(14,2,3,25,1);
    cursor(15,4);
    write('Last query (y/n)?: ');
    readln(searchstr);
    uc(searchstr);
  until (searchstr = 'Y') or (searchstr = 'N');

  if (searchstr = 'Y') then
    begin
      curmfn := setpos (0,1);
      if curmfn > 0
        then begin
           clearbox(17,2,4,76,0);
           box(17,2,4,76,2);
           cursor (18,6);
           write('Recs Read    |  Recs Updated    | Flds Processed  |   Changes
   Made   ');
           repeat
             updrec(curmfn);
             curmfn := nxtpos(1);
           until curmfn = 0;
        end
      else
        begin
          clearmsg;
          cursor (22,20);
          writeln ('No search has been performed. Press any key to continue.');
          garb := inkey;
        end;
    end
   else  {don't use last query }
     begin
       repeat begin
         clearbox(14,2,3,80,0);
         box(14,2,3,20,1); cursor(15,4);
         write('First mfn: '); readln(stag);
         fmfn:=val(stag);
       end until fmfn>0;
       repeat begin
         clearbox(14,30,3,20,0);
         box(14,30,3,20,1); cursor(15,32);
         write('Last mfn: '); readln(stag);
         lmfn:=val(stag);
       end until lmfn>0;

       clearbox(17,2,4,76,0);
       box(17,2,4,76,2);
       cursor (18,6);
       write('Recs Read    |  Recs Updated    | Flds Processed  |   Changes Made
      ');

       if lmfn > maxmfn-1 then lmfn := maxmfn-1;
       curmfn := 0;
       for curmfn:=fmfn to lmfn
         do begin
           updrec(curmfn);
         end; { for }
    end; {if query }
end.