#include "xbpdev.ch" #include "Common.ch" #include "Xbp.ch" PROCEDURE Rechdr2uni( cAuf, edrucker, zdate, zdate14, zdate8, cKuvert, anzbeg, anz, lAbr, oDlg1 ) // universelles Rechnungsdruckprogramm fr KSO LOCAL nOldArea := Select(), nRec := RecNo() //+11.10.2018 14:21 LOCAL aLeist1 := {}, aLeist2 := {}, aLeist3 := {}, aLeistA := {} //04.05.2008 16:32 aLeistA LOCAL nL1Sum := 0, nL2Sum := 0, nL3Sum := 0, nLASum := 0 LOCAL n4 := 4 , n5 := 5, nL12 := 0 LOCAL sbetr, grsu, smwsta, smwstb, zae, cKonto //31.01.2008 19:20 LOCAL cDummyL := cLPT //04.02.2008 12:49 LOCAL i, endbetr := 0, cAdeltaTx := "", cString := "", nSpaAnf := 5 //05.03.2008 18:34 LOCAL cNeu := "j", aPrompt := Array(7), aAnzahl:= Array(7) //15.03.2008 22:37 neuer ModalDialogA() LOCAL nAnz, nAnz1, nAnz2, nAnz3, nAnz4, nAnz5, cUm, nAnzum // LOCAL cRatenTx //+30.08.2012 10:21 Zahldatum und Skontodatum sollen berechnet aber „nderbar sein: //LOCAL zDate14 := DtoC(CtoD(zDate)+14) //LOCAL zDate8 := DtoC(CtoD(zDate)+8) PRIVATE cPrintfile //+02.07.2018 18:51 vorher nur inline definiert /*21.05.2008 18:25 */ IF xdmeu="D" /* DM darf nicht mehr gebraucht werden fr neue F„lle!! */ RETURN ENDIF /**/ IF lAbr //+30.10.2018 18:22 nur wenn aus R5L gedruckt / NICHT aus Kontrollbersicht AbrechZeilenKorrektur(cAuf) //+09.10.2018 21:23 ENDIF cLPT = "LPTA" //04.02.2008 12:49 nLL := 0 nAnz := Val(anz) IF ValType(oDlg1)=="O" // wenn aus der Windows-Bestattungsfall-Maske aufgerufen //31.01.2008 22:41 cKonto := 1->konto cKonto := "1" //+14.05.2018 13:03 Zahlung nur noch auf das Schumacher-Konto 1->(Satzsperren()) 1->konto := cKonto 1->(DbRUnlock()) // //+ 23.07.2008 10:47 Abrechnungsdatum aus der Datei holen - oder heute(): zdate := IIf( DtoC(1->abr_datum)!=" ", DtoC(1->abr_datum), DtoC(DATE()) ) //+16.07.2008 21:08 zdate ist "C" IF cNeu == "j" // ist oben als LOCAL so vorbesetzt SELECT 9 USE mwstdat aPrompt[1] := "Aufstellung (w fr Writer)" IF IsFieldVar("dfile1") .AND. Len(Trim(dFile1))>0 aPrompt[2] := IIf(cKonto="0",Trim(mwstdat->dfile1),"") //05.05.2008 21:30 AufstEnd.txt ENDIF IF IsFieldVar("dfile2") .AND. Len(Trim(dFile2))>0 aPrompt[3] := IIf(cKonto="0",Trim(mwstdat->dfile2),"") //05.05.2008 21:30 AufstEn2.txt ENDIF IF IsFieldVar("dfile3") .AND. Len(Trim(dFile3))>0 aPrompt[4] := IIf(cKonto="2",Trim(mwstdat->dfile3),"") //05.05.2008 21:30 begleit2.txt ENDIF IF IsFieldVar("dfile4") .AND. Len(Trim(dFile4))>0 aPrompt[5] := IIf(cKonto="2",Trim(mwstdat->dfile4),"") //05.05.2008 21:31 ratenant.jpg // aPrompt[5] := Trim(mwstdat->dfile4) /* 03.07.2008 12:54 neu: ratenant.jpg + .txt ! */ ENDIF IF IsFieldVar("dfile5") .AND. Len(Trim(dFile5))>0 aPrompt[6] := IIf(cKonto="2",Trim(mwstdat->dfile5),"") //05.05.2008 21:31 ratenant.jpg // aPrompt[6] := Trim(mwstdat->dfile5) ENDIF aPrompt[7] := "Briefumschlag (1/-1)" AFill(aAnzahl,"1") /* 04.05.2008 16:21 cKonto="0" kommt nicht mehr vor, kann also drinbleiben: */ IF cKonto == "0" // Aufforderungs/Benachrichtigungsschreiben mit Kostenaufstellung aAnzahl := {"1","1","1","","","","-1"} ELSEIF cKonto == "2" // Aufstellung mit Kontoangabe Adelta aAnzahl := {"2","","","0","0","","0"} //05.05.2008 21:33 0 Begleitbrief / 1 Ratenantrag ELSEIF cKonto == "1" // Aufstellung mit Kontoangabe KSO aAnzahl := {"2","","","","","","0"} //05.05.2008 21:34 0 Begleitbrief /neuer Ratenantrag ENDIF // aAnzahl := ModalDialogA( aPrompt, ; // "Ausdruck mit Konto: "+cKonto, oDlg1, 200*nV, 150*nV, aAnzahl, @zDate ) //+23.07.2008 10:48 aAnzahl := ModalDialogA( aPrompt, ; "Ausdruck mit Konto: "+cKonto, oDlg1, 300*nV, 300*nV, aAnzahl, @zDate, @zDate14, @zDate8 ) //+23.07.2008 10:48 IF aAnzahl[1]==0 .AND. aAnzahl[2]==0 .AND. aAnzahl[3]==0 .AND. aAnzahl[4]==0 .AND. aAnzahl[5]==0 ; .AND. aAnzahl[6]==0 .AND. aAnzahl[7]==0 //+22.10.2018 09:34 SELECT &nOldArea RETURN ENDIF nAnz := Val(aAnzahl[1]) nanz1 := IIf(cKonto="2",Val(aAnzahl[4]),Val(aAnzahl[4])) //15.06.2008 17:57 Anzahl fr dfile3=Begleitbrief nAnz2 := Val(aAnzahl[3]) // darf nicht mehr gebraucht werden, weil aufsten2 nAnz3 := Val(aAnzahl[4]) // wie nAnz1 ?? wohl historisch -oder? nAnz4 := Val(aAnzahl[5]) // ist ratenant.jpg nAnz5:= Val(aAnzahl[6]) // ist noch frei cUm := IIf( aAnzahl[7]$"1+j", "j", IIf(aAnzahl[7]$"k-1","k","") ) // j, oder k ELSE // frhere Anzahlabfrage: nAnz := 1 nAnz := Val( ModalDialog( LTrim(Str(nAnz,2,0)), ; "Anzahl der Drucke eingeben:", oDlg1, 200*nV, 150*nV )) ENDIF nArea := IIf( edrucker=="K", 3, 13 ) ELSEIF ValType(oDlg1) == "L" //+22.10.2018 21:47 cKonto := "1" //+14.05.2018 13:03 Zahlung nur noch auf das Schumacher-Konto nAnz := Val(anz) nAnz1 := Val(anzbeg) aAnzahl[1] := anz cUm := cKuvert nArea := IIf( edrucker=="K", 3, 13 ) ELSE nArea := 3 ENDIF //nAnzahl := nAnz select 20 use drubef edrucker=upper(edrucker) if edrucker="E" .OR. cDrucker="EP" z12p=trim(ep12p) z14p=trim(ep14p) znorm=trim(epnorm) cRes1 := Trim(epres1) cRes2 := Trim(epres2) cRes3 := Trim(epres3) cRes4 := Trim(epres4) nPoffY:= Val(SubStr(epres5,1,3)) nPoffX:= Val(SubStr(epres5,4,3)) nPpZ := Val( Substr( 20->epres5, 7, 3 ) ) //10.01.2008 09:24 nPpS := Val( Substr( 20->epres5, 10, 3 ) ) //10.01.2008 09:24 else z12p=trim(hp12p) z14p=trim(hp14p) znorm=trim(hpnorm) cRes1 := Trim(hpres1) cRes2 := Trim(hpres2) cRes3 := Trim(hpres3) cRes4 := Trim(hpres4) nPoffY:= Val(SubStr(hpres5,1,3)) nPoffX:= Val(SubStr(hpres5,4,3)) nPpZ := Val( Substr( 20->hpres5, 7, 3 ) ) //10.01.2008 09:24 nPpS := Val( Substr( 20->hpres5, 10, 3 ) ) //10.01.2008 09:24 endif USE //nAnzahl := nAnz // DO WHILE nAnz > 0 ASize( aLeist1, 0 ); ASize( aLeist2, 0 ); ASize( aLeist3, 0 ); ASize( aLeistA, 0 ) SELECT &nArea IF nArea == 3 FIND &cAuf ELSE /*04.05.2008 22:54 damit aLeistA ermittelt werden kann: */ SELECT 3 FIND &cAuf DbSuspendNotifications() //05.03.2008 12:40 DO WHILE Auftrnr == Val( cAuf ) .AND. .NOT. Eof() DO CASE CASE rn == "A" //04.05.2008 16:31 AAdd( aLeistA, bezeich ) AAdd( aLeistA, &b_g ) AAdd( aLeistA, mwst_schl ) AAdd( aLeistA, rn ) nLASum += &b_g //+27.10.2018 21:51 CASE rn == " " AAdd( aLeist1, bezeich ) AAdd( aLeist1, &b_g ) AAdd( aLeist1, mwst_schl ) AAdd( aLeist1, rn ) nL1Sum += &b_g //+27.10.2018 21:51 CASE rn == "2" AAdd( aLeist2, bezeich ) AAdd( aLeist2, &b_g ) AAdd( aLeist2, mwst_schl ) AAdd( aLeist2, rn ) nL2Sum += &b_g //+27.10.2018 21:51 CASE rn == "3" AAdd( aLeist3, bezeichf1 ) AAdd( aLeist3, bezeichf2 ) AAdd( aLeist3, &b_g ) AAdd( aLeist3, mwst_schl ) AAdd( aLeist3, rn ) nL3Sum += &b_g //+27.10.2018 21:51 ENDCASE SKIP ENDDO DbResumeNotifications() //05.03.2008 12:40 //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //+27.10.2018 21:45 Vergleich der gerade erstellten aktuellen Summen mit den Summen in best.dbf IF nLASum != 1->&r_b_1h IF ConfirmBox( oCB, "Die Rechnungssumme III in der Bestattungsfalldatei stimmt" + CRLF +; "nicht mit der aus der Rechnungsdatei ermittelten berein!" + CRLF +; "Bitte den Druck abbrechen mit und kontrollieren!", ; "ACHTUNG - Finanzierungskosten berprfen", ; XBPMB_YESNO, ; XBPMB_CRITICAL ) == XBPMB_RET_NO SELECT &nOldArea RETURN ENDIF ENDIF IF Val(Str(nL1Sum)) != Val(Str(1->&r_b_1)) IF ConfirmBox( oCB, "Die Rechnungssumme I in der Bestattungsfalldatei stimmt" + CRLF +; "nicht mit der aus der Rechnungsdatei ermittelten berein!" + CRLF +; "Bitte den Druck abbrechen mit und kontrollieren!", ; "ACHTUNG - Eigenleistungen I berprfen", ; XBPMB_YESNO, ; XBPMB_CRITICAL ) == XBPMB_RET_NO SELECT &nOldArea RETURN ENDIF ENDIF IF Val(Str(nL2Sum)) != Val(Str(1->&r_b_2)) IF ConfirmBox( oCB, "Die Rechnungssumme II in der Bestattungsfalldatei stimmt" + CRLF +; "nicht mit der aus der Rechnungsdatei ermittelten berein!" + CRLF +; "Bitte den Druck abbrechen mit und kontrollieren!", ; "ACHTUNG - Eigenleistungen II berprfen", ; XBPMB_YESNO, ; XBPMB_CRITICAL ) == XBPMB_RET_NO SELECT &nOldArea RETURN ENDIF ENDIF //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ASize( aLeist1, 0 ); ASize( aLeist2, 0 ); ASize( aLeist3, 0 ); ASize( aLeistA, 0 ) /**/ SELECT &nArea GO TOP ENDIF DbSuspendNotifications() //05.03.2008 12:40 DO WHILE Auftrnr == Val( cAuf ) .AND. .NOT. Eof() DO CASE CASE rn == "A" //04.05.2008 16:31 AAdd( aLeistA, bezeich ) AAdd( aLeistA, &b_g ) AAdd( aLeistA, mwst_schl ) AAdd( aLeistA, rn ) CASE rn == " " AAdd( aLeist1, bezeich ) AAdd( aLeist1, &b_g ) AAdd( aLeist1, mwst_schl ) AAdd( aLeist1, rn ) CASE rn == "2" AAdd( aLeist2, bezeich ) AAdd( aLeist2, &b_g ) AAdd( aLeist2, mwst_schl ) AAdd( aLeist2, rn ) CASE rn == "3" AAdd( aLeist3, bezeichf1 ) AAdd( aLeist3, bezeichf2 ) AAdd( aLeist3, &b_g ) AAdd( aLeist3, mwst_schl ) AAdd( aLeist3, rn ) ENDCASE SKIP ENDDO DbResumeNotifications() //05.03.2008 12:40 nL1 := Len( aLeist1 ) nL2 := Len( aLeist2 ) nL3 := Len( aLeist3 ) nLA := Len( aLeistA ) //04.05.2008 16:33 nAnzahl := nAnz IF nAnz == 0 AAdd( aLeist1, 0, nL1+1 ) AAdd( aLeist1, 0, nL1+2 ) AAdd( aLeist2, 0, nL2+1 ) AAdd( aLeist2, 0, nL2+2 ) AAdd( aLeist3, 0, nL3+1 ) AAdd( aLeist3, 0, nL3+2 ) AAdd( aLeistA, 0, nLA+1 ) //04.05.2008 16:34 AAdd( aLeistA, 0, nLA+2 ) //04.05.2008 16:34 ELSE AAdd( aLeist1, 0, nL1+1 ) AAdd( aLeist1, 0, nL1+2 ) AAdd( aLeist1, 0, nL1+3 ) AAdd( aLeist1, 0, nL1+4 ) AAdd( aLeist2, 0, nL2+1 ) AAdd( aLeist2, 0, nL2+2 ) AAdd( aLeist2, 0, nL2+3 ) AAdd( aLeist2, 0, nL2+4 ) AAdd( aLeist3, 0, nL3+1 ) AAdd( aLeist3, 0, nL3+2 ) AAdd( aLeist3, 0, nL3+3 ) AAdd( aLeist3, 0, nL3+4 ) AAdd( aLeistA, 0, nLA+1 ) //04.05.2008 16:34 AAdd( aLeistA, 0, nLA+2 ) //04.05.2008 16:34 AAdd( aLeistA, 0, nLA+3 ) //04.05.2008 16:34 AAdd( aLeistA, 0, nLA+4 ) //04.05.2008 16:34 ENDIF nL12 := int( Len( aLeist1 )/4 + Len( aLeist2 )/4 + Len( aLeistA )/4 ) //04.05.2008 16:35 select 9 use ksotexte rechtext1=ksotexte->retxt1 rechtext2=ksotexte->retxt2 //31.01.2008 19:23 Umschaltung der Konten zahltext1=IIf(cKonto$"A1 ",ksotexte->zatxt1,ksotexte->zbtxt1) zahltext2=IIf(cKonto$"A1 ",ksotexte->zatxt2,ksotexte->zbtxt2) zahltext3=IIf(cKonto$"A1 ",ksotexte->zatxt3,ksotexte->zbtxt3) zahltext4=IIf(cKonto$"A1 ",ksotexte->zatxt4,ksotexte->zbtxt4) zahltext5=IIf(cKonto$"A1 ",ksotexte->zatxt5,ksotexte->zbtxt5) zahltext6=IIf(cKonto$"A1 ","",ksotexte->zbtxt6) //04.02.2008 11:48 guttext1=ksotexte->gutxt1 guttext2=ksotexte->gutxt2 use //+25.06.2018 18:33 wenn anz == w, dann wird nur der HTML-File ausgegeben auf swriter vvvvvvvv IF nAnz == 0 .AND. Upper(anz) == "W" //+29.10.2018 21:34 cDruckabr := "c:\hdbe\dHTML.abr" // Text fr HTML-File ELSE cDruckabr := "c:\hdbe\dummy.abr" // Dummy, damit berechnet wird ENDIF //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ zaehler=0 ++nAnz /*03.07.2008 18:15*/ DO WHILE nAnz > 0 zaehler=zaehler+1 sbetr=0 kzmwst="m" IF nAnz>1 /* 03.07.2008 18:14 in Dummydatei, damit endbetr berechnet wird -auch ohne Druck! */ SET DEVICE TO PRINTW ELSE --nAnz Set( _SET_DEVICE, "PRINTER" ) // damit PRINTW umgangen wird: schreiben in eine Datei cPrintFile := Set( _SET_PRINTFILE, cDruckabr ) // in cPrintfile ist jetzt die VORIGE Einstellung! ENDIF select 1 find &cAuf zrechbetr1=&r_b_1 zrechbetr2=&r_b_2 ///*04.05.2008 17:12 Vorfinanzierungskosten (werden z.Zt. nicht abgespeichert!) 21.05.2008 18:41 jetzt doch! */ nLL := nLA aLeistA := Leistdruck( aLeistA, n4, 0 ) // 0 heiát nicht drucken, nur rechnen // IF &r_b_1h != aLeistA[nLA+1] // MsgBox("Rechnung ist nicht mit diesen Vorfinanzierungskosten gedruckt worden!") // ENDIF ///**/ ganzer Absatz geREMt 28.05.2008 13:12 und ersetzt durch die folgende Zeile: zrechbetrA=&r_b_1h //21.05.2008 18:36 jetzt wird DM nicht mehr erlaubt sein! // zdate := DtoC(DATE()) //+16.07.2008 21:08 zdate ist "C" @ 06,5 say Z1214(chr(27)+znorm+" ") //01.02.2008 13:54 @ 07,5 say ansp_anr @ 08,5 say trim(ansp_vname) + " " + ansp_name @ 09,5 say ansp_str @ 11,5 say ansp_ort //+30.08.2012 10:47 @ 12,45 say "Auftrag : "+cAuf+" / "+zdate //+16.07.2008 21:08 zdate ist "C" @ 12,45 say "Auftrag : "+cAuf //+30.08.2012 10:47 nach unten: +" / "+zdate //+16.07.2008 21:08 zdate ist "C" zae=14 @ zae,5 say Z1214(Chr(27)+z12p)+"Bestattung: "+trim(anrede)+" "+trim(vorname)+ " "+name zae=zae+1 @ zae,5 say Z1214(chr(27)+znorm+" ") zae=zae+2 @ zae,5 say Z1214(chr(27)+z12p)+space(IIf(cLPT="LPT1",43,20))+"A U F S T E L L U N G" // @ zae,48 say Z1214(chr(27)+z14p)+"A U F S T E L L U N G" //+25.06.2018 13:22 damit kein zae-2 fr den Printfile bei html vvvvvvvvvvvvvvvvvvvvvvv IF isMemvar("cPrintFile") @ zae,61 SAY "vom "+zDate zae=zae+2 @ zae,5 say Z1214(chr(27)+znorm+" ") ELSE zae=zae+2 @ zae,5 say Z1214(chr(27)+znorm+" ") //+30.08.2012 10:50 jetzt ist das Aufstellungs-Datum hier: @ zae-2,61 SAY "vom "+zDate ENDIF //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ zae=zae+1 @ zae,5 say "Rechnung-"+Trim(rechtext1) //+25.06.2018 15:12 Trim() @ zae,62 SAY w_g @ zae,67 say str(zrechbetr1,8,2) zae=zae+1 /* @ zae,5 say "Rechnung-"+rechtext2 04.05.2008 16:38 geREMt */ @ zae,5 say "Rechnung-Fa. Schumacher - Leistung II, Sonstiges" @ zae,62 SAY w_g @ zae,67 say str(zrechbetr2,8,2) IF zrechbetrA <> 0 //+25.06.2018 15:12 Leistung III ist eigentlich schon abgeschafft worden @ ++zae,5 say "Rechnung-Fa. Schumacher - Leistung III, Vorfinanzierung" //04.05.2008 16:40 @ zae,62 SAY w_g @ zae,67 say str(zrechbetrA,8,2) ENDIF zae=zae+2 @ zae,5 say Z1214(chr(27)+z12p)+"In Ihrem Namen und fr Ihre Rechnung verauslagt:" zae=zae+1 @ zae,5 say Z1214(chr(27)+znorm)+" " // zae=zae+1 //18.07.2006 16:23 geREMt gr=" " grsu=0 grsu1=0 sbetr=0 smwsta=0 smwstb=0 texta=" " textb=" " aufzei=0 // DO WHILE .NOT. Eof() nLL := nL3 aLeist3 := Leistdruck( aLeist3, n5, @zae ) //// sbetr=nASum // das gab am 9.9.02 eine falsche Summe! sbetr=aLeist3[nL3+1] // grsu=grsu + val(substr(&tabf,62,8)) // enddo @ ++zae,67 say "--------" zae=zae+1 @ zae,36 say Z1214(chr(27)+z12p)+"Gesamtkosten:"+Z1214(chr(27)+znorm)+" " gesbetr=zrechbetr1+zrechbetr2+zrechbetrA+sbetr //04.05.2008 23:18 @ zae,62 SAY w_g @ zae,67 say str(gesbetr,8,2) zae=zae+1 @ zae,67 say "========" zae=zae+1 select 2 // Versicherungsbetr„ge find &cAuf suvers=0.00 sch1=1 do while val(cAuf)=auftrnr if .not. delete() .and. &b_b_g<>0 if sch1=1 sch1=0 @ zae,5 say Z1214(chr(27)+z12p)+ "Erhaltene Betr„ge von:" zae=zae+1 @ zae,5 say Z1214(chr(27)+znorm)+" " zae=zae+1 endif IF !Empty( abrname ) @ zae,5 say SubStr(abrname,1,40) //+02.07.2018 20:03 Substr() - wg bez_am ELSE @ zae,5 say name1 ENDIF //+09.07.2012 20:54 Zahldatum drucken, wenn Zahlung des Kunden: IF "AUFT"$2->verskz .AND. !"2"$2->verskz @ zae,47 SAY "am "+DtoC(2->bez_am) ENDIF @ zae,62 SAY w_g @ zae,66 say str(&b_b_g,9,2) zae=zae+1 suvers=suvers+&b_b_g endif skip enddo if suvers>0 @ zae,67 say "--------" zae=zae+1 @ zae,36 say Z1214(chr(27)+z12p)+"Erhaltener Betrag:"+Z1214(chr(27)+znorm)+" " @ zae,62 SAY w_g @ zae,66 say str(suvers,9,2) zae=zae+1 @ zae,67 say "========" zae=zae+3 endif do while .t. if Round(gesbetr,2) > Round(suvers,2) @ zae,36 say "Gesamtkosten:" @ zae,62 SAY w_g @ zae,66 say str(gesbetr,9,2) zae=zae+1 @ zae,36 say "- Erhaltener Betrag:" @ zae,62 SAY w_g @ zae,66 say str(suvers,9,2) zae=zae+1 @ zae,67 say "--------" endbetr=gesbetr-suvers zae=zae+1 @ zae,36 SAY Z1214(chr(27)+z12p)+"Restbetrag:"+Z1214(chr(27)+znorm)+" " @ zae,62 say w_g @ zae,66 say str(endbetr,9,2) zae=zae+1 @ zae,67 say "========" zae=zae+2 IF cKonto != "0" //05.03.2008 12:08 "0": kein Kontotext^ //////////// +14.05.2018 12:54 nur noch cKonto == 1: vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //////////// IF cKonto $ "A1 " //04.05.2008 17:45 =alter Text aus ksotexte.dbf //////////// /* 03.07.2008 11:26 Zahltermine ohne und mit Sofortzahlungsnachlass: */ //////////// //* die Texte sind in KSOTEXTE.DBF fr Konto1 die Sektion ZATXT~ //////////// IF "Leistung III"$ zahltext1+zahltext2+zahltext3+zahltext4+zahltext5 //////////////+30.08.2012 10:30 @ zae,5 say Trim(zahltext1) + " " + DtoC( DATE()+21 ) // Zahlungstermin 21 Tage //////////// //+30.08.2012 10:30 //////////// @ zae,5 say Trim(zahltext1) + " " + zDate14 // Zahlungstermin 14 Tage //////////// zae=zae+1 //////////// @ zae,5 say zahltext2 //////////// zae=zae+1 //////////// @ zae,5 say zahltext3 //////////// zae=zae+1 //////////////+30.08.2012 10:31 @ zae,5 say DtoC( DATE()+8) + " " + zahltext4 // 'Skonto'Termin 8 Tage //////////// //+30.08.2012 10:31 //////////// @ zae,5 say zDate8 + " " + zahltext4 // 'Skonto'Termin 8 Tage //////////// zae=zae+1 //////////// @ zae,5 say guttext2 //+09.07.2012 20:44 frher: zahltext5 //////////// zae=zae+1 //04.02.2008 11:49 //////////// @ zae,5 say zahltext6 //////////// ELSE // @ zae,5 say zahltext1 @ zae,5 say IIf(zahltext1=">","",Trim(zahltext1) + " " + zDate14) // Zahlungstermin 14 Tage zae=zae + IIf(zahltext1=">",0,1) // '>' in KSOTEXTE.dbf l”scht die Zeile @ zae,5 say IIf(zahltext2=">","",zahltext2) zae=zae + IIf(zahltext2=">",0,1) @ zae,5 say IIf(zahltext3=">","",zahltext3) zae=zae + IIf(zahltext3=">",0,1) @ zae,5 say IIf(zahltext4=">","",zahltext4) zae=zae + IIf(zahltext4=">",0,1) @ zae,5 say IIf(zahltext5=">","",zahltext5) zae=zae + IIf(zahltext5=">",0,1) @ zae,5 say zahltext6 //////////// ENDIF //////////// ELSE //////////// /*04.05.2008 18:02 bei cKonto=2 kommt Text aus Textdatei: ggf mit Seitenvorschub */ //////////// IF zae > 48 //////////// @ ++zae,55 say "-2-" //////////// EJECT //////////// zae=12 //////////// @ zae,5 say "Seite 2" //////////// @ zae,45 say "Auftrag : "+cAuf+" / "+dtoc(date()) //////////// ++zae //////////// @ ++zae,5 say Z1214(Chr(27)+z12p)+"Bestattung: "+trim(1->anrede)+" "+trim(1->vorname)+ " "+1->name //////////// zae=zae+1 //////////// @ zae,5 say Z1214(chr(27)+znorm+" ") //////////// zae=zae+5 //////////// ENDIF //////////// select 9 //////////// use mwstdat //////////// cDFile1 := IIf(IsFieldVar("dfile1"),Trim(mwstdat->dfile1),"") //z.B. AufstEnd.txt //////////// cDFile2 := IIf(IsFieldVar("dfile2"),Trim(mwstdat->dfile2),"") //z.B. AufstEn2.txt //////////// USE //////////// SELECT 1 //////////// /* Wenn die Datei existiert: einlesen in cAdeltaTx: //////////// ConvToOEMCP - weil die Datei im Windows-Editor gepflegt wird! //////////// (zrechbetrA=Vorfinanzierungskosten) */ //////////// IF FExists(cDatver + IIf(zrechbetrA!=0,cDFile1,cDFile2)) .AND. ; //////////// Upper(Right(IIf(zrechbetrA!=0,cDFile1,cDFile2),4))$".TXT" //05.05.2008 21:40 //////////// cAdeltaTx := ConvToOEMCP(MemoRead(cDatver + IIf(zrechbetrA!=0,cDFile1,cDFile2))) //05.05.2008 21:40 //////////// /* Im Text die Auftragsnummer unterbringen: */ //////////// IF "Auftragsnummer"$cAdeltaTx //////////// cAdeltaTx := Stuff(cAdeltaTx,At("Auftragsnummer",cAdeltaTx),14,"Auftragsnummer "+Str(1->auftrnr,6,0)) //////////// ENDIF //////////// FOR i := 1 TO MlCount( cAdeltaTx ) //////////// cString := MemoLine( cAdeltaTx,75, i ) //////////// IF Len(LTrim(cString))>0 .AND. LTrim(cString)[1]==">" //+24.04.2018 10:59 Len(LTrim( //////////// @ zae++,5 SAY Z1214(chr(27)+z12p)+Subst(cString,2) //////////// ELSE //////////// zae=zae+1 //04.02.2008 11:49 //////////// @ zae,5 SAY Z1214(chr(27)+znorm)+" " //////////// zae=zae-1 //04.02.2008 11:50 //////////// @ zae++,5 SAY LTrim(cString) //////////// ENDIF //////////// NEXT //////////// ENDIF //////////// ENDIF // + 14.05.2018 12:53 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ENDIF //+25.06.2018 22:03 geREMt wegen HTML: // zae=zae+1 //04.02.2008 11:49 // @ zae,5 SAY Z1214(chr(27)+znorm)+" " // zae=zae-2 //04.02.2008 11:50 EXIT endif if Round(gesbetr,2) < Round(suvers,2) @ zae,41 say "Erhaltener Betrag:" @ zae,62 SAY w_g @ zae,66 say str(suvers,9,2) zae=zae+1 @ zae,41 say "- Gesamtkosten:" @ zae,62 SAY w_g @ zae,66 say str(gesbetr,9,2) zae=zae+1 @ zae,67 say "--------" endbetr=suvers-gesbetr zae=zae+1 @ zae,41 say Z1214(chr(27)+z12p)+"Guthaben:"+Z1214(chr(27)+znorm)+" " @ zae,62 SAY w_g @ zae,66 say str(endbetr,9,2) zae=zae+1 @ zae,67 say "========" zae=zae+2 @ zae,5 say guttext1 zae=zae+1 @ zae,5 say guttext2 else @ zae,41 say "Erhaltener Betrag:" @ zae,62 SAY w_g @ zae,66 say str(suvers,9,2) zae=zae+1 @ zae,41 say "- Gesamtkosten:" @ zae,62 SAY w_g @ zae,66 say str(gesbetr,9,2) zae=zae+1 @ zae,67 say "--------" endbetr=suvers-gesbetr zae=zae+1 @ zae,41 say Z1214(chr(27)+z12p)+" "+Z1214(chr(27)+znorm)+" " @ zae,62 SAY w_g @ zae,66 say str(endbetr,9,2) zae=zae+1 @ zae,67 say "========" endif EXIT enddo zae=zae+2 @ zae,5 say "Wir danken Ihnen fr das uns entgegengebrachte Vertrauen." zae=zae+2 @ zae,5 say "Mit freundlichen Gráen" ////////////// IF cKonto$"A1 0" //31.01.2008 19:40 durch X-en der Kontonummer in Fettdruck //////////// IF cKonto$"A120" //04.05.2008 17:41 kein aus-X-en mehr ////////////// ELSE ////////////// @ 63.5,47 say Z1214(chr(27)+z12p) ////////////// @ 64.5,47 say Replicate("X",29) ////////////// @ 65.0,47 say Replicate("X",29) ////////////// @ 65.5,47 say Replicate("X",29) ////////////// @ 62.5,47 say Z1214(chr(27)+znorm)+" " //////////// ENDIF IF cLPT = "LPT1" EJECT lSeiteleer := .F. ENDIF sch1=0 --nAnz IF nAnz > 0 aLeist3[nL3+1] := 0 aLeist3[nL3+2] := 0 aLeistA[nLA+1] := 0 //21.05.2008 18:33 aLeistA[nLA+2] := 0 //21.05.2008 18:33 ENDIF IF nAnz >= 0 /*03.07.2008 18:17 s.o. Dummydruck, um endbetr auszurechnen */ SET DEVICE TO SCREEN ELSE Set( _SET_PRINTFILE, cPrintFile ) // 03.07.2008 18:17 Set( _SET_DEVICE, "SCREEN" ) // weil Ausdruck in File umgeleitet war ENDIF ENDDO //+25.06.2018 18:42 Aufruf von swriter mit dem HTML-Druckfile: vvvvvvvvvvvvvvvvvvvvv IF cDruckabr == "c:\hdbe\dHTML.abr" HTML_Brief(cDruckabr,,"Courier New, monospace", "11pt", "1cm 1cm 1cm 2cm") ENDIF //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ /*21.05.2008 18:29 Fremdleistungs-Summe wird jetzt auch abgespeichert, in &r_b_2h */ IF Val(aAnzahl[1]) > 0 .OR. Len(Trim(aAnzahl[1]))==0 .OR. Upper(Trim(aAnzahl[1]))="W" //+02.07.2018 20:34 .OR. ... SELECT 1 //+28.10.2018 21:15 hat hier vielleicht gefehlt? 1->(satzsperren()) //* damit die erg„nzten BestFallDaten auch bertragen werden aData1 := SatzGet( Select(), RecNo() ) *// IF xdmeu="D" /* DM darf nicht mehr gebraucht werden fr neue F„lle!! */ // 21.05.2008 18:19 repl &r_b_2 with aLeist2[nL2+1] // 21.05.2008 18:16 repl &r_b_2h with aLeist2[nL2+1]/xfaktor ELSE // 21.05.2008 18:17 repl &r_b_2 with aLeist2[nL2+1] repl 1->&r_b_2h with aLeist3[nL3+1] repl 1->abr_datum WITH CtoD(zdate) //+16.07.2008 20:55 "C"! Abrechnungsdatum = heute (s.o.) ENDIF //* damit die erg„nzten BestFallDaten auch bertragen werden trckng( Select(), RecNo(), aData1 ) *// 1->(satzentsperren()) ENDIF /**/ /////////////*05.05.2008 18:03 Termin fr Adelta-Fax eintragen: */ //////////// IF cKonto ="2" //////////// SELECT 9 //////////// use term INDEX xterm //////////// LOCATE FOR "Heute Fax an Adelta fr "+Trim(1->name)+"/"+Str(1->auftrnr,6,0)$9->tx //////////// IF 9->(Eof()) //////////// 9->(DbAppend()) //////////// 9->datum := DATE()+14 //////////// 9->tx := "Heute Fax an Adelta fr "+Trim(1->name)+"/"+Str(1->auftrnr,6,0) //////////// ENDIF //////////// USE //////////// ENDIF /////////////**/ //+26.07.2008 19:53 Termin fr Erinnerung eintragen: IF cKonto ="1" SELECT 9 use term INDEX xterm LOCATE FOR "Heute erinnern: "+Trim(1->name)+"/"+Str(1->auftrnr,6,0)$9->tx IF 9->(Eof()) 9->(DbAppend()) 9->datum := CtoD(zdate) + 23 //+ Zahldatum + 2 9->tx := "Heute erinnern: "+Trim(1->name)+"/"+Str(1->auftrnr,6,0) ENDIF USE ENDIF /**/ // Anfang Schreiben der Auftrag-Backup-Datei SELECT 9 USE AUFTR_B SELECT &nArea // SELECT 13 IF nArea == 3 FIND &cAuf ELSE DbSuspendNotifications() INDEX ON Str(auftrnr,6,0)+kennz+zeile TO C:\HDBE\xtemp IF .NOT. Bof() GO TOP ENDIF ENDIF aData2 := Array(FCount()) nZeile := 0 DO WHILE .NOT. Eof() DO WHILE (nArea)->auftrnr != 1->auftrnr .AND. .NOT. (nArea)->(Eof()) // S„tze mit auftrnr == 0 SKIP LOOP ENDDO ++nZeile For n := 1 to FCount() aData2[n] := FieldGet( n ) NEXT SELECT 9 APPEND BLANK // Satzsp( oCB ) For n := 1 to FCount() FieldPut( n, aData2[n] ) NEXT REPLACE 9->zeile WITH Str( nZeile,2,0 ) DbRUnlock( Recno() ) SELECT &nArea // SELECT 13 SKIP ENDDO SELECT 9 USE SELECT &nArea // SELECT 13 IF nArea <> 3 SET INDEX TO DbResumeNotifications() ENDIF // Ende Schreiben der Auftrag-Backup-Datei IF cNeu != "j" nAnz1 := 1 nAnz1 := Val( ModalDialog( LTrim(Str(nAnz1,2,0)), ; "Anzahl der Anschreiben (1/0) eingeben:", oDlg1, 200*nV, 150*nV, {"",""} )) //05.03.2008 13:02 ENDIF IF nAnz1 > 0 //16.03.2008 11:00 nSpaAnf := 5 //05.03.2008 18:35 ////// SET DEVICE TO PRINTW ////// SET PRINTER TO c:\hdbe\anschrei.ben Set( _SET_DEVICE, "PRINTER" ) // damit PRINTW umgangen wird: schreiben in eine Datei cPrintFile := Set( _SET_PRINTFILE, "c:\hdbe\anschrei.ben" ) // 22.10.2005 cAnr := Trim(" ") IF Trim(1->ansp_anr) = "Herr" cAnr := "r" ENDIF @ 07,0 say 1->ansp_anr @ 08,0 say trim(1->ansp_vname) + " " + 1->ansp_name @ 09,0 say 1->ansp_str @ 11,0 say 1->ansp_ort DO CASE CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "2" // .OR. Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "5" @ 17,47 say "45144 Essen, " + DtoC(DATE()) //+05.03.2010 08:59 CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "3" ; CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "3" .AND. Substr( Str( 1->auftrnr,6,0 ), 4, 1 ) >= "5" ; //+05.03.2010 08:54 Ratingen .OR. Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "4" @ 17,44 say "47178 Duisburg, " + DtoC(DATE()) CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "5" ; .OR. Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "6" @ 17,39 say "45899 Gelsenkirchen, " + DtoC(DATE()) OTHERWISE @ 17,42 say "46117 Oberhausen, " + dtoc(date()) ENDCASE @ 21,0 say "Bestattung: "+Trim(1->anrede)+" "+Trim(1->vorname)+ " "+Trim(1->name) @ 24,0 say "Sehr geehrte"+cAnr+" "+Trim(1->ansp_anr)+" "+Trim(1->ansp_name)+"," //**05.03.2008 18:13 alternatives Begleitschreiben/////////// IF cKonto == "0" //05.05.2008 22:00 gibt es eh' nicht mehr !! /* cAdeltaTx := "in der Anlage bersenden wir Ihnen unsere Kostenaufstellung." + CRLF + CRLF cAdeltaTx += "Es ergibt sich ein Restbetrag in H”he von " + LTrim(Str(endbetr,9,2))+"."+CRLF+CRLF FOR i := 1 TO MlCount( cAdeltaTx ) @ i+25,0 SAY LTrim(MemoLine( cAdeltaTx,75, i )) NEXT select 9 use mwstdat cDFile1 := IIf(IsFieldVar("dfile1"),Trim(mwstdat->dfile1),"") //z.B. Begleit.txt/Begleit.jpg USE SELECT 1 IF FExists(cDatver + cDFile1) .AND. Upper(Right(cDFile1,4))$".TXT" //15.03.2008 18:11 cAdeltaTx := ConvToOEMCP(MemoRead(cDatver + cDFile1)) //04.05.2008 18:34 Ansi FOR i := 1 TO MlCount( cAdeltaTx ) @ i+29,0 SAY LTrim(MemoLine( cAdeltaTx,75, i )) NEXT ELSEIF FExists(cDatver + cDFile1) .AND. Upper(Right(cDFile1,4))$".JPG.BMP" //15.03.2008 19:12 cBriefkopf := cDFile1 // druckt die Grafikdatei auf die Seite drauf ELSE cAdeltaTx += "Wir bitten um šberweisung dieses Restbetrages als Akontozahlung innerhalb von 14 Tagen." cAdeltaTx += "Nach Zahlungseingang werden wir Ihnen die Originalbelege zusenden."+CRLF+CRLF cAdeltaTx += "K”nnen wir innerhalb von 14 Tagen keinen Zahlungseingang feststellen, werden wir, wie vereinbart, " cAdeltaTx += "Ihnen eine Abrechnung, erh”ht um die vereinbarte Bearbeitungsgebhr, zusenden mit der Bitte, den " cAdeltaTx += "endgltigen Betrag auf das Konto der Adelta Bestattungsfinanz innerhalb einer Frist von 21 Tagen " cAdeltaTx += "zu berweisen." + CRLF + CRLF cAdeltaTx += "Falls Sie sich fr diese Zahlungsweise entscheiden, steht Ihnen die Adelta Bestattungsfinanz gerne " cAdeltaTx += "mit einer Ratenzahlungsm”glichkeit zur Verfgung." + CRLF + CRLF cAdeltaTx += "Mit freundlichen Gráen" + CRLF+CRLF+CRLF+CRLF+CRLF+CRLF+CRLF cAdeltaTx += "Anlage: Kostenaufstellung" FOR i := 1 TO MlCount( cAdeltaTx ) @ i+25,0 SAY MemoLine( cAdeltaTx,75, i ) NEXT ENDIF */ ELSE //05.05.2008 22:00 d.h. cKonto$"A12 " ////// select 9 ////// use mwstdat ////// cDFile3 := IIf(IsFieldVar("dfile3"),Trim(mwstdat->dfile3),"") //z.B. Begleit.txt/Begleit.jpg ////// USE SELECT 1 ////// IF nAnz3>0 .AND. cKonto="2" .AND. FExists(cDatver + cDFile3) .AND. Upper(Right(cDFile3,4))$".TXT" //15.03.2008 18:11 ////// cAdeltaTx := ConvToOEMCP(MemoRead(cDatver + cDFile3)) //04.05.2008 18:34 Ansi ////// FOR i := 1 TO MlCount( cAdeltaTx ) ////// @ i+25,0 SAY LTrim(MemoLine( cAdeltaTx,75, i )) ////// NEXT ////// ELSEIF nAnz3>0 .AND. cKonto="2" .AND. FExists(cDatver + cDFile3) .AND. Upper(Right(cDFile3,4))$".JPG.BMP" //15.03.2008 19:12 ////// cBriefkopf := cDFile3 // druckt die Grafikdatei auf die Seite drauf ////// ELSE //+26.06.2018 09:01 Vorzeilen auskommentiert, weil jetzt nur noch Konto == 1 existiert (=KSO-Konto) IF IsFieldVar("abrief1") @ 26,0 say mwstdat->Abrief1 @ 27,0 say mwstdat->Abrief2 @ 28,0 SAY mwstdat->Abrief3 @ 29,0 say mwstdat->Abrief4 @ 30,0 say mwstdat->Abrief5 @ 31,0 say mwstdat->Abrief6 @ 32,0 say mwstdat->Abrief7 @ 33,0 say mwstdat->Abrief8 @ 34,0 say mwstdat->Abrief9 @ 36,0 say "Mit freundlichen Gráen" @ 43,0 say "Anlagen" ELSE @ 26,0 say "beiliegend bersenden wir Ihnen alle Originalbelege der" @ 27,0 say "Bestattungskosten und eine Information ber unsere Sterbekasse." @ 28,0 SAY "Falls Sie sich ber unsere Sterbekasse versichern wollen, " @ 29,0 say "rufen Sie uns bitte an." @ 31,0 say "Vielen Dank noch einmal fr das uns entgegengebrachte Vertrauen." @ 36,0 say "Mit freundlichen Gráen" @ 43,0 say "Anlagen" ENDIF ENDIF ////// SET PRINTER TO ////// SET DEVICE TO SCREEN // Set( _SET_PRINTFILE, "LPT1" ) Set( _SET_PRINTFILE, cPrintFile ) // 22.10.2005 Set( _SET_DEVICE, "SCREEN" ) // weil Ausdruck in File umgeleitet war // cString := ModalDialog( "c:\hdbe\anschrei.ben", ; // "Bestattungs-Aufstellung - Anschreiben:", oCB:setParent(), Int(700*nV), Int(400*nV), {"",""} ) //05.03.2008 13:04 // DO WHILE nAnz1-- > 0 //16.03.2008 11:10 // SET DEVICE TO PRINTW // IF cLPT = "LPTA" // das wird neuerdings (4.2.2008) oben ohnehin so eingestellt! // ////// IF cKonto == "0" //05.03.2008 18:51 // ////// aFonts := { "12.TIMES NEW ROMAN" } // ////// ELSE // aFonts := { "11.COURIER NEW" } // ////// ENDIF // // @ 0,0 say cString // FOR i := 1 TO MlCount( cString ) // @ i,nSpaAnf SAY MemoLine( cString,75, i ) //04.05.2008 20:46 // NEXT // aFonts := {} // ELSE // SET MARGIN TO nSpaAnf //15.03.2008 18:28 // @ 0,0 SAY Chr(27) + cRes1 + " " // SetPrc(0,0) // @ 0,0 say cString // QOut( Chr(27) + znorm +" " ) // SET MARGIN TO 0 //15.03.2008 18:28 // ENDIF // IF cLPT = "LPT1" // EJECT // lSeiteleer := .F. // ENDIF // SET DEVICE TO SCREEN // ENDDO HTML_Brief("c:\hdbe\anschrei.ben",,"Courier New, monospace", "11pt", "1cm 1cm 1cm 2cm") ENDIF //15.07.2008 08:26//////////////////////////////////////////////////////////////////////////////// /* 03.07.2008 11:38 Ausdruck der Ratenzahlungsvereinbahrung mit KSO (Konto1) */ IF ValType(nAnz4)=="N" .AND. nAnz4 > 0 .AND. cKonto == "1" //03.07.2008 11:38 /* >>>>> noch zu kl„ren (04.07.2008 18:09): Tabellen und viel zu lange Var/Fkt-Namen */ //* 15.07.2008 08:02 Variablen aufbauen: $aa - also nur mit 3 Zeichen, $AA fr Dezimalzahlen/EUR-Betr„ge //* innerhalb <>-spitzer Klammern stehen , <-Bemerkungen-> /* Ratenberechnung: */ /* Variablen-Namen: entweder Feldvariablen der aktuellen WorkArea oder bei "N" mit LenDec am Ende, z.B. 62 "N"-Variable mssen im Text in Klammern stehen: $(nRate62) */ /* aus ... n1Rate62:= nRate62 := 0 nBeGe62 := Round( endbetr * 0.05, 2 ) nRSum62 := Raten( endbetr, nBeGe62, @n1Rate62, @nRate62 ) /* wird: */ d := DATE() // Tagesdatum in eine einbuchstabige Variable verpacken //* d00 ist heute - d08, d21 sind 8 bzw. 21 Tage sp„ter als heute (=Zahlungstermine) FF := 0.05 //* Finanzierungskosten-Faktor RS := R1 := RA := BG := 0 //* Variablen initialisieren BG := Round( endbetr * FF, 2 ) //* externe Functions ... RS := Raten( endbetr, BG, @R1, @RA ) //* ... um den Text nicht zu berfrachen ////// select 9 ////// use mwstdat ////// cDFile4 := IIf(IsFieldVar("dfile4"),Trim(mwstdat->dfile4),"") // z.B. ratenant.txt ////// USE //+26.06.2018 09:05 statt Vorzeilen: cDFile4 := "ratenant.txt" SELECT 1 IF Upper(Right(cDFile4,4))$".TXT" Set( _SET_DEVICE, "PRINTER" ) // damit PRINTW umgangen wird: schreiben in eine Datei cPrintFile := Set( _SET_PRINTFILE, "c:\hdbe\ratenant.rag" ) // 22.10.2005 cAnr := Trim(" ") IF Trim(1->ansp_anr) = "Herr" cAnr := "r" ENDIF @ 07,0 say 1->ansp_anr @ 08,0 say trim(1->ansp_vname) + " " + 1->ansp_name @ 09,0 say 1->ansp_str @ 11,0 say 1->ansp_ort /* erstmal nur von der Zentrale aus ? */ // DO CASE // CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "2" // @ 17,47 say "45144 Essen, " + DtoC(DATE()) // CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "3" ; // .OR. Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "4" // @ 17,44 say "47178 Duisburg, " + DtoC(DATE()) // CASE Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "5" ; // .OR. Substr( Str( 1->auftrnr,6,0 ), 3, 1 ) = "6" // @ 17,39 say "45899 Gelsenkirchen, " + DtoC(DATE()) // OTHERWISE @ 17,42 say "46117 Oberhausen, " + dtoc(date()) // ENDCASE @ 21,0 say "Bestattung: "+Trim(1->anrede)+" "+Trim(1->vorname)+ " "+Trim(1->name) @ 24,0 say "Sehr geehrte"+cAnr+" "+Trim(1->ansp_anr)+" "+Trim(1->ansp_name)+"," cRatenTx := ConvToOEMCP(MemoRead(cDatver + cDFile4)) //04.05.2008 18:34 Ansi cRatenTx := VariErsatz( cRatenTx ) /*03.07.2008 17:33 am Ende von BlattDrG */ FOR i := 1 TO MlCount( cRatenTx ) @ i+25,0 SAY MemoLine( cRatenTx,75, i ) NEXT Set( _SET_PRINTFILE, cPrintFile ) // 22.10.2005 Set( _SET_DEVICE, "SCREEN" ) // weil Ausdruck in File umgeleitet war //* Editieren des Textes: cString := ModalDialog( "c:\hdbe\ratenant.rag", ; "Ratenantrag - Anschreiben:", oDlg1, Int(700*nV), Int(400*nV), {"",""}, "11.Courier New" ) //05.03.2008 13:04 DO WHILE nAnz4-- > 0 SET DEVICE TO PRINTW aFonts := { "11.COURIER NEW" } FOR i := 1 TO MlCount( cString ) @ i,nSpaAnf SAY MemoLine( cString,90, i ) NEXT aFonts := {} /* 03.07.2008 16:08 ist ja automatisch auf LPTA */ // IF cLPT = "LPT1" // EJECT // lSeiteleer := .F. // ENDIF SET DEVICE TO SCREEN ENDDO ENDIF ENDIF /**/ //**07.03.2008 18:01 Ausdruck des Antrags auf Ratenzahlungsvereinbahrung IF ValType(nAnz4)=="N" DO WHILE nAnz4-- > 0 .AND. (cKonto == "0" .OR. cKonto == "2") //16.03.2008 11:12 ////// select 9 ////// use mwstdat ////// cDFile4 := IIf(IsFieldVar("dfile4"),Trim(mwstdat->dfile4),"") // z.B. Adelta.jpg ////// USE //+26.06.2018 09:05 statt Vorzeilen: cDFile4 := "Adelta.jpg" SELECT 1 IF Upper(Right(cDFile4,4))$".BMP.JPG" BitmapDr(cDatver + cDFile4) ENDIF ENDDO ENDIF //** /* hier w„re jetzt noch Platz zum Ausdruck von aPrompt[6]/cDFile5 */ //SET DEVICE TO SCREEN IF cNeu != "j" nAnzum := 1 nAnzum := Val( ModalDialog( LTrim(Str(nAnzum,2,0)), ; "Anzahl der Umschl„ge (1/0) eingeben:", oDlg1, 200*nV, 150*nV, {"",""} )) cUm := IIf( nAnzum == 1 .OR. nAnzum == -1, IIf( nAnzum == -1, "k", "j"), "n" ) ENDIF //READ cUm := Lower(cUm) //+23.10.2018 10:25 IF cUm ="j" .or. cUm = "k" SELECT 9 use mwstdat nZnam := Val( Substr( 9->f13,1,2 ) ) nSnam := Val( Substr( 9->f13,4,2 ) ) nZadr := Val( Substr( 9->f14,1,2 ) ) nSadr := Val( Substr( 9->f14,4,2 ) ) use nZadr := IIf( cUm="k", nZadr-8, nZadr ) SELECT 1 nOrientierung := XBPPRN_ORIENT_LANDSCAPE // 27.10.2005 SET DEVICE TO printw IF cLPT = "LPTA" // oPrinterPS:DEVICE():setOrientation( XBPPRN_ORIENT_LANDSCAPE ) //Papier horizontal bedrucken //// oPrinterPS:DEVICE():setupDialog() // nur zum Testen !! // oPrinterPS:DEVICE():startdoc() // 26.10.2005 geremt fr Essen ELSE @ 0,0 say IIf(cDrucker=="HP",chr(27)+znorm+" "+chr(27)+"&l1O",) ENDIF @ nZadr,nSadr say ansp_anr @ ++nZadr,nSadr say trim(ansp_vname) + " " + ansp_name @ ++nZadr,nSadr say ansp_str @ ++nZadr,(nSadr-40) say name @ ++nZadr,nSadr say ansp_ort IF cLPT = "LPTA" // oPrinterPS:DEVICE():setOrientation( XBPPRN_ORIENT_PORTRAIT ) //Papier vertikal bedrucken ELSE @ ++nZadr,0 say IIf(cDrucker=="HP",chr(27)+"&l0O",) ENDIF IF cLPT = "LPT1" EJECT ENDIF nOrientierung := XBPPRN_ORIENT_PORTRAIT // 27.10.2005 SET DEVICE TO SCREEN ENDIF SELECT &nOldArea DbGoto(nRec) //+11.10.2018 14:21 cLPT := cDummyL //04.02.2008 12:50 RETURN ////////////////////////////////////////////////////////////////////////////////////////////////// //* externe Functions, damit der Text nicht zu lang wird: // FF := 0.05 //* Finanzierungskosten-Faktor // RS := R1 := RA := BG := 0 //* Variablen initialisieren // BG := Round( endbetr * FF, 2 ) //* externe Functions ... // RS := Raten( endbetr, BG, @R1, @RA ) //* ... um den Text nicht zu berfrachen /* Berechnet die 6 Raten aus dem Endbetrag und der Bearbeitungsgebhr nRate1, nRate mssen per Referenz bergeben werden */ FUNCTION Raten( nEB, nBG, nRate1, nRate ) DEFAULT nBG TO 0 nRate := Round( nEB / 6, 0 ) // die Rate2 bis Rate5 sind gleich nRate1 := nEB - nRate * 5 // die Rate1 enth„lt die beim Teilen entstehenden Centbetr„ge RETURN nEB + nBG // Rechnungsendbetrag + Bearbeitungsgebhr //+09.10.2018 21:19 macht das vor dem Drucken, was sonst erst vor dem Speichern in auftr.dbf gemacht wird: FUNCTION AbrechZeilenKorrektur(cAuf) LOCAL nOldArea := SELECT() LOCAL nZeile := 0, nRec := RecNo() DbSuspendNotifications() IF ConfirmBox( oCB, "Soll die Abrechnung geprft und korrigiert werden?" + CRLF +; "(Zeilen ohne Artikelnr oder Artikelbezeichnung l”schen.)", ; "Abrechnungs-Zeilen Checken", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_NO DbResumeNotifications() RETURN .F. ENDIF SELECT 13 // DELETE ALL FOR 13->auftrnr <> Val( cAuf ) .OR. ( Empty(13->zugr_z_st) .AND. Empty(13->bezeichf1)) //+14.10.2018 13:43 statt der Vorzeile folgende Schleife: // hier wird die Temp-Datei von leeren und falschen Zeilen befreit (siehe auch BregieR5L.prg) *** DbGotop() DO WHILE !Eof() IF 13->auftrnr <> Val( cAuf ) .AND. ( !Empty(13->zugr_z_st) .AND. !Empty(13->bezeichf1)) IF ConfirmBox( oCB, "Zeile erg„nzen+behalten=ja - Zeile l”schen=nein", ; "Zeile "+13->zeile+" hat noch keine Auftragsnummer!", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES 13->auftrnr := Val(cAuf) ELSE DbDelete() ENDIF ELSEIF 13->auftrnr == Val( cAuf ) .AND. (Empty(13->zugr_z_st) .OR. Empty(13->bezeichf1)) IF ConfirmBox( oCB, "Zeile behalten=ja - Zeile l”schen=nein", ; "Zeile "+13->zeile+": Artikelnr oder -bezeichnung ist leer!", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES 13->auftrnr := Val(cAuf) // vorsichtshalber ... ELSE DbDelete() ENDIF ELSEIF 13->auftrnr <> Val( cAuf ) DbDelete() // der Rest: keine/falsche Auftragsnummer und leere Zeilen ENDIF DbSkip() ENDDO // bis hier geht die neue DELETE-Routine vom 14.10.2018 PACK IF .NOT. Bof() GO TOP ENDIF DO WHILE .NOT. Eof() ++nZeile REPLACE 13->zeile WITH Str( nZeile,2,0 ) DbSkip() ENDDO DO WHILE Recno() < 20 APPEND BLANK ENDDO SELECT &nOldArea DbCommit() DbResumeNotifications() DbGotop() DbGoto(nRec) RETURN .T.