Hall of Fame/HallofFameCDROM.cdr/misc1/dprog12.lzh/MAIL.PRC

Text File | 1987-12-26 | 33.5 KB | 1,373 lines

PROCEDURE ST2
PARAMETERS Num2,Str2
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.ST2
*
*
* Module Description : Return a 1 or 2 digit number
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
IF Num2 < 10
   STORE STR(Num2,1) TO Str2
ELSE
   STORE STR(Num2,2) TO Str2
ENDIF



PROCEDURE IND
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.IND
*
*
* Module Description : Build Index if needed
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
IF .NOT. File("MAIL.NDX")
   @24,0 SAY SPACE(78)
   @24,0 SAY "Please wait, file is being Indexed"
   SELECT A
   USE MAIL
   INDEX ON LNAME+FNAME+MI TO MAIL
   @24,0 SAY SPACE(78)
ENDIF
USE MAIL INDEX MAIL
RETURN



PROCEDURE FMT
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.FMT
*
*
* Module Description : Screen Format file
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
@4,12 GET MA_FNAME PICTURE "!XXXXXXXXXXXXXXXXXXXX"
@4,26 GET MA_MI PICTURE "!"
@4,28 GET MA_LNAME PICTURE "!XXXXXXXXXXXXXXXXXXXXXX"
@5,12 GET MA_F_16
@6,12 GET MA_ADD1
@7,12 GET MA_ADD2
@8,12 GET MA_CITY
@8,34 GET MA_STATE PICTURE "!!"
@8,37 GET MA_ZIPCODE PICTURE "#####"
@9,12 GET MA_PHONE PICTURE "(###)999-9999"
@10,12 GET MA_COMPANY
@15,7 GET MA_SW1 PICTURE "Y"
@15,23 GET MA_SW2 PICTURE "Y"
@15,39 GET MA_SW3 PICTURE "Y"
@15,55 GET MA_SW4 PICTURE "Y"
@15,71 GET MA_SW5 PICTURE "Y"
RETURN



PROCEDURE PUB
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.PUB
*
*
* Module Description : Define Public Fields
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
PUBLIC MA_FNAME
PUBLIC MA_MI
PUBLIC MA_LNAME
PUBLIC MA_F_16
PUBLIC MA_ADD1
PUBLIC MA_ADD2
PUBLIC MA_CITY
PUBLIC MA_STATE
PUBLIC MA_ZIPCODE
PUBLIC MA_PHONE
PUBLIC MA_COMPANY
PUBLIC MA_SW1
PUBLIC MA_SW2
PUBLIC MA_SW3
PUBLIC MA_SW4
PUBLIC MA_SW5
RETURN



PROCEDURE CAL
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.CAL
*
*
* Module Description : Calculate and display Calculated fields
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
RETURN



PROCEDURE INT
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.INT
*
*
* Module Description : Initialize memory fields from Init or empty
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE SPACE(13) TO MA_FNAME
STORE SPACE(1) TO MA_MI
STORE SPACE(14) TO MA_LNAME
STORE SPACE(30) TO MA_F_16
STORE SPACE(30) TO MA_ADD1
STORE SPACE(30) TO MA_ADD2
STORE SPACE(21) TO MA_CITY
STORE SPACE(2) TO MA_STATE
STORE SPACE(5) TO MA_ZIPCODE
STORE SPACE(14) TO MA_PHONE
STORE SPACE(30) TO MA_COMPANY
STORE .N. TO MA_SW1
STORE .N. TO MA_SW2
STORE .N. TO MA_SW3
STORE .N. TO MA_SW4
STORE .N. TO MA_SW5
RETURN



PROCEDURE STO
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.STO
*
*
* Module Description : Store file fields to memory variables
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE MAIL -> FNAME   TO MA_FNAME
STORE MAIL -> MI      TO MA_MI
STORE MAIL -> LNAME   TO MA_LNAME
STORE MAIL -> F_16    TO MA_F_16
STORE MAIL -> ADD1    TO MA_ADD1
STORE MAIL -> ADD2    TO MA_ADD2
STORE MAIL -> CITY    TO MA_CITY
STORE MAIL -> STATE   TO MA_STATE
STORE MAIL -> ZIPCODE TO MA_ZIPCODE
STORE MAIL -> PHONE   TO MA_PHONE
STORE MAIL -> COMPANY TO MA_COMPANY
STORE MAIL -> SW1     TO MA_SW1
STORE MAIL -> SW2     TO MA_SW2
STORE MAIL -> SW3     TO MA_SW3
STORE MAIL -> SW4     TO MA_SW4
STORE MAIL -> SW5     TO MA_SW5
RETURN



