Post Reply 
TEST DATE
01-11-2017, 07:32 PM
Post: #1
TEST DATE
HI,

I would like submit you this little code for testing validity of a any date even for négatives years. It run good BUT the last CASE is an issue (and I dont' see why).

May be hights programmers like Dieter and many others, but Dieter is also expert in calendars, can help me to understand ? And surely optimized my code.

Thanks.

Code:


EXPORT TSTDate(J,M,A)
BEGIN
LOCAL ND, TST, JULBISS:=0,GREGBISS:=0;
CASE
  IF J*M*A==0 THEN RETURN "Date ?"; END;
  IF J<1 OR J>31 OR FP(J)≠0 THEN RETURN "date JJ?";END;
  IF M<1 OR M>12 OR FP(M)≠0 THEN RETURN "Date MM?"; END;
  IF A<−4712 OR A>9999 OR FP(A) ≠ 0 OR A=0 THEN RETURN "Date AAAA?";END;
  IF M==04 OR M==06 OR M==09 OR M==11 AND J>30 THEN RETURN"Date JJ/MM?";END;

END;

TST:=A+M/100+J/10000;

IF (A==1582 AND (TST>1582.1004
AND TST<1582.1015)) THEN 
RETURN"GREG?";
END;

CASE
IF (A>1582) AND (NOT(A MOD 4) AND A MOD 100)
OR (NOT(A MOD 400)) THEN GREGBISS:=1 END;
IF (A<1582) AND irem(A,4)==0 THEN
JULBISS:=1;END;
END;

CASE
IF (M==2 AND JULBISS==1) OR (M==2 AND GREGBISS==1) AND J>29 THEN RETURN "Date>29/02?"; 
END;
IF (M==2 AND JULBISS==0) OR (M==2 AND GREGBISS==0) AND J>28 THEN RETURN "Date>28/02?";
END;

END;
END;

Gérard.
Find all posts by this user
Quote this message in a reply
01-11-2017, 07:50 PM
Post: #2
RE: TEST DATE
(01-11-2017 07:32 PM)ggauny@live.fr Wrote:  HI,

I would like submit you this little code for testing validity of a any date even for négatives years. It run good BUT the last CASE is an issue (and I dont' see why).

May be hights programmers like Dieter and many others, but Dieter is also expert in calendars, can help me to understand ? And surely optimized my code.

Thanks.

Code:


EXPORT TSTDate(J,M,A)
BEGIN
LOCAL ND, TST, JULBISS:=0,GREGBISS:=0;
CASE
  IF J*M*A==0 THEN RETURN "Date ?"; END;
  IF J<1 OR J>31 OR FP(J)≠0 THEN RETURN "date JJ?";END;
  IF M<1 OR M>12 OR FP(M)≠0 THEN RETURN "Date MM?"; END;
  IF A<−4712 OR A>9999 OR FP(A) ≠ 0 OR A=0 THEN RETURN "Date AAAA?";END;
  IF M==04 OR M==06 OR M==09 OR M==11 AND J>30 THEN RETURN"Date JJ/MM?";END;

END;

TST:=A+M/100+J/10000;

IF (A==1582 AND (TST>1582.1004
AND TST<1582.1015)) THEN 
RETURN"GREG?";
END;

CASE
IF (A>1582) AND (NOT(A MOD 4) AND A MOD 100)
OR (NOT(A MOD 400)) THEN GREGBISS:=1 END;
IF (A<1582) AND irem(A,4)==0 THEN
JULBISS:=1;END;
END;

CASE
IF (M==2 AND JULBISS==1) OR (M==2 AND GREGBISS==1) AND J>29 THEN RETURN "Date>29/02?"; 
END;
IF (M==2 AND JULBISS==0) OR (M==2 AND GREGBISS==0) AND J>28 THEN RETURN "Date>28/02?";
END;

END;
END;

Maybe you want:
Code:
IF (M==04 OR M==06 OR M==09 OR M==11) AND J>30 THEN RETURN"Date JJ/MM?";END;

unless the > 30 only applies to M==11

Tom L

Tom L
I'm pining for the Fjords
Find all posts by this user
Quote this message in a reply
01-13-2017, 08:42 AM
Post: #3
RE: TEST DATE
Hello,
After some modifications I have solved my code. Now it run well and verify all date good or not. I thing I was not mastering *CASE* instruction and *TEST* instructions. Only thing I see : when a date is wrong I obtain a Japanese message !

Code:


EXPORT TSTDate(J,M,A)
BEGIN
LOCAL ND, TST, BISS:=0;
CASE
  IF J*M*A==0 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");KILL;END;
  IF J<1 OR J>31 OR FP(J)≠0 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");KILL;END;
  IF M<1 OR M>12 OR FP(M)≠0 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");KILL;END;
  IF A<−4712 OR A>9999 OR FP(A) ≠ 0 OR A=0 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");KILL;END;
  IF M==04 OR M==06 OR M==09 OR M==11 AND J>30 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");KILL;END;
  //DEFAULT TST:=A+M/100+J/10000; 
END;

IF A==1582 THEN
TST:=A+M/100+J/10000 ELSE END;

IF (A==1582 AND (TST>1582.1004
AND TST<1582.1015)) 
THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");END;

IF A MOD 4==0 AND(A MOD 400==0
   OR A MOD 100≠0)
   THEN BISS:=1
END;

IF A MOD 4==0 AND A<1582 
   THEN BISS:=1 END; 

IF M==2 AND BISS==1 
  AND J>29 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");END;

IF M==2 AND BISS==0
   AND J>28 THEN MSGBOX("Date= "+J+"/"+M+"/"+A+"?");END;

MSGBOX("Date OK");
            
END;

Gérard.
Find all posts by this user
Quote this message in a reply
Post Reply 




User(s) browsing this thread: 1 Guest(s)