Category : Science and Education
Archive   : DB4WAZLG.ZIP
Filename : DB4WAZLG.PRG

 
Output of file : DB4WAZLG.PRG contained in archive : DB4WAZLG.ZIP
**********************************************************************
* Program......: DB4WAZLG.PRG
* Author.......: Paul M. Elliott N3GPU
* Date.........: 3-12-90
* Notice.......:
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: dBase IV Worked All Zones Award Tracking System

* Description..: Main routine for menu system
**********************************************************************

*-- Setup environment
SET CONSOLE OFF
IF TYPE("gn_ApGen")="U"
CLEAR ALL
CLEAR WINDOWS
CLOSE ALL
CLOSE PROCEDURE
gn_ApGen=1
ELSE
gn_ApGen=gn_ApGen+1
IF gn_ApGen > 4
Do Pause WITH "Maximum level of Application nesting exceeded."
RETURN
ENDIF
PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
gc_instruc, gc_safety, gc_status, gc_score, gc_talk, gc_key
ENDIF
*-- Store some sets to variables
gc_bell =SET("BELL")
gc_carry =SET("CARRY")
gc_clock =SET("CLOCK")
gc_century=SET("CENTURY")
gc_confirm=SET("CONFIRM")
gc_deli =SET("DELIMITERS")
gc_instruc=SET("INSTRUCT")
gc_safety =SET("SAFETY")
gc_status =SET("STATUS")
gc_score =SET("SCOREBOARD")
gc_talk =SET("TALK")
SET CONSOLE ON

SET BELL OFF
SET CARRY OFF
SET CENTURY OFF
SET CLOCK OFF
SET CONFIRM OFF
SET DELIMITERS TO " "
SET DELIMITERS OFF
SET DEVICE TO SCREEN
SET ESCAPE ON
SET EXCLUSIVE OFF
SET ECHO OFF
SET LOCK ON
SET MESSAGE TO ""
SET PRINT OFF
SET REPROCESS TO 4
SET SAFETY ON
SET TALK OFF

*-- Initialize global variables
gn_error=0 && 0 if no error, otherwise an error occurred
gn_ikey=0 && keypress returned from the INKEY() function
gn_send=0 && return value from popup of position menus
gn_trace=1 && sets trace level, however you need to change template
gc_brdr='1' && border to use when drawing boxes
gc_dev='CON' && Device to use for printing - See Proc. PrintSet
gc_key='N' && leave the application
gc_prognum=' ' && internal program counter to handle nested menus
gc_quit=' ' && memvar for return to caller
listval='NO_FIELD' && Pick List value

*-- remove asterisk to turn clock on
* SET CLOCK TO
SET INSTRUCT OFF

*-- Blank the screen
SET COLOR TO
CLEAR
SET SCOREBOARD OFF
SET STATUS OFF

*-- Define menus
DO MPDEF && execute Menu Process DEFinition

*-- Execute main menu
DO WHILE gc_key = 'N'
DO DB4WAZ01 WITH "B00"
IF gc_quit = 'Q'
EXIT
ENDIF
ACTIVATE WINDOW Exit_App
lc_conf=SET("CONFIRM")
lc_deli=SET("DELIMITER")
SET CONFIRM OFF
SET DELIMITER OFF
@ 1,2 SAY "Do you want to leave this application?" ;
GET gc_key PICT "!" VALID gc_key $ "NY"
READ
SET CONFIRM &lc_conf.
SET DELIMITER &lc_deli.
RELEASE lc_conf, lc_deli
DEACTIVATE WINDOW Exit_App
ENDDO

*-- Reset environment
gn_ApGen=gn_ApGen-1
SET BELL &gc_bell.
SET CARRY &gc_carry.
SET CLOCK &gc_clock.
SET CENTURY &gc_century.
SET CONFIRM &gc_confirm.
SET DELIMITERS &gc_deli.
SET INSTRUCT &gc_instruc.
SET STATUS &gc_status.
SET SAFETY &gc_safety.
SET SCORE &gc_score.
SET TALK &gc_talk.

IF gn_Apgen < 1
ON KEY LABEL F1
CLEAR ALL
CLEAR WINDOWS
CLOSE ALL
CLOSE PROCEDURE
SET CLOCK OFF
SET ESCAPE ON
SET MESSAGE TO ""
CLEAR
ENDIF
RETURN