PROCEDURE REP
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.REP
*
*
* Module Description : Replace file fields to memory variables
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
REPLACE MAIL -> FNAME   WITH MA_FNAME
REPLACE MAIL -> MI      WITH MA_MI
REPLACE MAIL -> LNAME   WITH MA_LNAME
REPLACE MAIL -> F_16    WITH MA_F_16
REPLACE MAIL -> ADD1    WITH MA_ADD1
REPLACE MAIL -> ADD2    WITH MA_ADD2
REPLACE MAIL -> CITY    WITH MA_CITY
REPLACE MAIL -> STATE   WITH MA_STATE
REPLACE MAIL -> ZIPCODE WITH MA_ZIPCODE
REPLACE MAIL -> PHONE   WITH MA_PHONE
REPLACE MAIL -> COMPANY WITH MA_COMPANY
REPLACE MAIL -> SW1     WITH MA_SW1
REPLACE MAIL -> SW2     WITH MA_SW2
REPLACE MAIL -> SW3     WITH MA_SW3
REPLACE MAIL -> SW4     WITH MA_SW4
REPLACE MAIL -> SW5     WITH MA_SW5
RETURN



PROCEDURE REL
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.REL
*
*
* Module Description : Release Memory variables
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
RELEASE MA_FNAME
RELEASE MA_MI
RELEASE MA_LNAME
RELEASE MA_F_16
RELEASE MA_ADD1
RELEASE MA_ADD2
RELEASE MA_CITY
RELEASE MA_STATE
RELEASE MA_ZIPCODE
RELEASE MA_PHONE
RELEASE MA_COMPANY
RELEASE MA_SW1
RELEASE MA_SW2
RELEASE MA_SW3
RELEASE MA_SW4
RELEASE MA_SW5
RETURN



PROCEDURE ADD
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.ADD
*
*
* Module Description : Add New Records to file
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE " " TO MH_Wait
CALL MAIL
DO WHILE .T.
   DO INT
   DO FMT
   @24,0 SAY SPACE(78)
   @24,0 SAY "Press Ctrl End without entering data to exit"
   READ
   IF MA_FNAME   <> " "
      DO VAL
      @24,0 SAY SPACE(79)
      APPEND BLANK
      DO REP
      DO CAL
      @24,0 SAY "Press any key to continue"
      @24,30 GET MH_Wait
      READ
   ELSE
     EXIT
   ENDIF
ENDDO
RELEASE MH_Wait
RETURN



