Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : FDIEXAM.ZIP
Filename : MERGE.PRG

* Merge.Prg ... Mailmerge letter.dbf with the rolodisk.dbf
* Called from ... Rep_Menu.Prg
* Written by ... Paul Fischer
* Last Update ... 14:24:07 2/10/1989

DO box WITH 7,10,10,60,[Merge RoloDisk with a form letter]
mfield = [key]

SELE 0
DO chkfield && prc.prg - open database - allowable macros

SELE 0
DO rolodisk && prc.prg - open database

SELE 0
DO code && prc.prg - open database

DO co_selec && co_selec.prg - select codes
DO ro_selec && ro_selec.prg - select rolodisk records

@ 23,0 SAY REPL([Í],79)
@ 24,0
mletter = [Letter.Txt ]
DO WHIL .T.
@ 24,0 SAY 'Name of letter file, leave blank to write, ESC to quit: ' GET mletter PICT '@!K'
READ
ESCBREAK() && fdi89 - std_prc

IF EMPTY(mletter) && no form letter called - let them write letter
DO writelet && writelet.prg
mletter = [Memo.Txt] && output file from writelet.prg
EXIT
ENDIF

IF FILE(TRIM(mletter)) && check that file exists
EXIT
ELSE
DO kbhit WITH "That file is nowhere to be found! Any key continues..."
LOOP
ENDIF
ENDDO

DO yes_no WITH [Want a pause between pages? (Y/N) ] && fdi89 - std_prc
mpause = myn = [Y] && myn is return variable from yes_no

DO openit WITH [PS] && fdi89 - std_prc - printer or screen?

SELE 0
USE letter && use database structure
ZAP
APPE FROM &mletter SDF && append from chosen form letter

SELE rolodisk
SET RELA TO code INTO code
IF EMPTY(mstart) && position in rolodisk
GO TOP
ELSE
SEEK TRIM(mstart)
ENDIF

DO WHIL ! EOF() .AND. ESCBREAK()
IF code->(EMPTY(APICKED(apicks))) && not a code thay selected in picks
SKIP
LOOP
ENDIF

IF ! EMPTY(mstop) .AND. (&mfield > mstop .OR. ! EOF())
EXIT && past the last requested record.
ENDIF

DO let_form WITH 8 && procedure below, 8 = left margin
IF mpause && pause between letters ?
DO kbhit
ENDIF
@ 1,0
SELE rolodisk
SKIP
ENDDO *** Loop thru RoloDisk

* clean-up:
DO closeit
CLOSE DATA

RETURN
*** EOF ***

PROC let_form
PARA left_margin
* assumes LETTER.DBF has one record for each line of the letter
left_over=[]
SELE letter
GO TOP
DO WHIL ! EOF() .AND. ESCBREAK()
IF '~' $ line && there must be a macro in there somewhere.
mline = line
mprint = ''
DO WHILE '~' $ mline .AND. ESCBREAK()
mstart = AT('~', mline) + 1
mlength = AT('~',SUBS(mline,mstart+1))
mfield = SUBS(mline,mstart,mlength)
CHKF([&mfield]) && function below
IF mquit && macro not found in chkfield.dbf
mquit = .F.
RETU
ENDIF
mvar = chkfield->fname
SELE rolodisk
mval = TRIM(SUBS(CVAL(&mvar),1,AT([:],CVAL(&mvar))-1)) && cval - fdi89 - errorsys
mprint = mprint + SUBS(mline,1,mstart-2) + mval
SELE letter
mline = SUBS(mline,mstart + mlength + 1)
ENDDO
mprint = TRIM(mprint) +TRIM(mline) && continually build line
IF ! EMPTY(mprint)
@ PROW(),0 SAY MLINE(mprint) && func below - does word wrapping
ENDIF
ELSE ** no macros in the line
@ PROW(),0 SAY MLINE(TRIM(line))
ENDIF
@ PROW()+1,0
SKIP
ENDDO *** Loop thru lines of letter
SELE rolodisk
RETURN

FUNC dollars && transform of dollars
PARAM xval
xstring = [$] + LTRIM(TRANS(xval,[999,999,999.99]))
RETURN (xstring)


FUNC chkf && check for macro value in chkfield.dbf
PARA mfield
PRIV mtf
SELE chkfield
LOCA FOR UPPER(TRIM(macro)) = UPPER(TRIM([&mfield])) && very small database - all in buffer
IF ! EOF()
mtf = .T.
ELSE
DO kbhit WITH [Macro &mfield is not allowed. Please fix template. Anykey ...]
mquit = .T.
mtf = .F.
ENDIF
RETU (mtf)

FUNC mline
PARA wrapline,right_mar
IF PCOUNT()<2
right_mar=70
ENDIF
wrapline = left_over + IIF(EMPTY(left_over),[],[ ])+wrapline+IIF(EMPTY(wrapline).AND.!EMPTY(left_over),CHR(10),[])
wrappos = WRAP(SUBS(wrapline+SPAC(right_mar),1,1+right_mar),right_mar)
mret = SPAC(left_margin)+SUBS(wrapline,1,wrappos)
IF ! EMPTY(mret)
left_over = TRIM(SUBS(wrapline,wrappos+1,(LEN(wrapline)-wrappos)))
ENDIF
RETU(mret)

FUNC wrap
PARA mstr,margin
DO WHIL SUBS(mstr,margin,1) # SPAC(1) .AND. margin > 0
margin = margin - 1
ENDDO
RETU(margin)