/*
**  $VER: Versand 4.013 (17 Jan 1999)
**              für FIASCO
**        © 1996/98 Gerald Froehlich
**
**  PROGRAMNAME:
**      Versand
**
**  FUNCTION:
**      Schreibt Record in eine Datei für HB
**
**  $HISTORY:
**
**  17 Jan 1999 : 004.013 :  Überpr. ob Beträge richtig
**  02 Dec 1998 : 004.012 :  Flag-Feld dazu
**  29 Nov 1998 : 004.011 :  unverändert
**  23 Nov 1998 : 003.722 :  für mein Cron-Prog!
**  20 Nov 1998 : 003.721 :  bei leerem Bis -> 31.12.2099 auch eintragen
**  19 Nov 1998 : 003.720 :  bei leerer Dauer -> 31.12.2099
**  16 Nov 1998 : 003.719 :  Abfrage 0-Überweisung
**  14 Nov 1998 : 003.718 :  dummy neu
**  14 Nov 1998 : 003.717 :  neues Setfield
**  02 Nov 1998 : 003.716 :  message durch Clip ersetzt
**  06 Oct 1998 : 003.715 :   100 statt 010
**  04 Oct 1998 : 003.714 :  Daten ohne Nullen
**  02 Oct 1998 : 003.713 :  - no comment -
**  30 Sep 1998 : 003.712 :  Kontonr. -> KontoNr
**  24 Sep 1998 : 003.711 :  für LÜws und DAs
**  29 Jun 1998 : 003.710 :  unverändert
**  16 Dec 1997 : 003.505 :  neue Eröffnung
**  26 Nov 1997 : 003.504 :  Strukturänderung I
**  23 Nov 1997 : 003.503 :  screen
**  21 Nov 1997 : 003.502 :  Dateinamen verändert
**  20 Nov 1997 : 003.501 :  Datums-Versand an V2.1 angepasst
**  16 Apr 1997 : 003.500 :  Clip Virgin
**  14 Apr 1997 : 003.103 :  close und Writeln mit a = versetzt
**  14 Apr 1997 : 003.102 :  D-Flag löschen
**  14 Jan 1997 : 003.101 :  identisch
**   20 Mar 1996 : 0.01 : initial release
*/


OPTIONS RESULTS
F_neu = "6.282"

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

  fiasco_port = ADDRESS()
  neu = 1
  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','rexxtricks.library')) then
    call addlib('rexxtricks.library',0,-30,0)
if (~show('l','rexxreqtools.library')) then
    call addlib('rexxreqtools.library',0,-30,0)


Options Results
Address FIASCO

/* ------ */

F_GetFieldCont "Status"
Stat = Result
if Stat = 1 then do
  x= rtezrequest('Diese Überweisung wurde bereits gespeichert!','_Entschuldigung|als _Kopie speichern',
  ,,'rt_pubscrname='screen)
  IF x = 1 THEN CALL bail_out
  if x = 0 then F_DupRec
end

F_GetFieldCont "BLZ"
BLZ = Result
BLZ = Overlay(BLZ,BLZ,1,8,' ')


F_GetFieldCont "KontoNr"
KontoNr = Result
KontoNr = Overlay(KontoNr,KontoNr,1,10,' ')

F_GetFieldCont "Name"
Name = Result
Name = Overlay(Name,Name,1,27,' ')

F_GetFieldCont "Mark"
Mark = RESULT

F_GetFieldCont "Pfennige"
Pfennige = Result

/* Null-Üw ? */

IF Mark = 0 & Pfennige = 0 THEN DO
    CALL rtezrequest('Überweisungen über 0,00 ' '0a'x,
    ||'sind nicht möglich!',,,'rt_pubscrname='screen)
    CALL bail_out
END

IF Mark = "" | Pfennige = "" THEN DO
    CALL rtezrequest('Leere Felder bei Angabe des Betrages' '0a'x,
    ||'sind nicht möglich!',,,'rt_pubscrname='screen)
    CALL bail_out
END

IF Verify(Mark,xrange('0','9')) ~= 0 | Verify(Pfennige,xrange('0','9')) ~= 0   THEN DO
         CALL rtezrequest('Falsche Werte bei den Beträgen!',,,'rt_pubscrname='screen)
          Feld = "Mark"
          CALL bail_out
END


Mark = Overlay(Mark,Mark,1,7,' ')
Pfennige = Overlay(Pfennige,Pfennige,1,2,' ')



F_GetFieldCont "Zweck1"
Zweck1 = Result
Zweck1 = Overlay(Zweck1,Zweck1,1,27,' ')

F_GetFieldCont "Zweck2"
Zweck2 = Result
Zweck2 = Overlay(Zweck2,Zweck2,1,27,' ')