PROCEDURE UPD
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.UPD
*
*
* Module Description : Search,Update,Edit,Find,Print,Examine file
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE "N" TO MH_Function
STORE "N" TO MH_Answer
STORE SPACE(65) TO MH_Filt
STORE "Next" TO MH_LMenu1
STORE "Prev" TO MH_LMenu2
STORE "Top " TO MH_LMenu3
STORE "Bot " TO MH_LMenu4
STORE "Quit" TO MH_LMenu5
STORE "Edit" TO MH_LMenu6
STORE "Set " TO MH_LMenu7
STORE "List" TO MH_LMenu8
STORE "Find" TO MH_LMenu9
STORE "Help" TO MH_LMenu10
STORE "Del " TO MH_LMenu11
STORE 11 TO MH_Lopts
CALL MAIL
DO WHILE .T.
   DO STO
   DO DIS
   DO CAL
   IF LEN(TRIM(MH_Filt)) = 0
      @24,55 SAY "    "
   ELSE
      @24,55 SAY "FILT"
   ENDIF
   IF Deleted()
      @24,60 SAY "DEL"
   ELSE
      @24,60 SAY "   "
   ENDIF
   @24,65 SAY Ltrim(Str(RECNO()))+"/"+Ltrim(STR(RECCOUNT()))+"     "
   STORE 1 TO MH_Lcho
   @24,0 SAY SPACE(55)
   STORE 0 TO MH_Col
   STORE "1" TO MH_Sub
   @24,0 SAY "Next Prev Top  Bot  Quit Edit Set  List Find Help Del"
   STORE 1 TO MH_Lcho
   STORE "1" TO MH_Sub
   STORE 0 TO MH_Sel
   @24,(MH_Lcho-1)*5 GET MH_Lmenu1
   CLEAR GETS
   STORE " " TO MH_Function
   DO WHILE MH_Function = " "
      STORE 0 TO MH_Sel
      DO WHILE MH_Sel=0
         STORE INKEY() TO MH_Sel
      ENDDO
      IF MH_Sel = 32
         @24,(MH_Lcho-1)*5 SAY MH_Lmenu&MH_Sub
         IF MH_Sel=4 .OR. MH_Sel = 32
            STORE MH_Lcho+1 TO MH_Lcho
         ENDIF
         IF MH_Lcho> 11
            STORE 1 TO MH_Lcho
         ENDIF
         DO St2 WITH MH_Lcho,MH_Sub
         @24,(MH_Lcho-1)*5 GET MH_Lmenu&MH_Sub
         CLEAR GETS
         LOOP
      ENDIF
      STORE AT(UPPER(CHR(MH_Sel)),"NPTBQESLFHD") TO MH_Lcho1
      IF MH_Lcho1 # 0
         @24,0 SAY "Next Prev Top  Bot  Quit Edit Set  List Find Help Del"
         DO St2 WITH MH_Lcho1,MH_Sub
         STORE MH_Lcho1 TO MH_Lcho
         @24,(MH_Lcho-1)*5 GET MH_Lmenu&MH_Sub
         CLEAR GETS
         STORE UPPER(CHR(MH_Sel)) TO MH_Function
         EXIT
      ENDIF
      IF MH_Sel = 13
         DO St2 WITH MH_Lcho, MH_Sub
         STORE LEFT(MH_Lmenu&MH_Sub,1) TO MH_Function
      ENDIF
   ENDDO
   DO CASE
      CASE UPPER(MH_Function) = "N"
      IF .NOT. EOF()
          Skip 1
          IF EOF()
             Skip -1
           ENDIF
      ENDIF
      LOOP
      CASE UPPER(MH_Function) = "P"
      IF .NOT. BOF()
         SKIP -1
      ENDIF
      LOOP
      CASE UPPER(MH_Function) = "E"
         DO STO
         DO FMT
         READ
         DO VAL
         DO CAL
         DO REP
         LOOP
      CASE UPPER(MH_Function) = "T"
           GOTO TOP
           LOOP
      CASE UPPER(MH_Function) = "B"
           GOTO BOTTOM
           LOOP
      CASE UPPER(MH_Function) = "D"
         STORE "N" TO MH_Answer
         @24,0 SAY SPACE(78)
         IF  DELETED()
             @24,0 SAY "Recall this record?"
         ELSE
             @24,0 SAY "Delete this record?"
         ENDIF
         @24,22 GET MH_Answer
         READ
         IF UPPER(MH_Answer) = "Y"
            IF DELETED()
               RECALL
            ELSE
               DELETE
            ENDIF
         ENDIF
         LOOP
      CASE UPPER(MH_Function) = "S"
         STORE "N" TO MH_Answer
         STORE MH_Filt TO MH_FiltH
         @24,0 SAY SPACE(78)
         @24,0 SAY "FILTER: "
         @24,9 GET MH_Filt
         READ
         @24,0 SAY SPACE(78)
         IF MH_Filt <> MH_FiltH
            SET FILTER TO &MH_Filt
            GOTO TOP
            CLEAR
         CALL MAIL
         ENDIF
         IF EOF()
            @24,0 SAY "Nothing matches filter! Press any key to continue"
            @24,50 GET MH_Answer
            READ
         ENDIF
         LOOP
      CASE UPPER(MH_Function) = "F"
           DO FND
           LOOP
      CASE UPPER(MH_Function) = "Q"
           EXIT
      CASE UPPER(MH_Function) = "L"
           SET DEVICE TO PRINT
           DO DIS
           SET DEVICE TO SCREEN
           LOOP
      CASE UPPER(MH_Function)="H"
           DO HLP WITH 2
      CALL MAIL
           LOOP
      ENDCASE
   STORE "N" TO MH_Function
ENDDO
SET FILTER TO
RELEASE MH_Function,MH_Answer
RETURN



PROCEDURE DIS
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.DIS
*
*
* Module Description : Display only Format file
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
@4,12 SAY MA_FNAME PICTURE "!XXXXXXXXXXXXXXXXXXXX"
@4,26 SAY MA_MI PICTURE "!"
@4,28 SAY MA_LNAME PICTURE "!XXXXXXXXXXXXXXXXXXXXXX"
@5,12 SAY MA_F_16
@6,12 SAY MA_ADD1
@7,12 SAY MA_ADD2
@8,12 SAY MA_CITY
@8,34 SAY MA_STATE PICTURE "!!"
@8,37 SAY MA_ZIPCODE PICTURE "#####"
@9,12 SAY MA_PHONE PICTURE "(###)999-9999"
@10,12 SAY MA_COMPANY
@15,7 SAY MA_SW1 PICTURE "Y"
@15,23 SAY MA_SW2 PICTURE "Y"
@15,39 SAY MA_SW3 PICTURE "Y"
@15,55 SAY MA_SW4 PICTURE "Y"
@15,71 SAY MA_SW5 PICTURE "Y"
RETURN