*******************************************************************************
* Description..: Procedure files for generated menu system.
* The programs that follow are common to main routines
* The last procedure is the Menu Process DEFinition
*******************************************************************************
PROCEDURE Lockit
PARAMETER ltype
IF NETWORK()
gn_error=0
ON ERROR DO Multerr
IF ltype = "1"
ll_lock=FLOCK()
ENDIF
IF ltype = "2"
ll_lock=RLOCK()
ENDIF
ON ERROR
ENDIF
RETURN

PROCEDURE Info_Box
PARAMETERS lc_say
? lc_say
? REPLICATE("-",LEN(lc_say))
?
RETURN
* EOP: Info_Box

PROCEDURE get_sele
*-- Get the user selection & store BAR into variable
gn_send = BAR() && Variable for print testing
DEACTIVATE POPUP
RETURN

PROCEDURE ShowPick
listval=PROMPT()
IF LEFT(entryflg,1)="B"
lc_file=POPUP()
DO &lc_file. WITH "A"
RETURN
ENDIF
IF TYPE("lc_window")="U"
ACTIVATE WINDOW ShowPick
ELSE
ACTIVATE WINDOW &lc_window.
ENDIF
STORE 0 TO ln_ikey,x1,x2
ln_ikey=LASTKEY()
IF ln_ikey=13
x1=AT(TRIM(listval)+',',lc_fldlst)
IF x1 = 0
lc_fldlst=lc_fldlst+TRIM(listval)+','
ELSE
x2=AT(',',SUBSTR(lc_fldlst,x1))
lc_fldlst=STUFF(lc_fldlst,x1,x2,'')
ENDIF
CLEAR
? lc_fldlst
ENDIF
ACTIVATE SCREEN
RETURN
* EOP: ShowPick

PROCEDURE Cleanup
*-- test whether report option was selected
DO CASE
CASE gc_dev='CON'
WAIT
CASE gc_dev='PRN'
SET PRINT OFF
SET PRINTER TO
CASE gc_dev='TXT'
CLOSE ALTERNATE
ENDCASE
RETURN

* EOP: Cleanup

