/*
**  $VER: Bis 4.014 (25 Jan 2000)  **
**            für FIASCO
**        © 1996/2000 Gerald Froehlich
**
**  PROGRAMNAME:
**      Bis
**
**  FUNCTION:
**      überprüft Datumsstring
**
**  $HISTORY:
**
**  25 Jan 2000 : 004.014 :  Überprüfung an Jahr 2000 angepaßt
**  08 Jan 1999 : 004.013 :  Fehlerhafte Eingabe besser abfangen
**  03 Dec 1998 : 004.012 :  Feld aktivieren
**  29 Nov 1998 : 004.011 :  unverändert
**  17 Nov 1998 : 003.716 :  Abfrage Datum größer als Termin?
**  14 Nov 1998 : 003.715 :  dummy neu
**  13 Nov 1998 : 003.714 :  Probe VERSION!! neues SetField
**  29 Sep 1998 : 003.713 :  Intervall-abfrage
**
**
**
**
**
**
**
**
**
**   28 Sep 1998 : 3.712:   initial release
*/
OPTIONS RESULTS
SIGNAL on error
SIGNAL ON break_c
SIGNAL ON break_d
SIGNAL ON break_e
SIGNAL ON break_f
SIGNAL ON failure
SIGNAL ON halt
SIGNAL ON ioerr
SIGNAL ON syntax

n = 0 /* nächstes Jahr - Flag */
F_neu = "6.282"

Sndpfad    = "HB:Senden/"     /* ÜW-Dateien-Pfad */
Ppfad  = "HB:Ablage/"     /* Pfad für Ablage */

IF GetClip("F_Version") ~< F_neu THEN DO

  IF ~abbrev(ADDRESS(), "FIASCO.") THEN DO
   /* Get list of all available ports */

    ports = show("Ports")

    /* Search for a port of Fiasco */

    do i = 1 to words(ports)

        portname = word(ports, i)

        if abbrev(portname, "FIASCO.") then
        do
            if datatype(substr(portname, 8), "Numeric") then
            do
                /* A port of Fiasco has been found.
                 * Now query Fiasco to return the port
                 * name of the active database.
                 */

                Address Value portname

                GetAttr Project Name Active ARexx

                /* This command may fail when
                 * no projects are active. This is
                 * for example the case, when all
                 * projects are hidden.
                 */

                if rc == 0 then
                do
                    Address Value Result
                end
                else
                do
                    RequestChoice '"No active project" "Cancel" Title "' || scriptname || '"'

                    call bail_out
                end

                break
            end
        END
    end
  END

  
   neu = 1
  fiasco_port = ADDRESS()
  Feld = "BLZ"
  Signal on Syntax
  SIGNAL on Halt
  SIGNAL on Break_C
  SIGNAL on Failure

  /* This script runs WHILE the user cannot DO anything
   * in Fiasco's GUI
   */

  LockGUI

  GetAttr Application SCREEN VAR screen

  setF = "ADDRESS" fiasco_port "SetField"

END
ELSE DO
     screen = GetClip('screenName')
     setF = "F_SetFieldCont"
     
END

IF (~show('l','rexxreqtools.library')) THEN
    CALL AddLib('rexxreqtools.library',0,-30,0)

IF (~show('l','rexxtricks.library')) THEN
    CALL AddLib('rexxtricks.library',0,-30,0)

Address FIASCO

F_GetFieldCont "Bis"
Termin = RESULT


F_GetFieldCont "Intervall"
Intervall = RESULT

F_GetFieldCont "Termin"
Term = RESULT

IF Intervall < 2 THEN
 IF Termin ~= "??.??.??"  THEN DO
 text =  'Was soll eine Angabe der Dauer bei' || '0A'x || 'einer Termin- oder Sofort-Überweisung?'
 ab = rtezrequest(text,"_Tschuldigung", "Termin",'rt_pubscrname='screen)


 INTERPRET setF Bis "??.??.??"
 Feld = "Bis"
 CALL bail_out

END