PROCEDURE FND
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.FND
*
*
* Module Description : Find record by key function
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE " " TO MH_Find
STORE " " TO MH_Answer
STORE 0   TO MH_Rec
@4,12 GET MA_FNAME PICTURE "!XXXXXXXXXXXXXXXXXXXX"
@4,26 GET MA_MI PICTURE "!"
@4,28 GET MA_LNAME PICTURE "!XXXXXXXXXXXXXXXXXXXXXX"
@5,12 SAY MA_F_16
@6,12 SAY MA_ADD1
@7,12 SAY MA_ADD2
@8,12 SAY MA_CITY
@8,34 SAY MA_STATE PICTURE "!!"
@8,37 SAY MA_ZIPCODE PICTURE "#####"
@9,12 SAY MA_PHONE PICTURE "(###)999-9999"
@10,12 SAY MA_COMPANY
@15,7 SAY MA_SW1 PICTURE "Y"
@15,23 SAY MA_SW2 PICTURE "Y"
@15,39 SAY MA_SW3 PICTURE "Y"
@15,55 SAY MA_SW4 PICTURE "Y"
@15,71 SAY MA_SW5 PICTURE "Y"
@24,0 SAY SPACE(78)
@24,0 SAY "Enter data to find in open fields"
READ
IF LEN(TRIM(MA_LNAME+MA_FNAME+MA_MI)) # 0
   STORE MA_LNAME+MA_FNAME+MA_MI TO MH_Find
   STORE RECNO() TO MH_Rec
   FIND &MH_Find
   IF EOF()
      GOTO MH_Rec
      @24,0 SAY SPACE(78)
      @24,0 SAY "Record Not Found! Press any key to continue"
      @24,45 GET MH_Answer
      READ
   ENDIF
ENDIF
RELEASE MH_Find,MH_Answer,MH_Rec
@24,0 SAY SPACE(78)
RETURN



PROCEDURE RPT
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAILRPT
*
*
* Module Description : Report Module
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE .N. TO MH_Prt
STORE .Y. TO MH_Con
STORE .N. TO MH_Disk
STORE "        " TO MH_Frm
STORE ".T."+SPACE(73) TO MH_Cri
STORE "             " TO MH_DFname
CALL DPOUT
@5,22 SAY MH_Prt
@6,22 SAY MH_Con
@7,22 SAY MH_Disk
@7,42 SAY MH_DFname
@9,15 SAY MH_Frm
DO WHILE .T.
   @5,22 GET MH_Prt PICTURE "L"
   @6,22 GET MH_Con PICTURE "L"
   @7,22 GET MH_Disk PICTURE "L"
   @7,42 GET MH_Dfname PICTURE "!!!!!!!!!!!!!!"
   @9,15 GET MH_Frm PICTURE "!!!!!!!!"
   READ
   @24,0 SAY SPACE(78)
   IF MH_Prt .AND. MH_Con
      @24,0 SAY "You must only specify one output device"
      LOOP
   ENDIF
   IF MH_Prt .AND. MH_Disk
      @24,0 SAY "You must only specify one output device"
      LOOP
   ENDIF
   IF MH_Con .AND. MH_Disk
      @24,0 SAY "You must only specify one output device"
      LOOP
   ENDIF
   IF MH_Disk .AND. MH_Dfname = "          "
      @24,0 SAY "You must specify a disk file name"
      LOOP
   ENDIF
   IF MH_Frm = "        "
      @24,0 SAY "You must enter a sort name or 'NOSORT'"
      LOOP
   ENDIF
   EXIT
