#include "xbpdev.ch" PROCEDURE DRFIRMA( cAuf ) *drrente //+28.07.2010 21:58 vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //+ damit die Parameter gesetzt sind - auch fr diesen Spezialdruck LOCAL nOldArea := SELECT() select 20 use drubef if 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 SELECT &nOldArea //+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ anz=1 sch1=1 antw=" " schlver=" " IF cAuf == NIL schdat="1000100" ENDIF do datei do while .T. auf=IIf( cAuf == NIL, " ", cAuf ) clear do bild @ 2,2 say " " @ 2,9 say "Drucken Firmenanschreiben" @ 3,50 say date() @ 3,65 say time() do while val(auf)<1 .or. val(auf)>999999 zei=6 do while .t. @ zei,1 say space(70) zei=zei+1 if zei>23 exit endif enddo @ 6,19 say "Bitte Auftr-Nr eingeben : " get auf @ 8,15 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" @ 9,15 say "³ F10-Taste = zurck zur šbersicht ³" @10,15 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" read select 1 nr=" " nr=auf if nr="h10" .or. nr="H10" @ 5,0 clear @ 4,0 say "È" @ 4,79 say "¼" do h10 wait " Weiter mit ENTER ..." endif if nr="h " .or. nr="H " @ 5,0 clear @ 4,0 say "È" @ 4,79 say "¼" do h wait " Weiter mit ENTER ..." endif if auf="!" IF cAuf == NIL clear all ELSE SELECT 1 ENDIF clear return endif enddo select 1 find &auf if eof() @ 12,19 say "Auftrags-Nr nicht vorhanden" wait " Weiter mit ENTER ..." auf=" " loop endif clear @ 1,5 say "Bestattung: "+trim(anrede)+" "+trim(vorname)+" "+name @ 2,5 say "Best-Datum: " @ 2,18 say beerd_dat do while .t. @ 4,5 say "Bitte Adresskennzeichen eingeben :" get schlver read select 5 if schlver=space(5) loop endif schlver=upper(schlver) find &schlver if eof() zname1=space(30) zname2=space(30) zstrasse=space(30) zplz_ort=space(30) ELSE zname1=name1 zname2=name2 zstrasse=strasse zplz_ort=plz_ort endif select 1 a1="Sterbefall: "+trim(anrede)+" "+trim(vorname)+" "+trim(name)+space(5) a2=" " a3=" " a4="Sehr geehrte Damen und Herren, " a5="im oben angefhrten Sterbefall bersende ich Ihnen eine " a6="Sterbeurkunde nebst beigefgten Anlagen und bitte um ent- " a7="sprechende Veranlassung. " a8="Bitte teilen Sie unserem Auftraggeber mit, ob Ansprche " a9="auf Sterbe- oder Hinterbliebenenversorgung bestehen. " a10="Anlage: Sterbeurkunde " a11=" " a12=" " @ 6,5 say "Name 1 : " get zname1 @ 7,5 say "Name 2 : " get zname2 @ 8,5 say "Straáe : " get zstrasse @ 9,5 say "PLZ/Ort : " get zplz_ort @10,5 get a1 @11,5 get a2 @12,5 get a3 @13,5 get a4 @14,5 get a5 @15,5 get a6 @16,5 get a7 @17,5 get a8 @18,5 get a9 @19,5 get a10 @20,5 get a11 @21,5 get a12 read @ 23,5 say "Alle Eingabe O.K. (j/n/a)? " get antw read antw=upper(antw) if antw="J".or.antw="A" EXIT ELSE loop endif enddo if antw="A" clear IF cAuf == NIL clear all ELSE SELECT 1 ENDIF return endif @ 24,5 say "Wie oft soll der Brief gedruckt werden ? "get anz read do while .t. if anz=0 exit endif anz=anz-1 clear select 1 find &auf *******do drabr1 set device to printW // 22.10.2005 zae=08 @ zae,8 say zname1 if zname2#space(30) zae=zae+1 @ zae,8 say zname2 endif zae=zae+1 @ zae,8 say zstrasse zae=zae+2 @ zae,8 say zplz_ort @ 12,65 say date() @ 20,8 say a1 @ 21,8 say a2 @ 22,8 say a3 @ 26,8 say a4 @ 28,8 say a5 @ 29,8 say a6 @ 30,8 say a7 @ 31,8 say a8 @ 32,8 say a9 @ 34,8 say "Mit freundlichen Gráen" @ 37,8 say "Beerdigungs-Institut" @ 38,8 say "Karl Schumacher" @ 45,8 say "Auftraggeber: "+ansp_bez @ 46,8 say " "+ansp_anr @ 47,8 say " "+trim(ansp_vname)+" "+ansp_name @ 48,8 say " "+ansp_str @ 49,8 say " "+ansp_ort @ 50,8 say " "+"Tel: "+ansp_telp IF cLPT = "LPT1" eject lSeiteleer := .F. ELSE set device to screen ENDIF enddo set device to screen cUm := "j" @ 24,5 say space(60) @ 24,5 say "Umschlag eingelegt ? j/n (/k)" get cUm READ 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 // 22.10.2005 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)+"&l1O",) ENDIF @ 0,0 say chr(27)+"&l1O" @ nZadr,nSadr say zname1 IF zname2<>" " @ ++nZadr,nSadr say zname2 ENDIF @ ++nZadr,nSadr say zstrasse @ ++nZadr,(nSadr-40) say name @ ++nZadr,nSadr say zplz_ort IF cLPT = "LPTA" // 22.10.2005 // oPrinterPS:DEVICE():setOrientation( XBPPRN_ORIENT_PORTRAIT ) //Papier vertikal bedrucken ELSE @ ++nZadr,0 say IIf(cDrucker=="HP",chr(27)+"&l0O",) ENDIF // @ ++nZadr,0 say chr(27)+"&l0O" //// EJECT IF cLPT = "LPT1" EJECT ENDIF nOrientierung := XBPPRN_ORIENT_PORTRAIT // 27.10.2005 SET DEVICE TO SCREEN ENDIF clear //clear all SELECT 1 //28.04.2015 18:57: ################################################ // Vermerk im Notizfeld: cVermerk := "TFM: "+DtoC(DATE()) + ", " + Trim(zname1) + ", " + Trim(zname2) + ", " + Trim(zstrasse) + ", " + Trim(zplz_ort) + "." IF !cVermerk$1->notiz .AND. (anz>0 .OR. cUm$"jk") 1->(DbRlock()) 1->notiz += Chr(13)+Chr(10)+cVermerk 1->(DbCommit()) ENDIF //################################################################## return enddo RETURN