F_GetFieldCont "Art"
Art = Result

F_GetFieldCont "Termin"
Termin = Result

F_GetFieldCont "Intervall"
Intervall = RESULT

F_GetFieldCont "Flag"
Flag = RESULT

/* sind auch alle Daten vorhanden? */

IF Intervall > 0 & Termin = "??.??.??" THEN DO
   CALL rtezrequest('Sie brauchen eine Terminangabe!',
    ,,,'rt_pubscrname='screen)
    CALL bail_out
END


F_GetFieldCont "Bis"
Bisi = RESULT

IF Bisi = "" | Bisi = ??.??.?? THEN DO     /* Dauer setzen */
  IF Intervall > 1 THEN DO
    Bisi = "31.12.2099"
    INTERPRET setF 'Bis' Bisi
  END
END

Bis = Bisi      /* wegen Angabe von Feldnamen ging bis jetzt bis nicht! */

IF Left(Termin,5) ~= "??.??" THEN DO        /* alle außer sofort */

  IF SubStr(Termin,2,1) = "." THEN Termin = '0' || Termin
  if substr(Termin,5,1) = "." then Termin = left(Termin,3) || '0' || substr(Termin,4)


   IF SubStr(Bis,2,1) = "." THEN Bis = '0' || Bis
   IF SubStr(Bis,5,1) = "." THEN Bis = Left(Bis,3) || '0' || SubStr(Bis,4)

   i = 2     /* ist 1.Zeile Termin? */

    SELECT
        WHEN Intervall = 1 THEN DO  /* Termin-Üw */

/* nur 90 Tage ? */

       y = Date("S",Date('I')+90)
       Termin1 = Right(Termin,4) || SubStr(Termin,4,2) || Left(Termin,2)
          IF Termin1 ~> y THEN DO    /* normale Termin-ÜW */
            Intervall=0
            zeile.0 = 8
            zeile.1 = Termin
            i = 2
          END
          ELSE DO             /* Lang-Termin -> Reminder-Ablage */

            cron.0 = 1
            text =  Left(Termin,2)"/"SubStr(Termin,4,2)"/"||Right(Termin,4)
            cron.1 = text||"®"||text||"®"text
          END
      END
        WHEN Intervall = 2 THEN DO  /* monatl. */
            cron.0 = 1
            cron.1 = Left(Termin,2)"/"SubStr(Termin,4,2)"/"||,
            Right(Termin,4)||"®"||,
            Left(Bis,2)"/"SubStr(Bis,4,2)"/"||,
            Right(Bis,4)||"®"|| Left(Termin,2)"/??/????"

        END
        WHEN Intervall = 3 THEN DO  /* 2monatl.  Zeichen = Z1 oder Z2 */

            Mon = SubStr(Termin,4,2)
        
            IF Mon/2 = Trunc(Mon/2) THEN Zeichen = "Z2"
            ELSE Zeichen = "Z1"

            cron.0 = 1

            cron.1 = Left(Termin,2)"/"SubStr(Termin,4,2)"/"||,
              Right(Termin,4)"®"||,
              Left(Bis,2)"/"SubStr(Bis,4,2)"/"||,
              Right(Bis,4)||"®"||Left(Termin,2)"/"Zeichen"/????"
        END

        WHEN Intervall = 4 THEN DO  /* 3monatl.  Zeichen D1-D3*/
         Mon = SubStr(Termin,4,2)

       
            IF Mon > 3 THEN Mon = Trunc(Mon/3)
            ELSE Mon = Mon-0
            Zeichen = "D"Mon

            cron.0 = 1
            cron.1 = Left(Termin,2)"/"SubStr(Termin,4,2)"/"||,
              Right(Termin,4)"®"||,
              Left(Bis,2)"/"SubStr(Bis,4,2)"/"||,
              Right(Bis,4)||"®"||Left(Termin,2)"/"Zeichen"/????"

        END

        WHEN Intervall = 5 THEN DO  /* 6monatl.  Zeichen S1-6*/
           Mon = SubStr(Termin,4,2)

          IF Mon > 6 THEN Mon = Trunc(Mon-6)
            ELSE Mon = Mon-0
            Zeichen = "S"Mon

            cron.0 = 1
            cron.1 = Left(Termin,2)"/"SubStr(Termin,4,2)"/"||,
              Right(Termin,4)"®"||,
              Left(Bis,2)"/"SubStr(Bis,4,2)"/"||,
              Right(Bis,4)||"®"||Left(Termin,2)"/"Zeichen"/????"
        END

        WHEN Intervall = 6 THEN DO  /* jährl.    */

            Mon = SubStr(Termin,4,2)
            cron.0 = 1
         
              cron.1 = Left(Termin,2)"/"SubStr(Termin,4,2)"/"||,
              Right(Termin,4)"®"||,
              Left(Bis,2)"/"SubStr(Bis,4,2)"/"||,
              Right(Bis,4)||"®"||Left(Termin,2)"/"Mon"/????"

        END

    END