ENDDO
IF MH_Frm = "NOSORT  "
   STORE .F. TO MH_NdxL
   ELSE
   IF .NOT.(FILE("DPSORT.DBF") .AND. FILE("DPSORT.NDX"))
      @24,0 SAY SPACE(78)
      @24,0 SAY "DPSORT files not found"
      STORE " " TO MH_Ans
      @24,40 GET MH_Ans
      READ
      RETURN
   ENDIF
   SELE I
   USE DPSORT INDEX DPSORT
   SEEK MH_Frm
   IF EOF()
      @24,0 SAY SPACE(78)
      @24,0 SAY "Sort name not found on selection database (DPSORT.DBF)"
      STORE " " TO MH_Ans
      @24,40 GET MH_Ans
      READ
      SELE A
      RETURN
   ENDIF
   STORE SORTCRI TO MH_Cri
   STORE SORTNDX TO MH_NDX
   STORE SORTFRM TO MH_FRM
   STORE .F. TO MH_NdxL
   IF SORTF1 <> "       "
      STORE            SORTF1+"/"+SORTO1 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF2 <> "       "
      STORE MH_Srt+","+SORTF2+"/"+SORTO2 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF3 <> "       "
      STORE MH_Srt+","+SORTF3+"/"+SORTO3 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF4 <> "       "
      STORE MH_Srt+","+SORTF4+"/"+SORTO4 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF5 <> "       "
      STORE MH_Srt+","+SORTF5+"/"+SORTO5 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF6 <> "       "
      STORE MH_Srt+","+SORTF6+"/"+SORTO6 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF7 <> "       "
      STORE MH_Srt+","+SORTF7+"/"+SORTO7 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF8 <> "       "
      STORE MH_Srt+","+SORTF8+"/"+SORTO8 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF9 <> "       "
      STORE MH_Srt+","+SORTF9+"/"+SORTO9 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF10 <> "       "
      STORE MH_Srt+","+SORTF10+"/"+SORTO10 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   USE
ENDIF
@16,13 GET MH_Frm
@19,2  GET MH_Cri
READ
DO WHILE LEN(TRIM(MH_Frm)) = 0
   @24,0 SAY "You must specify a form for REPORTs and LABELS"
   @16,13 GET MH_Frm
   READ
ENDDO
SELE A
STORE TRIM(MH_Frm)+".FRM" TO MH_work
IF .NOT. FILE(MH_Work)
   @24,0 SAY SPACE(78)
   @24,0 SAY "REPORT FORM "+TRIM(MH_Frm)+"not found"
   STORE " " TO MH_Ans
   @24,40 GET MH_Ans
   READ
ENDIF
IF MH_NdxL
   @24,0 SAY SPACE(78)
   @24,0 SAY "SELECTING/SORTING DATA! PLEASE WAIT"
   SORT TO &MH_NDX ON &MH_SRT FOR &MH_Cri
   SELE J
   USE &MH_NDX
ELSE
    @24,0 SAY SPACE(78)
    @24,0 SAY "Using Unsorted File"
ENDIF
@24,0 SAY SPACE(78)
@24,0 SAY "PRODUCING OUTPUT. PLEASE WAIT"
DO CASE
   CASE MH_Con
       REPORT FORM &MH_Frm FOR &MH_Cri
   CASE MH_Prt
        SET CONSOLE OFF
        REPORT FORM &MH_Frm TO PRINT FOR &MH_Cri
        SET CONSOLE ON
   CASE MH_Disk
      SET CONSOLE OFF
      SET ALTERNATE TO &MH_Dfname FOR &MH_Cri
      SET ALTERNATE ON
      REPORT FORM &MH_Frm FOR &MH_Cri
      SET ALTERNATE OFF
      CLOSE ALTERNATE
      SET CONSOLE ON
ENDCASE
IF MH_NdxL
   USE
ENDIF
SELE A
RETURN



PROCEDURE LAB
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAILLAB
*
*
* Module Description : Label Module
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE .N. TO MH_Prt
STORE .Y. TO MH_Con
STORE .N. TO MH_Disk
STORE "        " TO MH_Frm
STORE ".T."+SPACE(73) TO MH_Cri
STORE "             " TO MH_DFname
CALL DPOUT
@5,22 SAY MH_Prt
@6,22 SAY MH_Con
@7,22 SAY MH_Disk
@7,42 SAY MH_DFname
@9,15 SAY MH_Frm
DO WHILE .T.
   @5,22 GET MH_Prt PICTURE "L"
   @6,22 GET MH_Con PICTURE "L"
   @7,22 GET MH_Disk PICTURE "L"
   @7,42 GET MH_Dfname PICTURE "!!!!!!!!!!!!!!"
   @9,15 GET MH_Frm PICTURE "!!!!!!!!"
   READ
   @24,0 SAY SPACE(78)
   IF MH_Prt .AND. MH_Con
      @24,0 SAY "You must only specify one output device"
      LOOP
   ENDIF
   IF MH_Prt .AND. MH_Disk
      @24,0 SAY "You must only specify one output device"
      LOOP
   ENDIF
   IF MH_Con .AND. MH_Disk
      @24,0 SAY "You must only specify one output device"
      LOOP
   ENDIF
   IF MH_Disk .AND. MH_Dfname = "          "
      @24,0 SAY "You must specify a disk file name"
      LOOP
   ENDIF
   IF MH_Frm = "        "
      @24,0 SAY "You must enter a sort name or 'NOSORT'"
      LOOP
   ENDIF
   EXIT
