IMPLEMENTATION MODULE DBFields;

(*
 *  ModBase
 *  Release 3.0
 *  (c) Copyright 1986 - 1991 John McMonagle & Donald G. Fletcher
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *
 *)
IMPORT ModBase3;
FROM ModBase3 IMPORT DBFile, GetField,FieldList,DBFieldPtr;
FROM DateFunctions IMPORT Date;
FROM StrConv  IMPORT RealToStr, StrToReal;
FROM NumTypes IMPORT Real8;

CONST MaxDigits = 18;

PROCEDURE DataFormatToDate(dbstring: ARRAY OF CHAR; VAR d: Date);
(* Converts a string from dbase data format (yyyymmdd) to Date *)
VAR i: CARDINAL;
BEGIN
  IF dbstring[0] = ' ' THEN
    d.yr := 0; d.mo := 0; d.day := 0
  ELSE
    d.yr := 0;
    FOR i := 0 TO 3 DO
      d.yr := (d.yr * 10) + (ORD(dbstring[i])-60B)
    END;
    d.mo  :=  (ORD(dbstring[4])-60B) * 10 + (ORD(dbstring[5])-60B);
    d.day :=  (ORD(dbstring[6])-60B) * 10 + (ORD(dbstring[7])-60B);
  END;
END DataFormatToDate;

PROCEDURE DateToDataFormat(d: Date; VAR datestring: ARRAY OF CHAR);
BEGIN
  datestring[0] := CHR(d.yr DIV 1000 + 60B);
  d.yr := d.yr MOD 1000;
  datestring[1] := CHR(d.yr DIV 100 + 60B);
  d.yr := d.yr MOD 100;
  datestring[2] := CHR(d.yr DIV 10 + 60B);
  datestring[3] := CHR(d.yr MOD 10 + 60B);
  datestring[4] := CHR(d.mo DIV 10 + 60B);
  datestring[5] := CHR(d.mo MOD 10 + 60B);
  datestring[6] := CHR(d.day DIV 10 + 60B);
  datestring[7] := CHR(d.day MOD 10 + 60B);
  IF HIGH(datestring) > 7 THEN
     datestring[8] := 0C;
  END;
END DateToDataFormat;

PROCEDURE GetDateField(VAR alias: DBFile; fieldnum: CARDINAL;
    VAR d: Date);
VAR datestr: ARRAY [0..7] OF CHAR;
BEGIN
  GetField(alias, fieldnum, datestr);
  DataFormatToDate(datestr, d);
END GetDateField;

PROCEDURE GetLogicalField(VAR alias: DBFile; fieldnum: CARDINAL;
    VAR l: BOOLEAN);
VAR lstring: ARRAY [0..1] OF CHAR;
BEGIN
  GetField(alias, fieldnum, lstring);
  IF (CAP(lstring[0]) = 'Y') OR (CAP(lstring[0]) = 'T') THEN
    l := TRUE
  ELSE
    l := FALSE
  END;
END GetLogicalField;

PROCEDURE GetNumField(VAR alias: DBFile; fieldnum: CARDINAL;  VAR
    n: Real8);
VAR nstring: ARRAY [1..MaxDigits] OF CHAR;
    ok: BOOLEAN;
BEGIN
  GetField(alias, fieldnum, nstring);
  ok:=StrToReal(nstring,0, n)
END GetNumField;

PROCEDURE Replace(VAR alias: DBFile; fieldnum: CARDINAL; s: ARRAY
    OF CHAR);
BEGIN
  ModBase3.Replace(alias,fieldnum,s);
END Replace;

PROCEDURE ReplaceD(VAR alias: DBFile; fieldnum: CARDINAL; d:
    Date);
VAR dstring: ARRAY [0..9] OF CHAR;
BEGIN
  DateToDataFormat(d, dstring);
  Replace(alias, fieldnum, dstring);
END ReplaceD;

PROCEDURE ReplaceL(VAR alias: DBFile; fieldnum: CARDINAL; l:
    BOOLEAN);
VAR lchar: ARRAY [0..0] OF CHAR;
BEGIN
  IF l THEN
    lchar[0] := 'T'
  ELSE
    lchar[0] := 'F'
  END;
  Replace( alias, fieldnum, lchar );
END ReplaceL;

PROCEDURE ReplaceN(VAR alias: DBFile; fieldnum: CARDINAL; n:
    Real8);
VAR nstring: ARRAY [0..MaxDigits] OF CHAR;
   fldptr:DBFieldPtr;
BEGIN
  fldptr:=FieldList(alias);
  WITH fldptr^[fieldnum] DO
    IF decplaces=0 THEN
      RealToStr(n, decplaces,
        size+1, nstring);(* assumes that Real to str will insert '.' *)
      nstring[size]:=0C;
    ELSE
      RealToStr(n, decplaces,
        size, nstring);
    END (* IF decplaces=0 *);
    Replace(alias, fieldnum, nstring);
  END (* With *);
END ReplaceN;

END DBFields.