* File = EMailMrg.PRG.  Called from RptsMenu.PRG to export name/address data *
to EMailMrg.DBF for email-merge.

PRIVATE ;
 cDeleted,cDisplay,cEMM_Filter,cFilter,cFull_Name,;
 nExported,nLenBracketEmail,nLenRecipientField,nMaxLenFullname

cDeleted = SET("DELETED")

CLOSE ALL
SET STATUS ON

******************************************************************************
IF YesNo("Specify a filter for email-merge export?")

   cEMM_Filter = ExpoFilt()
   
   IF EMPTY(cEMM_Filter)
      IF YesNo("Exit? (Y/N)")
         CLOSE ALL
         SET STATUS OFF
         RETURN
      ENDIF
   
      CLEAR
   ENDIF
ELSE
   cEMM_Filter = ""
ENDIF

******************************************************************************
USE EMailMrg
ZAP

SELECT 0
* Open Mpeople with ZIP CODE index (helps user verify proper geographic
* definition of filter):
=MPeoOpen("Country")

IF EMPTY(cEMM_Filter)
   SET FILTER TO ;
    (!DeleteFlag) AND (RECNO() > 1) AND !EMPTY(EMail)
ELSE
   SET FILTER TO ;
    (!DeleteFlag) AND (RECNO() > 1) AND !EMPTY(EMail) AND ;
    (&cEMM_Filter)
   DO EMM_Init
ENDIF

******************************************************************************
cFilter = SET("FILTER", 1)
COUNT TO nExported
&&   =AlertFP(;
&&      "Before duplicate email addresses are elminated, there are " + ;
&&      LTRIMSTR(nExported+2) + " names under the filter " + ;
&&      cFilter + ".", "Nonunique Names for Email-Merge Export")

=AlertFP(;
   "Exporting " + ;
   LTRIMSTR(nExported+2) + " names under the filter " + ;
   cFilter + ".", "Names Exported for Email-Merge")

******************************************************************************
SET DELETED ON
GOTO TOP
DO WHILE (.NOT. EOF())

   SELECT EMailMrg
   APPEND BLANK

   IF EMPTY(Mpeople.First_Name)
      REPLACE Dear_Name WITH FirstNameFix(Mpeople.Surname)
   ELSE
      REPLACE Dear_Name WITH FirstNameFix(Mpeople.First_Name)
   ENDIF

   REPLACE ;
      Serial     WITH RECNO(), ;
      Title      WITH MPeople.Title, ;
      WorkPhone  WITH FormatPhoneNumber(MPeople.Workacodec, ;
                                        MPeople.Workphonec, ;
                                        MPeople.Extension), ;
      Organizatn WITH ALLTRIM(Mpeople.Organizatn), ;
      HomePhone  WITH FormatPhoneNumber(MPeople.Homeacodec, ;
                                        MPeople.Homephonec), ;
      City       WITH MPeople.City, ;
      State      WITH MPeople.State, ;
      ZIP3       WITH LEFT(MPeople.ZIPc, 3), ;
      Country    WITH MPeople.Country

   IF !MPeople.Moved_NFA
      REPLACE ;
         Address1   WITH CC(ALLTRIM(Mpeople.Address1), ", ", ;
                            ALLTRIM(Mpeople.Address2)), ;
         Address2   WITH CC(;
                     CC(Mpeople.City, ", ", Mpeople.State), " ", Mpeople.ZIPc),;
   ENDIF

   * Use email field format "John Doe <jdoe@s.com>" to fit inside field
   cFull_Name = ;
      CC(Mpeople.Prefix, " ", CC(Mpeople.First_Name, " ", Mpeople.Surname))

   nLenBracketEmail   = 3 + LEN(TRIM(MPeople.EMail)) && LEN(" <jdoe@s.com>")
   nLenRecipientField = LEN(EMailMrg.Recipient)
   nMaxLenFullname    = nLenRecipientField - nLenBracketEmail

   REPLACE Recipient WITH TRIM(LEFT(cFull_Name, nMaxLenFullname)) + ;
                      " <" + TRIM(MPeople.EMail) + ">"

   SELECT Mpeople
   SKIP
ENDDO && (.NOT. EOF())

*cDisplay = SET("DISPLAY")
*SET DISPLAY TO VGA50

SELECT EMailMrg
GO TOP
IF (RECCOUNT() < 1000)
   DO BROWSE
ELSE
   DO MaxiWind
   BROWSE WIDTH 18
ENDIF

CLOSE ALL

* SET DISPLAY TO &cDisplay
SET DELETED &cDeleted
SET STATUS  OFF

*******************************************************************  FillField
FUNCTION FillField

PARAMETERS cFieldName,pcMessage

PRIVATE cMessage

IF (PARAMETERS() < 1)
   =AlertFP("No parameters passed to UDF " + PROGRAM() + ".", "ERROR")
   RETURN .F.
