Category : Science and Education
Archive   : DB4HAMLG.ZIP
Filename : CONTACT1.PRG

**********************************************************************
* Program......: CONTACT1.PRG
* Author.......: Paul M. Elliott N3GPU
* Date.........: 3-07-90
* Notice.......:
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: CONTACTS LOGGING SYSTEM MAIN MENU

* Description..: Menu actions
**********************************************************************
PROCEDURE CONTACT1
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="01"

DO SET01
IF gn_error > 0
gn_error=0
RETURN
ENDIF

*-- Before menu code
SET STATUS ON


ACTIVATE MENU CONTACT1

@ 0,0 CLEAR TO 3,79

*-- After menu

RETURN
*-- EOP CONTACT1

PROCEDURE SET01
ON KEY LABEL F1 DO 1HELP1

DO DBF01 && open menu level database

IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO R/N
SET COLOR OF MESSAGES TO R/N
SET COLOR OF TITLES TO R/N
SET COLOR OF HIGHLIGHT TO GR+/N
SET COLOR OF BOX TO GR+/N
SET COLOR OF INFORMATION TO GR+/N
SET COLOR OF FIELDS TO GR+/N
ENDIF

SET BORDER TO
@ 0,0 TO 3,79 DOUBLE COLOR GR+/N
@ 1,1 CLEAR TO 2,78
@ 1,1 FILL TO 2,78 COLOR R/N
@ 1,4 SAY "Contacts Log " COLOR R/N
@ 1,24 SAY "Reports & Labels" COLOR R/N
@ 1,49 SAY "Housekeeping" COLOR R/N
@ 1,71 SAY "Exit" COLOR R/N
@ 22,00
ENDIF
RETURN

PROCEDURE DBF01
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN

PROCEDURE ACT01
*-- Begin CONTACT1: BAR Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE "PAD_1" = PAD()
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Browscr
SET SCOREBOARD ON
SET MESSAGE TO "Add, Change, Review, Delete Records in Main Contacts Log"
*-- Desc: attach format file CONTACTS
SET FORMAT TO CONTACTS
EDIT
*-- close format file so as not to affect READ's
SET FORMAT TO
SET SCOREBOARD OFF
DEACTIVATE WINDOW Browscr
CASE "PAD_2" = PAD()
lc_new='Y'
DO RPTLBL01 WITH " 01"
CASE "PAD_3" = PAD()
lc_new='Y'
DO HOUSKEEP WITH " 01"
CASE "PAD_4" = PAD()
lc_new='Y'
DO EXIT1 WITH " 01"
OTHERWISE
@ 24,00
@ 24,21 SAY "This item has no action. Press a key."
x=INKEY(0)
@ 24,00
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE MENU && CONTACT1
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: RPTLBL01.PRG
* Author.......: Paul M. Elliott N3GPU
* Date.........: 3-07-90
* Notice.......:
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: Contacts Log Standard Reports & Label Printing Routines

* Description..: Menu actions
**********************************************************************
PROCEDURE RPTLBL01
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="02"

DO SET02
IF gn_error > 0
gn_error=0
RETURN
ENDIF

*-- Before menu code


ACTIVATE POPUP RPTLBL01

*-- After menu

RETURN
*-- EOP RPTLBL01

PROCEDURE SET02
ON KEY LABEL F1 DO 1HELP1

DO DBF02 && open menu level database

IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO W/B
SET COLOR OF MESSAGES TO W/B
SET COLOR OF TITLES TO W/B
SET COLOR OF HIGHLIGHT TO GR+/N
SET COLOR OF BOX TO GR+/N
SET COLOR OF INFORMATION TO GR+/N
SET COLOR OF FIELDS TO GR+/N
ENDIF
@ 22,00
ENDIF
RETURN

PROCEDURE DBF02
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN

PROCEDURE ACT02
*-- Begin RPTLBL01: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO DXCCNTRY.NDX
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) DXCCNTRY.NDX"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Report all contacts for which no QSL has been sent"
*-- Desc: Report
SET PRINT ON
REPORT FORM QSLACTN1 FOR LIKE(" / / ",DTOC(QSL_SENT))
SET PRINT OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 2
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO DXCCNTRY.NDX
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) DXCCNTRY.NDX"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Report all contacts for which QSL has been sent but not received"
*-- Desc: Report
SET PRINT ON
REPORT FORM QSLSTAT1 FOR LIKE(" / / ",DTOC(QSL_RECD))
SET PRINT OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 3
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO DXCCNTRY
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) DXCCNTRY"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Print QSL card labels for all contacts w/ BLANK QSL_Sent & BLANK QSL_Status"
*-- Desc: LABEL command to call QSLCARD
SET PRINT ON
LABEL FORM QSLCARD FOR LIKE(" / / ",DTOC(QSL_SENT)) .AND. QSL_STATUS=" " SAMPLE
SET PRINT OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 4
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO DXCCNTRY
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) DXCCNTRY"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Print full detail about every contact in log"
*-- Desc: Report
SET PRINT ON
REPORT FORM FOR_LIST
SET PRINT OFF
DEACTIVATE WINDOW Savescr
CASE BAR() = 5
*-- Open Item level view/database and indexes
CLOSE DATABASES
lc_dbf='Y'
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Call, date, freq., name, city, country, QSL status/sent/recd - all contacts"
*-- Desc: Report
SET PRINT ON
REPORT FORM SHORTLST
SET PRINT OFF
DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && RPTLBL01
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
IF lc_dbf='Y' .AND. .NOT. lc_new='Y'
lc_file="DBF"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: HOUSKEEP.PRG
* Author.......: Paul M. Elliott N3GPU
* Date.........: 3-07-90
* Notice.......:
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: Database housekeeping menu

