Category : Science and Education
Archive   : DB4WAZLG.ZIP
Filename : WAZXX.FRG
* Date...............: 12-12-89
* Versions...........: dBASE IV, Report 1
*
* Notes:
* ------
* Prior to running this procedure with the DO command
* it is necessary use LOCATE because the CONTINUE
* statement is in the main loop.
*
*-- Parameters
PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
** The first three parameters are of type Logical.
** The fourth parameter is a string. The fifth is extra.
PRIVATE _peject, _wrap
*-- Test for no records found
IF EOF() .OR. .NOT. FOUND()
RETURN
ENDIF
*-- turn word wrap mode off
_wrap=.F.
IF _plength < 10
SET DEVICE TO SCREEN
DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
ACTIVATE WINDOW gw_report
@ 0,1 SAY "Increase the page length for this report."
@ 2,1 SAY "Press any key ..."
x=INKEY(0)
DEACTIVATE WINDOW gw_report
RELEASE WINDOW gw_report
RETURN
ENDIF
_plineno=0 && set lines to zero
*-- NOEJECT parameter
IF gl_noeject
IF _peject="BEFORE"
_peject="NONE"
ENDIF
IF _peject="BOTH"
_peject="AFTER"
ENDIF
ENDIF
*-- Set-up environment
ON ESCAPE DO prnabort
IF SET("TALK")="ON"
SET TALK OFF
gc_talk="ON"
ELSE
gc_talk="OFF"
ENDIF
gc_space=SET("SPACE")
SET SPACE OFF
gc_time=TIME() && system time for predefined field
gd_date=DATE() && system date " " " "
gl_fandl=.F. && first and last page flag
gl_prntflg=.T. && Continue printing flag
gl_widow=.T. && flag for checking widow bands
gn_length=LEN(gc_heading) && store length of the HEADING
gn_level=2 && current band being processed
gn_page=_pageno && grab current page number
SET CONSOLE OFF
*-- Set up procedure for page break
IF _pspacing > 1
gn_atline=_plength - (_pspacing + 1)
ELSE
gn_atline=_plength - 2
ENDIF
ON PAGE AT LINE gn_atline EJECT PAGE
*-- Print Report
PRINTJOB
IF gl_plain
ON PAGE AT LINE gn_atline DO Pgplain
ELSE
ON PAGE AT LINE gn_atline DO Pgfoot
ENDIF
DO Pghead
gl_fandl=.T. && first physical page started
*-- File Loop
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
DO Upd_Vars
*-- Detail lines
IF .NOT. gl_summary
DO Detail
ENDIF
CONTINUE
ENDDO
IF gl_prntflg
DO Rsumm
IF _plineno <= gn_atline
EJECT PAGE
ENDIF
ELSE
DO Rsumm
DO Reset
RETURN
ENDIF
ON PAGE
ENDPRINTJOB
DO Reset
RETURN
* EOP: D:\DB4\N3GPU\CQWAZXX.FRG
*-- Update summary fields and/or calculated fields in the detail band.
PROCEDURE Upd_Vars
RETURN
* EOP: Upd_Vars
*-- Set flag to get out of DO WHILE loop when escape is pressed.
PROCEDURE prnabort
gl_prntflg=.F.
RETURN
* EOP: prnabort
PROCEDURE Pghead
?
?? IIF(gl_plain,'' , "Page " ) AT 0,
?? IIF(gl_plain,'',_pageno) PICTURE "999" ,
?? rptmode FUNCTION "T" PICTURE "XXX" AT 14,
?? " Worked All Zones Award Status - " ,
?? band FUNCTION "T" PICTURE "XXXXX" ,
?? " Meter Band"
?
*-- Print HEADING parameter ie. REPORT FORM
IF .NOT. gl_plain .AND. gn_length > 0
?? gc_heading FUNCTION "I;V"+LTRIM(STR(_rmargin-_lmargin))
?
ENDIF
IF .NOT. gl_plain
?? gd_date AT 0
?
ENDIF
?? gc_time FUNCTION "T" AT 0
?
?? " ------- Worked --------" AT 14,
?? " ------ Confirmed ------" AT 41
?
?? " " AT 0,
?? "Zone" AT 4,
?? " Callsign" AT 14,
?? "Date" AT 30,
?? " Callsign Date" AT 42
?
?
RETURN
* EOP: Pghead
PROCEDURE Detail
If band = "10"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd10call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD10DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM10CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM10DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "12"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd12call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD12DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM12CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM12DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "15"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd15call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD15DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM15CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM15DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "17"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd17call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD17DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM17CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM17DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "20"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd20call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD20DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM20CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM20DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "30"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd30call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD30DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM30CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM30DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "40"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd40call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD40DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM40CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM40DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "75/80"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd80call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD80DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM80CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM80DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
If band = "160"
?? " " AT 0,
?? ZONE PICTURE "99" ,
?? wkd160call FUNCTION "T" PICTURE "XXXXXXXXXXXX" AT 15,
?? WKD160DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 29,
?? " " AT 41,
?? CFM160CALL FUNCTION "T" PICTURE "XXXXXXXXXXXX" ,
?? CFM160DATE FUNCTION "T" PICTURE "XXXXXXXX" AT 56
?
Endif
RETURN
* EOP: Detail
PROCEDURE Pgfoot
PRIVATE _box
gl_widow=.F. && disable widow checking
?
IF .NOT. gl_plain
ENDIF
EJECT PAGE
*-- is the page number greater than the ending page
IF _pageno > _pepage
GOTO BOTTOM
SKIP
gn_level=0
ENDIF
IF .NOT. gl_plain .AND. gl_fandl
DO Pghead
ENDIF
gl_widow=.T. && enable widow checking
RETURN
* EOP: Pgfoot
PROCEDURE Rsumm
?
?? "Total Worked:" AT 14,
?? WORKED PICTURE "99" AT 32
?
?? "Total Confirmed:" AT 14,
?? CONFIRM PICTURE "99" AT 32
gl_fandl=.F.
?
RETURN
* EOP: Rsumm
*-- Process page break when PLAIN option is used.
PROCEDURE Pgplain
PRIVATE _box
EJECT PAGE
RETURN
* EOP: Pgplain
*-- Reset dBASE environment prior to calling report
PROCEDURE Reset
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
ON PAGE
RETURN
* EOP: Reset
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/