ENDDO
IF MH_Frm = "NOSORT  "
   STORE .F. TO MH_NdxL
   ELSE
   IF .NOT.(FILE("DPSORT.DBF") .AND. FILE("DPSORT.NDX"))
      @24,0 SAY SPACE(78)
      @24,0 SAY "DPSORT files not found"
      STORE " " TO MH_Ans
      @24,40 GET MH_Ans
      READ
      RETURN
   ENDIF
   SELE I
   USE DPSORT INDEX DPSORT
   SEEK MH_Frm
   IF EOF()
      @24,0 SAY SPACE(78)
      @24,0 SAY "Sort name not found on selection database (DPSORT.DBF)"
      STORE " " TO MH_Ans
      @24,40 GET MH_Ans
      READ
      SELE A
      RETURN
   ENDIF
   STORE SORTCRI TO MH_Cri
   STORE SORTNDX TO MH_NDX
   STORE SORTFRM TO MH_FRM
   STORE .F. TO MH_NdxL
   IF SORTF1 <> "       "
      STORE            SORTF1+"/"+SORTO1 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF2 <> "       "
      STORE MH_Srt+","+SORTF2+"/"+SORTO2 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF3 <> "       "
      STORE MH_Srt+","+SORTF3+"/"+SORTO3 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF4 <> "       "
      STORE MH_Srt+","+SORTF4+"/"+SORTO4 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF5 <> "       "
      STORE MH_Srt+","+SORTF5+"/"+SORTO5 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF6 <> "       "
      STORE MH_Srt+","+SORTF6+"/"+SORTO6 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF7 <> "       "
      STORE MH_Srt+","+SORTF7+"/"+SORTO7 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF8 <> "       "
      STORE MH_Srt+","+SORTF8+"/"+SORTO8 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF9 <> "       "
      STORE MH_Srt+","+SORTF9+"/"+SORTO9 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF10 <> "       "
      STORE MH_Srt+","+SORTF10+"/"+SORTO10 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   USE
ENDIF
@16,13 GET MH_Frm
@19,2  GET MH_Cri
READ
DO WHILE LEN(TRIM(MH_Frm)) = 0
   @24,0 SAY "You must specify a form for REPORTs and LABELS"
   @16,13 GET MH_Frm
   READ
ENDDO
SELE A
STORE TRIM(MH_Frm)+".LBL" TO MH_work
IF .NOT. FILE(MH_Work)
   @24,0 SAY SPACE(78)
   @24,0 SAY "LABEL FORM "+TRIM(MH_Frm)+"not found"
   STORE " " TO MH_Ans
   @24,40 GET MH_Ans
   READ
ENDIF
IF MH_NdxL
   @24,0 SAY SPACE(78)
   @24,0 SAY "SELECTING/SORTING DATA! PLEASE WAIT"
   SORT TO &MH_NDX ON &MH_SRT FOR &MH_Cri
   SELE J
   USE &MH_NDX
ELSE
    @24,0 SAY SPACE(78)
    @24,0 SAY "Using Unsorted File"
ENDIF
@24,0 SAY SPACE(78)
@24,0 SAY "PRODUCING OUTPUT. PLEASE WAIT"
DO CASE
   CASE MH_Con
       LABEL FORM &MH_Frm FOR &MH_Cri
   CASE MH_Prt
        SET CONSOLE OFF
        LABEL FORM &MH_Frm TO PRINT FOR &MH_Cri
        SET CONSOLE ON
   CASE MH_Disk
      SET CONSOLE OFF
      SET ALTERNATE TO &MH_Dfname FOR &MH_Cri
      SET ALTERNATE ON
      LABEL FORM &MH_Frm FOR &MH_Cri
      SET ALTERNATE OFF
      CLOSE ALTERNATE
      SET CONSOLE ON
ENDCASE
IF MH_NdxL
   USE
ENDIF
SELE A
RETURN



PROCEDURE MM
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.MM
*
*
* Module Description : Mail Merge Module
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
STORE .N. TO MH_Prt
STORE .N. TO MH_Con
STORE .Y. TO MH_Disk
STORE "MMWORK    " TO MH_DFname
STORE "        " TO MH_Frm
STORE "WORDSTAR" TO MH_WP
STORE ".T."+SPACE(73) TO MH_Cri
CALL DPOUT
@11,2 SAY "Word Processor:"
@7,22 SAY MH_Disk
@7,42 SAY MH_DFname
@9,15 SAY MH_Frm
@11,19 SAY MH_WP
DO WHILE .T.
   @7,42 GET MH_Dfname PICTURE "!!!!!!!!!!"
   @9,15 GET MH_Frm PICTURE "!!!!!!!!"
   @11,19 GET MH_WP PICTURE "!!!!!!!!"
   READ
   @24,0 SAY SPACE(78)
   IF MH_Disk .AND. MH_Dfname = "          "
      @24,0 SAY "You must enter a disk filename"
      LOOP
   ENDIF
   IF MH_Frm = "        "
      @24,0 SAY "You must enter a sort form or 'NOSORT'"
      LOOP
   ENDIF
   IF .NOT.(MH_WP = "WORDSTAR" .OR. MH_WP = "MSWORD  ")
      LOOP
   ENDIF
   EXIT
