home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
library
/
dbase
/
cubs
/
stats.prg
< prev
next >
Wrap
Text File
|
1989-03-31
|
3KB
|
106 lines
*STATS.PRG
SET TALK OFF
CLEAR
?
? " I'm counting Leaders"
SELECT 2
COUNT TO MLDR
? ' '+STR(MLDR)
SELECT 1
?
CLEAR
? " Now I'm counting Cub Scouts"
COUNT TO MCUBS FOR DTOC(LEFT) = ' / / '
? ' '+STR(MCUBS)
COUNT FOR DEN = '1' .AND. DTOC(LEFT) = ' / / ' TO CNT1
COUNT FOR DEN = '2' .AND. DTOC(LEFT) = ' / / ' TO CNT2
COUNT FOR DEN = '3' .AND. DTOC(LEFT) = ' / / ' TO CNT3
CLEAR
?
?
?
CLEAR
? ' Where did you get all these kids?'
COUNT FOR DEN = 'W1' .AND. DTOC(LEFT) = ' / / ' TO CNTW1
COUNT FOR DEN = 'W2' .AND. DTOC(LEFT) = ' / / ' TO CNTW2
STORE 'Y' TO LOOKING
STORE 1 TO TRIPS
GO TOP
DO WHILE .NOT. EOF()
DO WHILE LOOKING = 'y' .OR. LOOKING = 'Y'
CLEAR
? CHR(10)+CHR(10)+CHR(10)
? ' PACK STATISTICS ì
'+DTOC(DATE())
?
? ' Ldrs Cubs Den 1 Den 2 Den 3 DenW1 ì
DenW2'
?
? STR(MLDR)+STR(MCUBS)+STR(CNT1)+STR(CNT2)+STR(CNT3)+STR(CNTW1)+STR(CNTW2)
?
?
?
? ' Webelos approaching 11 years of age'
?
SET HEADING OFF
DISPLAY OFF FIELDS ' ',SCOUT, DOB,' ', DEN FOR ì
DOB < DATE() - 3970 .AND. DTOC(LEFT) = ' / / '
?
?
? ' Cub Scouts approaching 10 years of age'
?
DISPLAY OFF FIELDS ' ',SCOUT, DOB, ' ', DEN FOR DOB ì
< DATE() - 3565 .AND. DEN <> 'W1' .AND. DEN <> 'W2' .AND. ì
DTOC(LEFT) = ' / / '
* This routine computes tenure in unit
GO TOP
SET DECIMALS TO 1
DO WHILE .NOT. EOF()
IF DTOC(LEFT) = ' / / '
STORE (DATE() - JOINED)/30 TO MTENURE
ENDIF
IF DTOC(LEFT) <> ' / / '
STORE (LEFT-JOINED)/30 TO MROTATE
REPLACE ROTATE WITH MROTATE
REPLACE TENURE WITH MTENURE
ENDIF
SKIP
ENDDO
AVERAGE TENURE TO FRED
?
? ' AVERAGE TENURE OF PRESENT CUBS '+STR(FRED)+' ì
Months'
AVERAGE ROTATE FOR ROTATE > 0 TO MROTATE
?
? ' AVERAGE TENURE OF DEPARTED CUBS'+STR(MROTATE)+' ì
Months'
?
*end of tenure routine
*? CHR(12)
SET PRINT OFF
TRIPS = TRIPS + 1
IF TRIPS < 3
WAIT 'Do You Want Hardcopy? (Y/N)' TO LOOKING
IF LOOKING = 'Y' .OR. LOOKING = 'y'
CLEAR
? ' ALIGN TOP OF PAPER WITH PRINTHEAD'
WAIT
SET PRINT ON
? CHR(27)+CHR(99)+CHR(49)
? CHR(27)+CHR(33)
LOOP
ELSE
ENDDO
ENDIF
ENDIF
RELEASE ALL
CLEAR
SET PRINT OFF
RETURN