home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / cubs.zip / STATS.PRG < prev    next >
Text File  |  1989-03-31  |  3KB  |  106 lines
  1.  
  2. *STATS.PRG
  3.  
  4. SET TALK OFF
  5. CLEAR
  6. ?
  7. ? "                             I'm counting Leaders"
  8. SELECT 2
  9. COUNT TO MLDR
  10. ? '                             '+STR(MLDR)
  11. SELECT 1
  12. ?
  13. CLEAR
  14. ? "                          Now I'm counting Cub Scouts"
  15.  
  16. COUNT TO MCUBS FOR DTOC(LEFT) = '  /  /  '
  17. ? '                              '+STR(MCUBS)
  18. COUNT FOR DEN = '1' .AND. DTOC(LEFT) = '  /  /  ' TO CNT1
  19. COUNT FOR DEN = '2' .AND. DTOC(LEFT) = '  /  /  ' TO CNT2
  20. COUNT FOR DEN = '3' .AND. DTOC(LEFT) = '  /  /  ' TO CNT3
  21. CLEAR
  22. ?
  23. ?
  24. ?
  25. CLEAR
  26. ? '                       Where did you get all these kids?'
  27. COUNT FOR DEN = 'W1' .AND. DTOC(LEFT) = '  /  /  ' TO CNTW1
  28. COUNT FOR DEN = 'W2' .AND. DTOC(LEFT) = '  /  /  ' TO CNTW2
  29. STORE 'Y' TO LOOKING
  30. STORE 1 TO TRIPS
  31. GO TOP
  32. DO WHILE .NOT. EOF()
  33. DO WHILE LOOKING = 'y' .OR. LOOKING = 'Y'
  34. CLEAR
  35. ? CHR(10)+CHR(10)+CHR(10)
  36. ? '                             PACK STATISTICS            ì
  37.         '+DTOC(DATE())
  38. ?
  39. ? '       Ldrs      Cubs     Den 1     Den 2     Den 3     DenW1    ì
  40.   DenW2'
  41. ?
  42. ? STR(MLDR)+STR(MCUBS)+STR(CNT1)+STR(CNT2)+STR(CNT3)+STR(CNTW1)+STR(CNTW2)
  43. ?
  44. ?
  45. ?
  46. ? '                     Webelos approaching 11 years of age'
  47. ?
  48. SET HEADING OFF
  49. DISPLAY OFF     FIELDS '            ',SCOUT, DOB,'      ', DEN FOR ì
  50. DOB < DATE() - 3970 .AND. DTOC(LEFT) = '  /  /  '
  51. ?
  52. ?
  53. ? '                    Cub Scouts approaching 10 years of age'
  54. ?
  55. DISPLAY OFF     FIELDS '            ',SCOUT, DOB, '       ', DEN FOR DOB ì
  56. < DATE() - 3565 .AND. DEN <> 'W1' .AND. DEN <> 'W2' .AND. ì
  57. DTOC(LEFT) = '  /  /  '
  58.  
  59. * This routine computes tenure in unit
  60.  
  61. GO TOP
  62. SET DECIMALS TO 1
  63. DO WHILE .NOT. EOF()
  64.     IF DTOC(LEFT) = '  /  /  '
  65.     STORE (DATE() - JOINED)/30 TO MTENURE
  66.     ENDIF
  67.         IF DTOC(LEFT) <> '  /  /  '
  68.         STORE (LEFT-JOINED)/30 TO MROTATE
  69.         REPLACE ROTATE WITH MROTATE
  70.         REPLACE TENURE WITH MTENURE
  71.         ENDIF
  72. SKIP
  73. ENDDO
  74. AVERAGE TENURE TO FRED
  75. ?
  76. ? '              AVERAGE TENURE OF PRESENT CUBS '+STR(FRED)+'  ì
  77. Months'
  78. AVERAGE ROTATE FOR ROTATE > 0 TO MROTATE
  79. ?
  80. ? '              AVERAGE TENURE OF DEPARTED CUBS'+STR(MROTATE)+' ì
  81.  Months'
  82. ?
  83. *end of tenure routine
  84.  
  85. *? CHR(12)
  86. SET PRINT OFF
  87. TRIPS = TRIPS + 1
  88. IF TRIPS < 3
  89. WAIT 'Do You Want Hardcopy? (Y/N)' TO LOOKING
  90.     IF LOOKING = 'Y' .OR. LOOKING = 'y'
  91.         CLEAR
  92.         ? '                      ALIGN TOP OF PAPER WITH PRINTHEAD'
  93.         WAIT
  94.         SET PRINT ON
  95.         ? CHR(27)+CHR(99)+CHR(49)
  96.         ? CHR(27)+CHR(33)
  97.         LOOP
  98.         ELSE
  99.         ENDDO
  100.     ENDIF
  101. ENDIF
  102. RELEASE ALL
  103. CLEAR
  104. SET PRINT OFF
  105. RETURN
  106.