ENDDO
IF MH_Frm = "NOSORT  "
   STORE .F. TO MH_NdxL
   ELSE
   IF .NOT. (FILE("DPSORT.DBF") .AND. FILE("DPSORT.NDX"))
      @24,0 SAY SPACE(78)
      @24,0 SAY "DPSORT files not found"
      STORE " " TO MH_Ans
      @24,40 GET MH_Ans
      READ
      RETURN
   ENDIF
   SELE I
   USE DPSORT INDEX DPSORT
   SEEK MH_Frm
   IF EOF()
      @24,0 SAY SPACE(78)
      @24,0 SAY "Sort name not found on selection database (DPSORT.DBF)"
      STORE " " TO MH_Ans
      @24,40 GET MH_Ans
      READ
      USE
      SELE A
      RETURN
   ENDIF
   STORE SORTCRI TO MH_Cri
   STORE SORTNDX TO MH_NDX
   STORE .F. TO MH_NdxL
   IF SORTF1 <> "       "
      STORE            SORTF1+"/"+SORTO1 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF2 <> "       "
      STORE MH_Srt+","+SORTF2+"/"+SORTO2 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF3 <> "       "
      STORE MH_Srt+","+SORTF3+"/"+SORTO3 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF4 <> "       "
      STORE MH_Srt+","+SORTF4+"/"+SORTO4 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF5 <> "       "
      STORE MH_Srt+","+SORTF5+"/"+SORTO5 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF6 <> "       "
      STORE MH_Srt+","+SORTF6+"/"+SORTO6 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF7 <> "       "
      STORE MH_Srt+","+SORTF7+"/"+SORTO7 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF8 <> "       "
      STORE MH_Srt+","+SORTF8+"/"+SORTO8 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF9 <> "       "
      STORE MH_Srt+","+SORTF9+"/"+SORTO9 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
   IF SORTF10 <> "       "
      STORE MH_Srt+","+SORTF10+"/"+SORTO10 TO MH_SRT
      STORE .T. TO MH_NdxL
   ENDIF
USE
ENDIF
@19,2 GET MH_Cri
READ
SELE A
IF  MH_NdxL
   @24,0 SAY SPACE(78)
   @24,0 SAY "SELECTING/SORTING DATA! PLEASE WAIT"
   SORT TO &MH_NDX ON &MH_SRT FOR &MH_Cri
   SELE J
   USE &MH_NDX
ELSE
    @24,0 SAY SPACE(78)
    @24,0 SAY "Using Unsorted File"
ENDIF
@24,0 SAY SPACE(78)
@24,0 SAY "PRODUCING OUTPUT. PLEASE WAIT"
IF (.NOT. MH_NdxL) .AND. (LEN(TRIM(MH_Cri)) <> 0)
   LOCATE FOR &MH_Cri
ENDIF
IF EOF()
   @24,0 SAY SPACE(78)
   @24,0 SAY "No records meet criteria."
   STORE " " TO MH_Ans
   @24,40 GET MH_Ans
   READ
   SELE A
   RETURN
ENDIF
*
* Turn on output device
*
SET CONSOLE OFF
STORE TRIM(MH_Dfname)+".DOC" TO MH_Ofn
SET ALTERNATE TO &MH_Ofn
SET ALTERNATE ON
*
* Output field header
*
DO CASE
   CASE MH_WP = "WORDSTAR"
      ?".OP"
      ?".DF "+MH_DFNAME+".DAT"
      ?".RV FNAME,MI,LNAME,F_16,ADD1,ADD2,CITY,STATE,ZIPCODE,PHONE,COMPANY,SW1,SW2,SW3,SW4,SW5"
      ?
      SET ALTERNATE OFF
      CLOSE ALTERNATE
      STORE TRIM(MH_Dfname)+".DAT" TO MH_Ofn
      SET ALTERNATE TO &MH_Ofn
      SET ALTERNATE ON
   CASE MH_WP = "MSWORD  "
        ?"FNAME,MI,LNAME,F_16,ADD1,ADD2,CITY,STATE,ZIPCODE,PHONE,COMPANY,SW1,SW2,SW3,SW4,SW5"