IF Index(Left(Termin,5),"?") ~= 0 THEN DO
 text =  'Nanu was soll dieser fehlerhafte Termin?'
 ab = rtezrequest(text,"_Tschuldigung", "Termin",'rt_pubscrname='screen)
 INTERPRET setF "Bis" "??.??.??"
 Feld = "Bis"
 CALL bail_out
END

IF GetClip("F_Version") < F_neu THEN DO
  IF Termin ~= "??.??." THEN DO
    IF SubStr(Termin,2,1) = "." THEN Termin = '0' || Termin
    IF SubStr(Termin,5,1) = "." THEN Termin = Left(Termin,3) || '0' || SubStr(Termin,4)
/* geändert im Jahr 2000 */
    IF Length(Termin) < 10 THEN Termin = Insert('20',Termin,6)
    IF Length(Termin) = 8 THEN Termin = Termin || Left(Date('o'),2)
  END
END
ELSE DO

/* hier prüfen */

IF Length(Termin) = 8 & Termin ~= "??.??.?? " THEN DO
  IF Right(Termin,2) = "??" THEN
    Termin = Left(Termin,Length(Termin)-2) || Left(Date('o'),2)
/* geändert im Jahr 2000 */
  Termin = Insert('20',Termin,6)
  END

END


/* ist nächstes Jahr gemeint? */

IF SubStr(Termin,4,2) <= 3 THEN do
 IF Date('D') > 275 THEN DO

    IF Right(Termin,4) = Right(Date(),4) THEN
    Termin = Left(Termin,6) || Right(Termin,4) + 1
    a = SetClip("Virgin","0")

    INTERPRET setF Bis Termin


 END
END

/* ist Bis auch nicht kleiner als Termin? */


a = Right(termin,4)||SubStr(Termin,4,2)||Left(Termin,2)

x = Right(term,4)||SubStr(Term,4,2)||Left(Term,2)

IF x > a THEN  DO

 x= rtezrequest('Die Angabe "Dauer" darf nicht kleiner als' '0a'x,
   ||'das Datum des Termins sein!',
  ,'Sorry','Termin','rt_pubscrname='screen)
 INTERPRET setF 'Bis' "??.??."
 Feld = "Bis"
 CALL bail_out
END

INTERPRET setF Bis Termin

bail_out:

IF neu ~= 1 THEN EXIT

Address Value fiasco_port

UnlockGUI
ResetStatus
ActivateField Feld
exit



/*###################################
*** Debugging-Fehlerroutinen *******
###################################*/
syntax:
text =  'Syntax-Fehler' rc 'in Zeile' sigl '0A'x ErrorText(rc),
    '0A'x || SourceLine(sigl)
   CALL rtezrequest(text,"Alles klar!", "Fehlermeldung Termin",'rt_pubscrname='screen)
  if show("Ports", fiasco_port) then
  DO
    Address Value fiasco_port

    RequestChoice '"Error ' || rc || ' in line ' || sigl || ':*n' || errortext(rc) || '" "Cancel" Title"' || scriptname || '"'
  END
  ELSE
  DO
    say "Error" rc "in line" sigl ":" errortext(rc)
    say "Enter to continue"
    pull dummy
  END

  CALL bail_out

failure:
ioerr:
ERROR:
text =  'Fehler' rc 'in Zeile' sigl '0A'x ErrorText(rc),
    '0A'x || SourceLine(sigl)
   CALL rtezrequest(text,"Alles klar!", "Fehlermeldung Termin",'rt_pubscrname='screen)
  EXIT 10
halT:
break_c:
break_d:
break_e:
break_f:
text =  'User-Abbruch durch Halt!' || '0A'x || 'Wirklich abbrechen ?'
 ab = rtezrequest(text,"_Mach Schluss|_Neeiiin", "Termin",'rt_pubscrname='screen)
 IF ab = 1 THEN DO
   if show("Ports", fiasco_port) then
    DO
     ADDRESS VALUE fiasco_port

     RequestChoice '"Script Abort Requested" "Abort Script" Title "' || scriptname || '"'
    END
    ELSE
    DO
      SAY "*** BREAK"
      SAY "Enter TO continue"
      PULL dummy
    END

  CALL bail_out
 END
 ELSE RETURN