PROCEDURE Pause
PARAMETER lc_msg
*-- Parameters : lc_msg = message line
IF TYPE("lc_message")="U"
gn_error=ERROR()
ENDIF
lc_msg = lc_msg
lc_option='0'
ACTIVATE WINDOW Pause
IF gn_error > 0
IF TYPE("lc_message")="U"
@ 0,1 SAY [An error has occurred !! - Error message: ]+MESSAGE()
ELSE
@ 0,1 SAY [Error # ]+lc_message
ENDIF
ENDIF
@ 1,1 SAY lc_msg
WAIT " Press any key to continue..."
DEACTIVATE WINDOW Pause
RETURN

* EOP: Pause

PROCEDURE Multerr
*-- set the global error variable
gn_error=ERROR()
*-- contains error number to test
lc_erno=STR(ERROR(),3)+','
*-- option var.
lc_opt='T'
*-- Dialog box for options Try again and Return to menu.
IF lc_erno $ "108,109,128,129,"
ACTIVATE WINDOW Pause
@ 0,2 SAY lc_erno+" "+MESSAGE()
@ 2,22 SAY "T = Try again, R = Return to menu." GET lc_opt ;
PICTURE "!" VALID lc_opt $ "TR"
READ
DEACTIVATE WINDOW Pause
IF lc_opt = "R"
RETURN
ENDIF
ENDIF
*-- Display message and return to menu.
IF .NOT. lc_erno $ "108,109,128,129,"
DO PAUSE WITH ERROR()
RETURN
ENDIF
*-- reset global variable
gn_error=0
*-- Try the command again
RETRY
RETURN

* EOP: Multerr

PROCEDURE Trace
* Desc: Trace procedure - to let programmer know what module
* is about to execute and what module has executed.
PARAMETERS p_msg, p_lvl
*-- Parameters : p_msg = message line, p_lvl = trace level
lc_msg = p_msg
ln_lvl = p_lvl
lc_trp = ' '
IF gn_trace < ln_lvl
RETURN
ENDIF
DEFINE WINDOW trace FROM 11,00 TO 16,79 DOUBLE
DO WHILE lc_trp <> 'Q'
@ 2,40-LEN(lc_msg)/2 SAY lc_msg
@ 4,05 SAY 'S - Set trace level, D - Display status, M - display Memory'
@ 5,05 SAY 'P - Turn printer on, Q - to Quit'
lc_trp = 'Q'
@ 5,38 GET lc_trp PICTURE "!"
READ
DO CASE
CASE lc_trp = 'S'
@ 2,01 CLEAR
@ 2,33 SAY 'Set trace level'
@ 4,05 SAY 'Enter trace level to change to:' GET gn_trace PICTURE '#'
@ 5,05 SAY ' '
READ
IF gn_trace=0
@ 2,01 CLEAR
@ 3,05 SAY 'Trace is now turned off..To reactivate Trace - Press [F3]'
@ 4,05 say 'Press any key to continue...'
WAIT ''
ENDIF
CASE lc_trp = 'D'
DISPLAY STATUS
WAIT
CASE lc_trp = 'M'
DISPLAY MEMORY
WAIT
CASE lc_trp = 'P'
SET PRINT ON
ENDCASE
ENDDO
SET PRINT OFF
@ 24,79 SAY " "
RELEASE WINDOW trace
RETURN

* EOP: Trace

PROCEDURE PrintSet
*-- Initialize variables
gc_dev='CON'
lc_choice=' '
gn_pkey=0
gn_send=0

DEFINE WINDOW printemp FROM 08,25 TO 17,56

DEFINE POPUP SavePrin FROM 10,40
DEFINE BAR 1 OF SavePrin PROMPT " Send output to ..." SKIP
DEFINE BAR 2 OF SavePrin PROMPT REPLICATE(CHR(196),24) SKIP
DEFINE BAR 3 OF SavePrin PROMPT " CON: Console" MESSAGE "Send output to Screen"
DEFINE BAR 4 OF SavePrin PROMPT " LPT1: Parallel port 1 " MESSAGE "Send output to LPT1:"
DEFINE BAR 5 OF SavePrin PROMPT " LPT2: Parallel port 2" MESSAGE "Send output to LPT2:"
DEFINE BAR 6 OF SavePrin PROMPT " COM1: Serial port 1" MESSAGE "Send output to COM1:"
DEFINE BAR 7 OF SavePrin PROMPT " FILE = REPORT.TXT" MESSAGE "Send output to File Report.txt"
ON SELECTION POPUP SavePrin DO get_sele

ACTIVATE POPUP SavePrin
RELEASE POPUP SavePrin

IF gn_send = 7
gc_dev = 'TXT'
SET ALTERNATE TO REPORT.TXT
SET ALTERNATE ON
ELSE
IF .NOT. (gn_send = 3 .OR. LASTKEY() = 27)
gc_dev = 'PRN'
temp = SUBSTR(" LPT1LPT2COM1 ",((gn_send-2)-1)*4,4)
ON ERROR DO prntrtry
SET PRINTER TO &temp.
IF gn_pkey <> 27
SET PRINT ON
ENDIF
ON ERROR
ENDIF
ENDIF
RELEASE WINDOW printemp
RETURN

PROCEDURE prntrtry
PRIVATE lc_escape
lc_escape = SET("ESCAPE")
IF .NOT. PRINTSTATUS()
IF lc_escape = "ON"
SET ESCAPE OFF
ENDIF
gn_pkey = 0
ACTIVATE WINDOW printemp
@ 1,0 SAY "Please ready your printer or"
@ 2,0 SAY " press ESC to cancel"
DO WHILE ( .NOT. PRINTSTATUS()) .AND. gn_pkey <> 27
gn_pkey = INKEY()
ENDDO
DEACTIVATE WINDOW printemp
SET ESCAPE &lc_escape.
IF gn_pkey <> 27
RETRY
ENDIF
ENDIF
RETURN

* EOP: PrintSet

PROCEDURE Position
IF LEN(DBF()) = 0
DO Pause WITH "Database not in use. "
RETURN
ENDIF
SET SPACE ON
SET DELIMITERS OFF
ln_type=0 && sublevel selection
ln_rkey=READKEY() && test for ESC or Return
ln_rec=RECNO() && DBF record number
ln_num=0 && for input of a number
ld_date=DATE() && for input of a date
lc_option='0' && main option ie. Seek, Goto and Locate
*-- Scope ie. ALL, REST, NEXT
STORE SPACE(10) TO lc_scp
*-- 1 = Character SEEK, 2 = For clause, 3 = While clause
STORE SPACE(40) TO lc_ln1, lc_ln2, lc_ln3
lc_temp=""
@ 0,00 SAY "Index order: "+IIF(""=ORDER(),"Database is in natural order",ORDER())
@ 1,00 SAY "Listed below are the first 16 fields."
lc_temp=REPLICATE(CHR(196),19)
@ 2,0 SAY CHR(218)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp
ln_num=240
DO WHILE ln_num < 560
lc_temp=FIELD( (ln_num-240)/20 +1)
@ (ln_num/80),MOD(ln_num,80) SAY CHR(179)+;
lc_temp+SPACE(11-LEN(lc_temp))+;
SUBSTR("= Char = Date = Logic = Num = Float = Memo ",;
AT(TYPE(lc_temp),"CDLNFMU")*8-7,8)
ln_num=ln_num+20
ENDDO
ln_num=1

DEFINE POPUP Posit1 FROM 8,30
DEFINE BAR 1 OF Posit1 PROMPT " Position by " SKIP
DEFINE BAR 2 OF Posit1 PROMPT REPLICATE(CHR(196),15) SKIP
DEFINE BAR 3 OF Posit1 PROMPT " SEEK Record" MESSAGE "Search on index key" SKIP FOR ""=ORDER()
DEFINE BAR 4 OF Posit1 PROMPT " GOTO Record" MESSAGE "Position to specific record"
DEFINE BAR 5 OF Posit1 PROMPT " LOCATE Record " MESSAGE "Locate record for condition"
DEFINE BAR 6 OF Posit1 PROMPT " Return" MESSAGE "Return without positioning"
ON SELECTION POPUP Posit1 DO get_sele

SET CONFIRM ON
DO WHILE lc_option='0'
ACTIVATE POPUP Posit1
lc_option = ltrim(str(gn_send)) && for popup
IF LASTKEY() = 27 .OR. lc_option="6"
GOTO ln_rec
EXIT
ENDIF
DO CASE
CASE lc_option='3'
*-- Seek
IF LEN(NDX(1))=0 .AND. LEN(MDX(1))=0
DO Pause WITH "Can't use this option - No index files are open."
LOOP
ENDIF
ln_type=1
lc_ln1=SPACE(40)
DEFINE WINDOW Posit2 FROM 8,19 TO 15,62 DOUBLE
ACTIVATE WINDOW Posit2
@ 1,1 SAY "Enter the type of expression:" GET ln_type PICT "#" RANGE 1,3
@ 2,1 SAY "(1=character, 2=numeric and 3=date.)"
READ
IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
SET CONFIRM ON
@ 3,1 SAY "Enter the key expression to search for:"
IF ln_type=3
@ 4,1 GET ld_date PICT "@D"
ELSE
IF ln_type=2
@ 4,1 GET ln_num PICT "##########"
ELSE
@ 4,1 GET lc_ln1
ENDIF
ENDIF
READ
SET CONFIRM OFF
IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
lc_temp=IIF(ln_type=1,"TRIM(lc_ln1)",IIF(ln_type=2,"ln_num","ld_date"))
SEEK &lc_temp.
ENDIF
ENDIF
RELEASE WINDOWS Posit2
CASE lc_option='4'
*-- Goto
ln_type=1
DEFINE POPUP Posit2 FROM 8,30
DEFINE BAR 1 OF Posit2 PROMPT " GOTO:" SKIP
DEFINE BAR 2 OF Posit2 PROMPT REPLICATE(CHR(196),10) SKIP
DEFINE BAR 3 OF Posit2 PROMPT " TOP" MESSAGE "GOTO Top of File"
DEFINE BAR 4 OF Posit2 PROMPT " BOTTOM" MESSAGE "GOTO Bottom of File"
DEFINE BAR 5 OF Posit2 PROMPT " Record # " MESSAGE "GOTO A Specific Record"
ON SELECTION POPUP Posit2 DO get_sele
ACTIVATE POPUP posit2
ln_type = gn_send
IF LASTKEY() <> 27
IF ln_type=5
DEFINE WINDOW Posit2 FROM 8,26 TO 13,50 DOUBLE
ACTIVATE WINDOW Posit2
ln_num=0
@ 3,1 SAY "Max. Record # = "+LTRIM(STR(RECCOUNT()))
@ 1,1 SAY "Record to GOTO" GET ln_num PICT "######" RANGE 1,RECCOUNT()
READ
IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
GOTO ln_num
ENDIF
RELEASE WINDOWS Posit2
ELSE
lc_temp=IIF(ln_type=3,"TOP","BOTTOM")
GOTO &lc_temp.

ENDIF
ENDIF
CASE lc_option='5'
*-- Locate
DEFINE WINDOW Posit2 FROM 8,16 TO 14,66 DOUBLE
ACTIVATE WINDOW Posit2
@ 1,19 SAY "ie. ALL, NEXT , and REST"
@ 1,01 SAY "Scope:" GET lc_scp
@ 2,01 SAY "For: " GET lc_ln2
@ 3,01 SAY "While:" GET lc_ln3
READ
IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
lc_temp=TRIM(lc_scp)
lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln2)) > 0," FOR "+TRIM(lc_ln2),"")
lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln3)) > 0," WHILE "+TRIM(lc_ln3),"")
IF LEN(lc_temp) > 0
LOCATE &lc_temp.
ELSE
DO Pause WITH "All fields were blank."
ENDIF
ENDIF
RELEASE WINDOW Posit2
ENDCASE
IF EOF()
DO Pause WITH "Record not found."
GOTO ln_rec
ENDIF
IF READKEY()=12 .OR. READKEY()= 268 .OR. LASTKEY()=27 && Esc was hit
lc_option='0'
ENDIF
ENDDO
SET DELIMITERS &gc_deli.
SET CONFIRM OFF
RETURN