END
ELSE DO                 /* für normale ÜWs */
  zeile.0 = 7
  i = 1
END





/*  Aufruf normsave: und DAsave: */
IF Intervall = 0 THEN CALL normsave
ELSE CALL DAsave


/* -SCHLUSS----------*/

INTERPRET setF 'Status' 1
    a = SetClip("Virgin","1")

    /*
    ADDRESS "HB"
    'OK'
    */
    a = SetClip("F_change","1")


CALL bail_out

/* --ENDE----------*/

normsave:

x = 0                   /* gilt für norm.T-ÜW und normal. ÜWs */
do i = i to zeile.0
    x = x+1
    select
     when x = 1 then zeile.i = BLZ
     when x = 2 then zeile.i = KontoNr
     when x = 3 then zeile.i = Name
     when x = 4 then zeile.i = Mark
     when x = 5 then zeile.i = Pfennige
     when x = 6 then zeile.i = Zweck1
     when x = 7 then zeile.i = Zweck2
    end
end i

IF Art = 0 THEN DO
  filename = "HB:senden/Ueberweisung"
  if Open(FP,"HB:Parameter/priv.Uew","R") then do
    x = Value(readln(FP))+1
    a = Close(FP)
    filename = filename || x || ".hb"
  end
  else do
    CALL rtezrequest('Fehler beim Öffnen von priv.Uew',,,'rt_pubscrname='screen)
  end

  if Open(FP,"HB:Parameter/priv.Uew","W") then do
    if x < 10 then x = "0" || x
    a = WriteLn(FP,x)
    a = Close(FP)
  end
  else do
    CALL rtezrequest('Fehler beim Schreiben von priv.Uew',,,'rt_pubscrname='screen)
  end
end

if Art = 1 then do
  filename = "HB:senden/GKtoUeberwsg"
  if Open(FP,"HB:Parameter/gesch.Uew","R") then do
    x = Value(readln(FP))+1
    a = Close(FP)
    filename = filename || x || ".hb"
  end
  ELSE CALL rtezrequest('Fehler beim Öffnen von gesch.Uew',,,'rt_pubscrname='screen)

  if Open(FP,"HB:Parameter/gesch.Uew","W") then do
    if x < 10 then x = "0" || x
    a = WriteLn(FP,x)
    a = Close(FP)
  end
  ELSE CALL rtezrequest('Fehler beim Schreiben von gesch.Uew',,,'rt_pubscrname='screen)
end

IF ~WRITEFILE(filename,'Zeile') THEN do
     dummy= BEEP()
     CALL rtezrequest('da war irgendwas beim Abspeichern....',,,'rt_pubscrname='screen)
 END
    /* Löschschutz ein */
 IF ~SETPROTECTION(filename,'----RWE-') THEN
       CALL rtezrequest('Fehler beim Löschen des D-Flags',,,'rt_pubscrname='screen)

    
RETURN

DAsave:

x = rtezrequest('Diese Überweisung oder der Dauerauftrag',
'0a'x'wird für HB-Cron gespeichert.','_Okay|_Nicht doch!',,'rt_pubscrname='screen)

IF x = 0 THEN CALL bail_out




x = 0                   /* anhängen von Daten*/
DO i = 1 TO cron.0
    cron.i = "####"||Flag||"®"|| cron.i||,
    "®"Art"®"BLZ"®"KontoNr"®"Name"®"Mark"®"Pfennige"®"Zweck1"®"Zweck2"®"
END i

cronfile = MAKEPATH(SubWord(GETENV('HB-Cron'),2),'HB-Cron.data')
   IF cronfile = "HB-Cron.data" THEN cronfile = "Multiterm:HB/HB-Cron.data"
IF ~Exists(cronfile) THEN DO
    v=Open("data",cronfile,"w")
    v=WriteLn("data","HB-Cronfile V.4.0")
    v=WriteLn("data","datafile")
    v=Close("data")
END

IF ~WRITEFILE(cronfile,'cron','a' ) THEN DO
     dummy= BEEP()
     CALL rtezrequest('da war irgendwas beim Abspeichern der HB-Cron-Daten',,,'rt_pubscrname='screen)
 END

RETURN


bail_out:
IF neu ~= 1 THEN EXIT

Address Value fiasco_port

UnlockGUI
ResetStatus

exit

/* Fehlerroutinen */


syntax:
failure:

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

halt:
break_c:

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