ENDCASE
*
* Output Selected data
*
DO WHILE .NOT. EOF()
   DO CASE
      CASE (MH_WP = "WORDSTAR") .OR. (MH_WP = "MSWORD  ")
         ? ""
         ?? CHR(34)+TRIM(FNAME)+CHR(34)+","
         ?? CHR(34)+TRIM(MI)+CHR(34)+","
         ?? CHR(34)+TRIM(LNAME)+CHR(34)+","
         ?? CHR(34)+TRIM(F_16)+CHR(34)+","
         ?? CHR(34)+TRIM(ADD1)+CHR(34)+","
         ?? CHR(34)+TRIM(ADD2)+CHR(34)+","
         ?? CHR(34)+TRIM(CITY)+CHR(34)+","
         ?? CHR(34)+TRIM(STATE)+CHR(34)+","
         ?? CHR(34)+TRIM(ZIPCODE)+CHR(34)+","
         ?? CHR(34)+TRIM(PHONE)+CHR(34)+","
         ?? CHR(34)+TRIM(COMPANY)+CHR(34)+","
         IF SW1
            ?? CHR(34)+"TRUE"+CHR(34)+","
         ELSE
            ?? CHR(34)+"FALSE"+CHR(34)+","
         ENDIF
         IF SW2
            ?? CHR(34)+"TRUE"+CHR(34)+","
         ELSE
            ?? CHR(34)+"FALSE"+CHR(34)+","
         ENDIF
         IF SW3
            ?? CHR(34)+"TRUE"+CHR(34)+","
         ELSE
            ?? CHR(34)+"FALSE"+CHR(34)+","
         ENDIF
         IF SW4
            ?? CHR(34)+"TRUE"+CHR(34)+","
         ELSE
            ?? CHR(34)+"FALSE"+CHR(34)+","
         ENDIF
         IF SW5
            ?? CHR(34)+"TRUE"+CHR(34)+","
         ELSE
            ?? CHR(34)+"FALSE"+CHR(34)+","
         ENDIF
   ENDCASE
   IF  MH_NdxL .OR. (LEN(TRIM(MH_Cri)) = 0)
       SKIP
   ELSE
       CONTINUE
   ENDIF
ENDDO
*
* Finish output
*
SET ALTERNATE OFF
CLOSE ALTERNATE
SET CONSOLE ON
IF MH_NdxL
   USE
ENDIF
SELE A
RETURN



PROCEDURE VAL
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.VAL
*
*
* Module Description : Validate data module
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
SELE J
USE State INDEX State
DO WHILE .T.
   IF LEN(TRIM(MA_STATE)) # 0
      FIND &MA_STATE
      IF  EOF()
         @24,0 SAY SPACE(78)
         @24,0 SAY "Not found on State Database"
         @8,34 GET MA_STATE PICTURE "!!"
         READ
      ELSE
         EXIT
      ENDIF
   ELSE
      @24,0 SAY SPACE(78)
      @24,0 SAY "Field cannot be blank"
      @8,34 GET MA_STATE PICTURE "!!"
      READ
   ENDIF
ENDDO
SELE A
RETURN



PROCEDURE HLP
PARAMETERS What
********************************************************************************
*
* System             : MAIL
*
*
* System Description : Mailing List System
*
*
* Module             : MAIL.HLP
*
*
* Module Description : Give general information
*
*
* Written by         : A. Michael Hearn
*
*
* Copyright (c) 1987 by University Research
*
********************************************************************************
CLEAR
DO CASE
CASE What = 1
     @1,1 SAY "Sorry, No help available"
CASE What = 2
@1,1 SAY "From the update screen, you can:"
@2,1 SAY ""
@3,1 SAY " N - Go to the next person"
@4,1 SAY " P - Go to the previous person"
@5,1 SAY " T - Go to the first person"
@6,1 SAY " L - Go to the last person"
@7,1 SAY " F - Find a person by using the index"
@8,1 SAY " S - Set a filter.  This will only display persons"
@9,1 SAY "     which meet some criteria you specified."
@10,1 SAY " R - Print a person"
@11,1 SAY " E - Change the data of a person"
@12,1 SAY " Q - Returns to the main menu"
OTHERWISE
     @1,1 SAY "Sorry, No help available"
ENDCASE
@24,0 SAY SPACE(80)
@24,0 SAY "Press any key to continue"
READ
@24,0 SAY SPACE(80)
RETURN