* EXDATES.PRG 10/1/2000
PARAMETER String
Datestr = ""
Datesfound = .F.
origstr = ""
bcsign = " "
date1 = ""
date2 = ""
origstr = string
segment = ""
segment1 = ""
segment2 = ""
DO CASE
CASE AT("B.C.",string) > 0
signloc = AT("B.C.",string)
bcsign= "-"
CASE AT("A.D.",string) > 0
signloc = AT("A.D.",string)
bcsign= ""
OTHERWISE
? "APISID = " + str(a->apisid,4,0)
? "No CE/BCE sign; cannot process date (exdates.prg)"
?
WAIT
CLEAR
Return
ENDCASE
DO Textdates WITH string
IF Datesfound =.F.
DO CASE
CASE AT("BETWEEN",UPPER(string)) > 0 .and. AT(" AND ",UPPER(string)) > 0
andloc = AT("AND",UPPER(string))
segment1 = substr(string,1,andloc-1)
DO Finddate with segment1
date1 = datestr
segment2 = substr(string,andloc+1)
DO Finddate with segment2
date2 = datestr
Datesfound = .T.
CASE AT(" OR ",UPPER(string)) > 0 .and. AT(" LATER ",UPPER(string)) = 0
orloc = AT("OR",UPPER(string))
segment1 = substr(string,1,orloc-1)
DO Finddate with segment1
date1 = datestr
segment2 = substr(string,orloc+1)
DO Finddate with segment2
date2 = datestr
CASE AT("/",string) > 0 .and. AT("./",string) = 0 .and. AT(" /",string) = 0
slashloc = AT("/",string)
segment1 = substr(string,1,slashloc-1)
DO Finddate with segment1
date1 = datestr
segment2 = substr(string,slashloc+1)
DO Finddate with segment2
date2 = datestr
CASE AT("-",string) > 0
hyphloc = AT("-",string)
segment1 = substr(string,1,hyphloc-1)
DO Finddate with segment1
date1 = datestr
segment2 = substr(string,hyphloc+1)
DO Finddate with segment2
date2 = datestr
Datesfound = .T.
OTHERWISE
segment = substr(string,signloc-4,5)
DO Finddate with segment
IF Datesfound = .T.
date1 = datestr
ENDIF
ENDCASE
ENDIF
IF Datesfound = .T.
IF bcsign = "-"
string = IIF(LEN(TRIM(Date1)) > 0, "046 |b" + TRIM(Date1),"") + ;
IIF(LEN(TRIM(Date2)) > 0, "|d" + TRIM(Date2),"")
ELSE
string = IIF(LEN(TRIM(Date1)) > 0,"046 |c" + TRIM(Date1),"") + ;
IIF(LEN(TRIM(Date2)) > 0,"|e" + TRIM(Date2),"")
ENDIF
Do writeout WITH m->string
ELSE
@row()+2,5 say "NO DATE EXTRACTED FROM STRING: "
ENDIF
RETURN
***************************************************************
PROCEDURE Textdates
PARAMETER string
DO CASE
CASE AT("LATE 2ND OR EARLY 3RD CENTURY A.D.",UPPER(string)) > 0
Date1 = "175"
Date2 = "225"
Datesfound = .T.
CASE AT("1ST CENTURY A.D.",UPPER(string)) > 0
Date1 = "1"
Date2 = "99"
Datesfound = .T.
CASE AT("2ND CENTURY A.D.",UPPER(string)) > 0
Date1 = "100"
Date2 = "199"
Datesfound = .T.
CASE AT("3RD CENTURY A.D.",UPPER(string)) > 0
Date1 = "200"
Date2 = "299"
Datesfound = .T.
CASE AT("4TH CENTURY A.D.",UPPER(string)) > 0
Date1 = "300"
Date2 = "399"
Datesfound = .T.
CASE AT("1ST CENTURY B.C.",UPPER(string)) > 0
Date1 = "-99"
Date2 = "1"
Datesfound = .T.
CASE AT("2ND CENTURY B.C.",UPPER(string)) > 0
Date1 = "199"
Date2 = "100"
Datesfound = .T.
CASE AT("3RD CENTURY B.C.",UPPER(string)) > 0
Date1 = "299"
Date2 = "200"
Datesfound = .T.
ENDCASE
IF bcsign= "-"
DO Bcmod
ELSE
DO Admod
ENDIF
*********************************************
PROCEDURE ADMOD
DO CASE
CASE "EARLY"$UPPER(string)
Date1 = Date1
Date2 = STUFF(Date2, LEN(TRIM(Date2))-1,2,"25")
CASE "MID"$UPPER(string)
Date1 = STUFF(Date1, LEN(TRIM(Date1))-1,2,"50")
Date2 = ""
CASE "LATE"$UPPER(string)
Date1 = STUFF(Date1, LEN(TRIM(Date1))-1,2,"75")
Date2 = Date2
CASE "FIRST HALF"$UPPER(string)
Date1 = Date1
Date2 = STUFF(Date2, LEN(TRIM(Date2))-1,2,"50")
CASE "SECOND HALF"$UPPER(string)
Date1 = STUFF(Date1, LEN(TRIM(Date1))-1,2,"50")
Date2 = Date2
ENDCASE
*********************************************
*********************************************
PROCEDURE BCMOD
DO CASE
CASE "EARLY"$UPPER(string)
Date1 = STUFF(Date1, LEN(TRIM(Date1))-1,2,"25")
Date2 = Date2
CASE "MID"$UPPER(string)
Date1 = STUFF(Date1, LEN(TRIM(Date1))-1,2,"50")
Date2 = ""
CASE "LATE"$UPPER(string)
Date1 = STUFF(Date2, LEN(TRIM(Date2))-1,2,"25")
Date2 = Date2
CASE "FIRST HALF"$UPPER(string)
Date1 = STUFF(Date1, LEN(TRIM(Date1))-1,2,"50")
Date2 = Date2
CASE "SECOND HALF"$UPPER(string)
Date1 = Date1
Date2 = STUFF(Date2, LEN(TRIM(Date2))-1,2,"50")
ENDCASE
******************************************************************************
PROCEDURE Finddate
PARAMETERS string
numlist = "1234567890"
TestingFD = .F.
current = ""
tempstr = ""
datestr = ""
endstr = LEN(TRIM(string))
Flagstrt = .F.
Flagend = .F.
Datefound = .F.
position = 1
DO WHILE position <= endstr .and. .not. Flagend
current = substr(string,position,1)
IF current$numlist && If an integer
IF Flagstrt = .F. && If flag not on, must be first integer
Flagstrt = .T. && Turn on flag
ENDIF
tempstr = tempstr + LTRIM(TRIM(current)) && Cumulate date in tempstr
ELSE
IF Flagstrt = .T. && If number has been identified previously
Flagend = .T. && but now no more integers
Flagstrt = .F. && reset Flagsrt
ENDIF
ENDIF
position = position + 1 && Increment position
ENDDO
datestr = tempstr && transfer number variable to datestr
If len(trim(datestr)) > 0
Datesfound = .T. && Set found flag to True
ELSE
Datesfound = .F.
Flagend = .T.
? "No date found in segment"
? "APISID = " + str(a->apisid,4,0)
? "SEGMENT = " + segment + segment1 + segment2
? "TEMPSTR = " + tempstr
WAIT
ENDIF
RETURN
Digital
Program