ENDIF

IF (PARAMETERS() < 2)
   cMessage = ""
ELSE
   cMessage = pcMessage
ENDIF

RETURN PADC(cMessage, LEN(&cFieldName), "X")
*******************************************************************  FillField

*******************************************************************  FirstNameFix
FUNCTION FirstNameFix

PARAMETERS pcName

PRIVATE cFixedName,cName,cName2,nPeriods
cName    = ALLTRIM(pcName) + " "
nPeriods = OCCURS(".", cName)

DO CASE
CASE !EMPTY(MPeople.Nickname)
   cFixedName = ALLTRIM(MPeople.Nickname)

CASE EMPTY(cName)
   =AlertFP("DATA ERROR", "No name for this record.")
   SELECT MPeople
   EDIT
   SELECT EMailMrg

   cFixedName = "DATA ERROR: MISSING NAME"

CASE (" and " $ lower(cName)) OR ("&" $ cName)
   cFixedName = "Friends"

CASE (nPeriods = 1)  && cName = "B. John" or "John B." or "B."
   nBlankPos  = AT(" ", cName)
   DO CASE
   CASE (nBlankPos < 3)
      cFixedName = "DATA ERROR: MISSING NAME"
      =AlertFP("DATA ERROR", "Name consists of " + m.pcName + " only.")

   CASE (nBlankPos = 3)
      cFixedName = TRIM(SUBSTR(cName, 4))      && cName = "B. John"
      IF EMPTY(cFixedName)
         cFixedName = TRIM(cName)              && cName = "B."
      ENDIF

   OTHERWISE
      cFixedName = LEFT(cName, nBlankPos - 1)  && cName = "John B."
   ENDCASE

CASE (nPeriods > 1)  && Two-initial names such as "B. J."
   cFixedName = TRIM(cName)

OTHERWISE
   cFixedName = TRIM(cName)
ENDCASE

RETURN cFixedName
*******************************************************************  FirstNameFix

******************************************************************  EMM_Init
PROCEDURE EMM_Init

PRIVATE cKey,cOrder

cOrder = SET("Order")
SET ORDER TO EMAIL

cKey = PADR("RAINBOW@REVRAINBOW.ORG", LEN(MPeople.Email))
IF SEEK(cKey)
   =AlertFP("The Rainbow Johnson record is included in the filter and will be found in the 787 ZIP code records in ZIP code order.", "INFORMATION FOR YOU")
ELSE
   SELECT EMailMrg
   APPEND BLANK
   REPLACE ;
      Serial     WITH 1, ;
      Dear_Name  WITH "Bard of the Seventh Tribe", ;
      Recipient  WITH "Mr. David Millican <dmill@attglobal.net>", ;
      Organizatn WITH "Worldsongs Peace Project", ;
      HomePhone  WITH "<data not shown on Web for privacy reasons>", ;
      Address1   WITH "<data not shown on Web for privacy reasons>", ;
      Address2   WITH "Austin, TX 78722-2237", ;
      State      WITH "TX", ;
      ZIP3       WITH "787", ;
      Country    WITH "U.S.A."

   APPEND BLANK
   REPLACE ;
      Serial     WITH 2, ;
      Dear_Name  WITH "Unorthodox Jewess", ;
      Recipient  WITH "Rev. Dr. Rainbow Johnson <rainbow@revrainbow.org>", ;
      Workphone  WITH "(800) 272-5413 x001", ;
      Organizatn WITH "Rainbow Ministries", ;
      HomePhone  WITH "<data not shown on Web for privacy reasons>", ;
      Address1   WITH "<data not shown on Web for privacy reasons>", ;
      Address2   WITH "Austin, TX 78722-2237", ;
      State      WITH "TX", ;
      ZIP3       WITH "787", ;
      Country    WITH "U.S.A."

   SELECT MPeople
ENDIF

SET ORDER TO &cOrder

RETURN
******************************************************************  EMM_Init

*********************************************************  FormatPhoneNumber
FUNCTION FormatPhoneNumber

PARAMETERS cAreaCode,cPhone,cExtension

PRIVATE cFormattedPhoneNumber

IF EMPTY(cPhone) OR (ALLTRIM(cPhone) == "-")
   cFormattedPhoneNumber = ""
ELSE
   cFormattedPhoneNumber = TRANSFORM(cPhone, "999-9999")
   IF !EMPTY(cAreaCode)
      cFormattedPhoneNumber = "(" + cAreaCode + ") " + cFormattedPhoneNumber
   ENDIF
   
   IF (PARAMETERS() = 3)
      IF !EMPTY(cExtension)
         cFormattedPhoneNumber = CC(cFormattedPhoneNumber, " x", cExtension)
      ENDIF
   ENDIF
ENDIF
RETURN cFormattedPhoneNumber
*********************************************************  FormatPhoneNumber

* End of EMailMrg.PRG.