* Description..: Menu actions
**********************************************************************
PROCEDURE HOUSKEEP
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="03"

DO SET03
IF gn_error > 0
gn_error=0
RETURN
ENDIF

*-- Before menu code


ACTIVATE POPUP HOUSKEEP

*-- After menu

RETURN
*-- EOP HOUSKEEP

PROCEDURE SET03
ON KEY LABEL F1 DO 1HELP1

DO DBF03 && open menu level database

IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO R/N
SET COLOR OF MESSAGES TO R/N
SET COLOR OF TITLES TO R/N
SET COLOR OF HIGHLIGHT TO GR+/N
SET COLOR OF BOX TO GR+/N
SET COLOR OF INFORMATION TO GR+/N
SET COLOR OF FIELDS TO GR+/N
ENDIF
@ 22,00
ENDIF
RETURN

PROCEDURE DBF03
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN

PROCEDURE ACT03
*-- Begin HOUSKEEP: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
SET EXCLUSIVE ON
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
SET EXCLUSIVE OFF
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Physically remove records previously marked for deletion."
lc_say='Looking for DELETED Records...'
DO info_box WITH lc_say
LOCATE FOR DELETED()
IF .NOT. EOF()
lc_say='Purging DELETED Records...'
DO info_box WITH lc_say
SET TALK ON
PACK
SET TALK OFF
GO TOP
ENDIF

DEACTIVATE WINDOW Savescr
CASE BAR() = 2
SET EXCLUSIVE ON
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
gn_error=0
lc_file="SET"+gc_prognum
DO &lc_file.
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
SET EXCLUSIVE OFF
ACTIVATE WINDOW Savescr
SET MESSAGE TO "Rebuild log file indexes (use if records display or print in wrong order)."
lc_say='Reindexing Database...'
DO info_box WITH lc_say
SET TALK ON
REINDEX
SET TALK OFF

DEACTIVATE WINDOW Savescr
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && HOUSKEEP
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN
**********************************************************************
* Program......: EXIT1.PRG
* Author.......: Paul M. Elliott N3GPU
* Date.........: 3-07-90
* Notice.......:
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: EXIT CHOICES MENU

* Description..: Menu actions
**********************************************************************
PROCEDURE EXIT1
PARAMETER entryflg
PRIVATE gc_prognum
gc_prognum="04"

DO SET04
IF gn_error > 0
gn_error=0
RETURN
ENDIF

*-- Before menu code


ACTIVATE POPUP EXIT1

*-- After menu

RETURN
*-- EOP EXIT1

PROCEDURE SET04
ON KEY LABEL F1 DO 1HELP1

DO DBF04 && open menu level database

IF gn_error = 0
IF ISCOLOR()
SET COLOR OF NORMAL TO R/N
SET COLOR OF MESSAGES TO R/N
SET COLOR OF TITLES TO R/N
SET COLOR OF HIGHLIGHT TO GR+/N
SET COLOR OF BOX TO GR+/N
SET COLOR OF INFORMATION TO GR+/N
SET COLOR OF FIELDS TO GR+/N
ENDIF
@ 22,00
ENDIF
RETURN

PROCEDURE DBF04
CLOSE DATABASES
*-- Open menu level view/database
lc_message="0"
ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
USE CONTACTS
IF "" <> DBF()
SET INDEX TO CALLSIGN
ENDIF
ON ERROR
gn_error=VAL(lc_message)
IF gn_error > 0
DO Pause WITH ;
"Error opening CONTACTS.DBF or index(es) CALLSIGN"
lc_new='Y'
RETURN
ENDIF
lc_new='Y'
RELEASE lc_message
RETURN

PROCEDURE ACT04
*-- Begin EXIT1: POPUP Menu Actions.
*-- (before item, action, and after item)
*
PRIVATE lc_new, lc_dbf
lc_new=' '
lc_dbf=' '
DO CASE
CASE BAR() = 1
*-- Quit dBASE
CLOSE DATABASES
QUIT
CASE BAR() = 2
*-- Return to caller
gc_quit='Q'
IF LEFT(entryflg,1) <> "B"
DEACTIVATE POPUP && EXIT1
ELSE
DEACTIVATE MENU
ENDIF
RETURN
ENDCASE
SET MESSAGE TO
IF SET("STATUS")="ON"
SET STATUS OFF
ENDIF
IF gc_quit='Q'
DEACTIVATE POPUP && EXIT1
ENDIF
IF lc_new='Y'
lc_file="SET"+gc_prognum
DO &lc_file.
ENDIF
RETURN