* EOP: Position

PROCEDURE Postnhlp
ln_getkey=INKEY()
DO CASE
CASE "SEEK" $ PROMPT()
HELP SEEK
CASE "GOTO" $ PROMPT()
HELP GOTO
CASE "LOCATE" $ PROMPT()
HELP LOCATE
ENDCASE
RETURN
* EOP: Postnhlp


**********************************************************************
* Program......: MPDEF
* Author.......: Paul M. Elliott N3GPU
* Date.........: 3-12-90
* Notice.......:
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: dBase IV Worked All Zones Award Tracking System

* Description..: Defines all menus in the system
**********************************************************************
PROCEDURE MPDEF
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 W/B
SET COLOR OF BOX TO W/B
SET COLOR OF INFORMATION TO W/B
SET COLOR OF FIELDS TO W/B
ENDIF
CLEAR


DEFINE WINDOW FullScr FROM 0,0 TO 24,79 NONE
DEFINE WINDOW Savescr FROM 0,0 TO 21,79 NONE
DEFINE WINDOW Helpscr FROM 0,0 TO 21,79 NONE
DEFINE WINDOW Browscr FROM 1,0 TO 21,79 NONE
IF gn_ApGen=1
DEFINE WINDOW Exit_App FROM 11,17 TO 15,62 DOUBLE
ENDIF
*-- Window for pause message box
DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE

ACTIVATE WINDOW FullScr
@ 24,00
@ 23,00 SAY "Loading..."
SET BORDER TO DOUBLE
*-- Bar
DEFINE MENU DB4WAZ01 MESSAGE 'Position with: '+CHR(27)+CHR(26)+' - to select choice - Help'
DEFINE PAD PAD_1 OF DB4WAZ01 PROMPT "CQ WAZ Tracking" AT 1,4 MESSAGE "Maintain award tracking log, print reports, perform database housekeeping."
ON SELECTION PAD PAD_1 OF DB4WAZ01 DO ACT01
DEFINE PAD PAD_2 OF DB4WAZ01 PROMPT "ITU WAZ Tracking" AT 1,30 MESSAGE "Maintain award tracking log, print reports, perform database housekeeping."
ON SELECTION PAD PAD_2 OF DB4WAZ01 DO ACT01
DEFINE PAD PAD_3 OF DB4WAZ01 PROMPT "Exit" AT 1,71
ON PAD PAD_3 OF DB4WAZ01 ACTIVATE POPUP EXIT1
?? "."
SET BORDER TO DOUBLE
*-- Bar
DEFINE MENU CQWAZ1 MESSAGE 'Position with: '+CHR(27)+CHR(26)+' - to select choice - Help'
DEFINE PAD PAD_1 OF CQWAZ1 PROMPT "Maintain Status Log" AT 5,3 MESSAGE "Review or change CQ WAZ status records for all zones and bands"
ON SELECTION PAD PAD_1 OF CQWAZ1 DO ACT02
DEFINE PAD PAD_2 OF CQWAZ1 PROMPT "Print Reports" AT 5,30
ON PAD PAD_2 OF CQWAZ1 ACTIVATE POPUP CQWAZRPT
DEFINE PAD PAD_3 OF CQWAZ1 PROMPT "Housekeeping" AT 5,51
ON PAD PAD_3 OF CQWAZ1 ACTIVATE POPUP HOUSKEEP
DEFINE PAD PAD_4 OF CQWAZ1 PROMPT "Exit" AT 5,71 MESSAGE "Return to Main Menu"
ON PAD PAD_4 OF CQWAZ1 ACTIVATE POPUP ESCAPE
?? "."
SET BORDER TO DOUBLE
*-- Bar
DEFINE MENU ITUWAZ1 MESSAGE 'Position with: '+CHR(27)+CHR(26)+' - to select choice - Help'
DEFINE PAD PAD_1 OF ITUWAZ1 PROMPT "Maintain Status Log" AT 5,3 MESSAGE "Review or change ITU WAZ award status records for all zones and bands"
ON SELECTION PAD PAD_1 OF ITUWAZ1 DO ACT03
DEFINE PAD PAD_2 OF ITUWAZ1 PROMPT "Print Reports" AT 5,30 MESSAGE "ITU Zone status standard reports"
ON PAD PAD_2 OF ITUWAZ1 ACTIVATE POPUP ITUWAZRP
DEFINE PAD PAD_3 OF ITUWAZ1 PROMPT "Housekeeping" AT 5,51
ON PAD PAD_3 OF ITUWAZ1 ACTIVATE POPUP HOUSKEEP
DEFINE PAD PAD_4 OF ITUWAZ1 PROMPT "Exit" AT 5,71 MESSAGE "Return to Main Menu"
ON PAD PAD_4 OF ITUWAZ1 ACTIVATE POPUP ESCAPE
?? "."
SET BORDER TO DOUBLE
*-- Popup
DEFINE POPUP EXIT1 FROM 2,65 TO 6,79 ;
MESSAGE 'Position: '+CHR(27)+CHR(26)+CHR(25)+CHR(24)+' Select: '+CHR(17)+CHR(196)+CHR(217)+' Help: F1'
DEFINE BAR 1 OF EXIT1 PROMPT " Go to DOS"
DEFINE BAR 2 OF EXIT1 PROMPT " Go to dBase"
ON SELECTION POPUP EXIT1 DO ACT04
?? "."
SET BORDER TO DOUBLE
*-- Popup
DEFINE POPUP CQWAZRPT FROM 6,25 TO 17,47 ;
MESSAGE 'Position: '+CHR(27)+CHR(26)+CHR(25)+CHR(24)+' Select: '+CHR(17)+CHR(196)+CHR(217)+' Help: F1'
DEFINE BAR 1 OF CQWAZRPT PROMPT " Status - 10 Meters" MESSAGE "Status report for all zones - 10 meter band only"
DEFINE BAR 2 OF CQWAZRPT PROMPT " Status - 12 Meters" MESSAGE "Status report for all zones - 12 meter band only"
DEFINE BAR 3 OF CQWAZRPT PROMPT " Status - 15 Meters" MESSAGE "Status report for all zones - 15 meter band only"
DEFINE BAR 4 OF CQWAZRPT PROMPT " Status - 17 Meters" MESSAGE "Status report for all zones - 17 meter band only"
DEFINE BAR 5 OF CQWAZRPT PROMPT " Status - 20 Meters" MESSAGE "Status report for all zones - 20 meter band only"
DEFINE BAR 6 OF CQWAZRPT PROMPT " Status - 30 Meters" MESSAGE "Status report for all zones - 30 meter band only"
DEFINE BAR 7 OF CQWAZRPT PROMPT " Status - 40 Meters" MESSAGE "Status report for all zones - 40 meter band only"
DEFINE BAR 8 OF CQWAZRPT PROMPT " Status - 80 Meters" MESSAGE "Status report for all zones - 75/80 meter band only"
DEFINE BAR 9 OF CQWAZRPT PROMPT " Status - 160 Meters" MESSAGE "Status report for all zones - 160 meter band only"
DEFINE BAR 10 OF CQWAZRPT PROMPT " Status - All Bands" MESSAGE "Status report for all zones - all bands 160-10 meters"
ON SELECTION POPUP CQWAZRPT DO ACT05
?? "."
SET BORDER TO DOUBLE
*-- Popup
DEFINE POPUP HOUSKEEP FROM 6,46 TO 10,67 ;
MESSAGE 'Position: '+CHR(27)+CHR(26)+CHR(25)+CHR(24)+' Select: '+CHR(17)+CHR(196)+CHR(217)+' Help: F1'
DEFINE BAR 1 OF HOUSKEEP PROMPT " Delete Records" MESSAGE "Physically remove records previously marked for deletion."
DEFINE BAR 2 OF HOUSKEEP PROMPT " Re-Index Log File" MESSAGE "Rebuild log file indexes (use if records display or print in wrong order)."
ON SELECTION POPUP HOUSKEEP DO ACT06
?? "."
SET BORDER TO DOUBLE
*-- Popup
DEFINE POPUP ESCAPE FROM 6,62 TO 10,79 ;
MESSAGE "Press ESCAPE to return to Main Menu"
DEFINE BAR 1 OF ESCAPE PROMPT " Press ESCAPE" SKIP
DEFINE BAR 2 OF ESCAPE PROMPT " to return to" SKIP
DEFINE BAR 3 OF ESCAPE PROMPT " Main Menu" SKIP
ON SELECTION POPUP ESCAPE DO ACT07
?? "."
SET BORDER TO DOUBLE
*-- Popup
DEFINE POPUP ITUWAZRP FROM 6,25 TO 18,47 ;
MESSAGE 'Position: '+CHR(27)+CHR(26)+CHR(25)+CHR(24)+' Select: '+CHR(17)+CHR(196)+CHR(217)+' Help: F1'
DEFINE BAR 1 OF ITUWAZRP PROMPT " Status - 10 Meters" MESSAGE "Status report for all zones - 10 meter bands only"
DEFINE BAR 2 OF ITUWAZRP PROMPT " Status - 12 Meters" MESSAGE "Status report for all zones - 12 meter band only"
DEFINE BAR 3 OF ITUWAZRP PROMPT " Status - 15 Meters" MESSAGE "Status report for all zones - 15 meter band only"
DEFINE BAR 4 OF ITUWAZRP PROMPT " Status - 17 Meters" MESSAGE "Status report for all zones - 17 meter band only"
DEFINE BAR 5 OF ITUWAZRP PROMPT " Status - 20 Meters" MESSAGE "Status report for all zones - 20 meter band only"
DEFINE BAR 6 OF ITUWAZRP PROMPT " Status - 30 Meters" MESSAGE "Status report for all zones - 30 meter band only"
DEFINE BAR 7 OF ITUWAZRP PROMPT " Status - 40 Meters" MESSAGE "Status report for all zones - 40 meter band only"
DEFINE BAR 8 OF ITUWAZRP PROMPT " Status - 80 Meters" MESSAGE "Status report for all zones - 75/80 meter band only"
DEFINE BAR 9 OF ITUWAZRP PROMPT " Status - 160 Meters" MESSAGE "Status report for all zones - 160 meter band only"
DEFINE BAR 10 OF ITUWAZRP PROMPT " Status - All Bands" MESSAGE "Status report for all zones - all bands 160-10 meters"
ON SELECTION POPUP ITUWAZRP DO ACT08
?? "."
@ 23,00 CLEAR
RETURN
*-- EOP: MPDEF.PRG

PROCEDURE 1HELP1
ACTIVATE WINDOW Helpscr
SET ESCAPE OFF
ACTIVATE SCREEN
@ 0,0 CLEAR TO 21,79
@ 1,0 TO 21,79 COLOR GR+/N
@ 24,00
@ 24,26 SAY "Press any key to continue..."
@ 0,0 SAY ""
ln_row=INKEY()
DO CASE
*-- help for menu DB4WAZ01
CASE "01"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu CQWAZ1
CASE "02"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu ITUWAZ1
CASE "03"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu EXIT1
CASE "04"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu CQWAZRPT
CASE "05"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu HOUSKEEP
CASE "06"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu ESCAPE
CASE "07"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
*-- help for menu ITUWAZRP
CASE "08"=gc_prognum
@ 2,2 SAY "No Help defined."
ln_row=INKEY(0)
ENDCASE
SET ESCAPE ON
@ 24,00
DEACTIVATE WINDOW Helpscr
RETURN
*-- EOP: 1HELP1


  3 Responses to “Category : Science and Education
Archive   : DB4WAZLG.ZIP
Filename : DB4WAZLG.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/