home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / cubs / main.prg < prev    next >
Encoding:
Text File  |  1989-03-31  |  9.6 KB  |  456 lines
  1. *MAIN.PRG
  2.  
  3. PROCEDURE ldrprint.prg
  4.  
  5.  
  6. *LDRPRINT.PRG
  7.  
  8. CLEAR
  9. ? '                   ALIGN TOP OF PAPER WITH PRINTHEAD'
  10. ?
  11. WAIT ' Press any key to begin printing...'
  12. SET TALK OFF
  13. SET PRINT ON
  14. ? CHR(27)+CHR(99)+CHR(49)
  15. SET MARGIN TO 3
  16. ?
  17. ?
  18. ? CHR(14)+CHR(27)+CHR(33)
  19. ? '        CUBSCOUT PACK 240'
  20. ? CHR(15)+'                           Vilseck, GE'
  21. STORE DATE() TO MDATE
  22. ?
  23. ?
  24. ? '                                                         ì
  25.         '+DTOC(MDATE)
  26. ?
  27. ?
  28. ? CHR(27)+CHR(81)+CHR(27)+CHR(34)
  29. ? 'SCOUT                  POSITION             RESIDENCE              ì
  30.     MAILING ADDRESS                HOME          DUTY'
  31. ?
  32. STORE 0 TO LINECNT
  33. DO WHILE .NOT. EOF()
  34. IF DTOC(LEFT) = '  /  /  '
  35. ? SCOUT, POSITION, RESIDENCE, ADDRESS, HOME, DUTY
  36. ?
  37. LINECNT = LINECNT + 1
  38. SKIP
  39.     IF LINECNT >21
  40.     ? CHR(10)+CHR(10)+CHR(10)+CHR(10)+CHR(10)+CHR(10)
  41.     ? CHR(10)+CHR(10)+CHR(10)
  42.     ? 'SCOUT                  POSITION             RESIDENCE        ì
  43.           MAILING ADDRESS                HOME          DUTY '
  44.     ?
  45.     STORE 0 TO LINECNT
  46.    ENDIF
  47. ENDIF
  48. ENDDO
  49. ?
  50. ?
  51. ? CHR(27)+CHR(69)
  52. ? 'Records Reported'+STR(LINECNT)
  53. ? CHR(12)
  54. SET PRINT OFF
  55. RETURN
  56.  
  57. return
  58.  
  59.  
  60.  
  61. PROCEDURE rosters.prg
  62.  
  63. *ROSTERS.PRG
  64.  
  65. CLEAR
  66. SET TALK OFF
  67.  
  68. ? '                                 PRINT MENU'
  69. ?
  70. ?
  71. ?
  72. ?
  73. ? '            1. Print All Rosters              6. Print Den 3  '
  74. ?
  75. ? '            2. Print Leaders Only             7. Print Den W1 '
  76. ?
  77. ? '            3. Print All Cubs                 8. Print Den W2 '
  78. ?
  79. ? '            4. Print Den 1                    9. Not Used   '
  80. ?
  81. ? '            5. Print Den 2                    0. Exit to Main Menu'
  82. ?
  83. ?
  84. ?
  85. ?
  86. WAIT '                           PICK A NUMBER...' TO CHOICE
  87.  
  88. DO CASE
  89.     CASE CHOICE = '1'
  90.         SELECT 2
  91.         GO TOP
  92.         SET FILTER TO DTOC(LEFT) = '  /  /  '
  93.         DO LDRPRINT
  94.  
  95.         SELECT 1
  96.         GO TOP
  97.         STORE ' ALLCUBS' TO MDEN
  98.         SET FILTER TO DTOC(LEFT) = '  /  /  '
  99.         DO CUBPRINT
  100.  
  101.         SELECT 1
  102.         SET FILTER TO DEN = '1' .AND. DTOC(LEFT) = '  /  /  '
  103.         GO TOP
  104.         STORE ' DEN 1' TO MDEN
  105.         DO CUBPRINT
  106.  
  107.         SELECT 1
  108.         SET FILTER TO DEN = '2' .AND. DTOC(LEFT) = '  /  /  '
  109.         GO TOP
  110.         STORE ' DEN 2' TO MDEN
  111.         DO CUBPRINT
  112.  
  113.         SELECT 1
  114.         SET FILTER TO DEN = '3' .AND. DTOC(LEFT) = '  /  /  '
  115.         GO TOP
  116.         STORE ' DEN 3' TO MDEN
  117.         DO CUBPRINT
  118.  
  119.         SELECT 1
  120.         SET FILTER TO DEN = 'W1'  .AND. DTOC(LEFT) = '  /  /  '
  121.         GO TOP
  122.         STORE 'DEN W1' TO MDEN
  123.         DO CUBPRINT
  124.  
  125.         SELECT 1
  126.         SET FILTER TO DEN = 'W2' .AND. DTOC(LEFT) = '  /  /  '
  127.         GO TOP
  128.         STORE 'DEN W2' TO MDEN
  129.         DO CUBPRINT
  130.  
  131.     CASE CHOICE = '2'
  132.         SELECT 2
  133.         SET FILTER TO DTOC(LEFT) = '  /  /  '
  134.         GO TOP
  135.         DO LDRPRINT
  136.  
  137.     CASE CHOICE = '3'
  138.         SELECT 1
  139.         SET FILTER TO DTOC(LEFT) = '  /  /  '
  140.         GO TOP
  141.         STORE ' ALLCUBS' TO MDEN
  142.         CLEAR
  143.         ? '                  ALIGN TOP OF PAPER WITH PRINTHEAD'
  144.         ?
  145.         WAIT ' Press any key to begin printing...'
  146.         DO CUBPRINT
  147.  
  148.     CASE CHOICE = '4'
  149.         SELECT 1
  150.         SET FILTER TO DEN = '1' .AND. DTOC(LEFT) = '  /  /  '
  151.         GO TOP
  152.         STORE ' DEN 1' TO MDEN
  153.         CLEAR
  154.         ? '                  ALIGN TOP OF PAPER WITH PRINTHEAD'
  155.         ?
  156.         WAIT ' Press any key to begin printing...'
  157.         DO CUBPRINT
  158.  
  159.     CASE CHOICE = '5'
  160.         SELECT 1
  161.         SET FILTER TO DEN = '2' .AND. DTOC(LEFT) = '  /  /  '
  162.         GO TOP
  163.         STORE ' DEN 2' TO MDEN
  164.         CLEAR
  165.         ? '                  ALIGN TOP OF PAPER WITH PRINTHEAD'
  166.         ?
  167.         WAIT ' Press any key to begin printing...'
  168.         DO CUBPRINT
  169.  
  170.     CASE CHOICE = '6'
  171.         SELECT 1
  172.         SET FILTER TO DEN = '3' .AND. DTOC(LEFT) = '  /  /  '
  173.         GO TOP
  174.         STORE ' DEN 3' TO MDEN
  175.         CLEAR
  176.         ? '                  ALIGN TOP OF PAPER WITH PRINTHEAD'
  177.         ?
  178.         WAIT ' Press any key to begin printing...'
  179.         DO CUBPRINT
  180.  
  181.     CASE CHOICE = '7'
  182.         SELECT 1
  183.         SET FILTER TO DEN = 'W1' .AND. DTOC(LEFT) = '  /  /  '
  184.         GO TOP
  185.         STORE 'DEN W1' TO MDEN
  186.         CLEAR
  187.         ? '                  ALIGN TOP OF PAPER WITH PRINTHEAD'
  188.         ?
  189.         WAIT ' Press any key to begin printing...'
  190.         DO CUBPRINT
  191.  
  192.     CASE CHOICE = '8'
  193.         SELECT 1
  194.         SET FILTER TO DEN = 'W2' .AND. DTOC(LEFT) = '  /  /  '
  195.         GO TOP
  196.         STORE 'DEN W2' TO MDEN
  197.         CLEAR
  198.         ? '                  ALIGN TOP OF PAPER WITH PRINTHEAD'
  199.         ?
  200.         WAIT ' Press any key to begin printing...'
  201.         DO CUBPRINT
  202.     CASE CHOICE = '9'
  203.  
  204.     CASE CHOICE = '0'
  205.         RETURN
  206.  
  207. RELEASE ALL
  208. ENDCASE CHOICE
  209. ENDDO
  210.  
  211. return
  212.  
  213. PROCEDURE cubprint.prg
  214.  
  215. *CUBPRINT.PRG
  216.  
  217. CLEAR
  218. SET TALK OFF
  219. SET PRINT ON
  220. SET MARGIN TO 5
  221. ? CHR(27)+CHR(99)+CHR(49)
  222. ?
  223. ?
  224. ?
  225. ?
  226. ? CHR(14)+CHR(27)+CHR(33)
  227. ? '      CUBSCOUT PACK 240'
  228. ? CHR(15)+'                        Vilseck, GE'
  229. ?
  230. ?
  231. STORE DATE() TO MDATE
  232. IF MDEN = ' ALLCUBS'
  233.     ? '                                                          ì
  234.      '+MDEN
  235. ELSE
  236. ? '                                                               ì
  237.   '+MDEN
  238. ENDIF
  239. ? '                                                               '+DTOC(MDATE)
  240. ?
  241. ?
  242. ?
  243. ? CHR(27)+CHR(81)+CHR(27)+CHR(34)
  244. ? 'SCOUT                         DOB            RESIDENCE          ì
  245.                     HOME               DUTY              DEN'
  246. ?
  247. STORE 1 TO PAGCNT
  248. STORE 0 TO PAGECNT
  249. STORE 0 TO LINECNT
  250. DO WHILE .NOT. EOF()
  251. IF DTOC(LEFT) = '  /  /  ';*
  252. ? SCOUT, DOB, '     ', RESIDENCE,' ', HOME, DUTY, DEN
  253. ?
  254. LINECNT = LINECNT+1
  255. SKIP
  256.     IF LINECNT >21
  257.     ?
  258.     ? CHR(12)
  259.     ? CHR(10)+CHR(10)+CHR(10)+CHR(10)
  260. ? 'SCOUT                         DOB            RESIDENCE           ì
  261.                    HOME               DUTY              DEN'
  262.     ?
  263.     STORE 0 TO LINECNT
  264.     PAGECNT = PAGECNT + 1
  265.     PAGCNT = PAGCNT + 1
  266.     ENDIF
  267. ENDIF;*
  268. ENDDO
  269. ?
  270. ? CHR(27)+CHR(69)
  271. ? 'RECORDS REPORTED' +STR(LINECNT + PAGECNT * 22)
  272. ?
  273. ?
  274. *? '                              Page ' +STR(PAGCNT)
  275. ? CHR(12)
  276. SET PRINT OFF
  277. RETURN
  278.  
  279. return
  280.  
  281. PROCEDURE search.prg
  282.  
  283. *SEARCH.PRG
  284.  
  285. CLEAR
  286. ? '       The entire name is not required, just enough to identify ì
  287. him.'
  288. ?
  289. ? '                    Capitalization must be correct!'
  290. ?
  291. ?
  292.  
  293. ACCEPT "Enter Scout's last name, first name  " to cubber
  294. FIND &CUBBER
  295. IF EOF() = .T.
  296. CLEAR
  297. @ 12,23 say "Couldn't find that Cub Scout"
  298. ?
  299. ?
  300. ?
  301. ?
  302. ?
  303. ?
  304. ?
  305. WAIT
  306. RETURN
  307. ELSE
  308. SET FORMAT TO LOOKCUB
  309. EDIT
  310.  
  311.  
  312. return
  313.  
  314. PROCEDURE stats.prg
  315.  
  316. *STATS.PRG
  317.  
  318. SET TALK OFF
  319. CLEAR
  320. ?
  321. ? "                             I'm counting Leaders"
  322. SELECT 2
  323. COUNT TO MLDR
  324. ? '                             '+STR(MLDR)
  325. SELECT 1
  326. ?
  327. CLEAR
  328. ? "                          Now I'm counting Cub Scouts"
  329.  
  330. COUNT TO MCUBS FOR DTOC(LEFT) = '  /  /  '
  331. ? '                              '+STR(MCUBS)
  332. COUNT FOR DEN = '1' .AND. DTOC(LEFT) = '  /  /  ' TO CNT1
  333. COUNT FOR DEN = '2' .AND. DTOC(LEFT) = '  /  /  ' TO CNT2
  334. COUNT FOR DEN = '3' .AND. DTOC(LEFT) = '  /  /  ' TO CNT3
  335. CLEAR
  336. ?
  337. ?
  338. ?
  339. CLEAR
  340. ? '                       Where did you get all these kids?'
  341. COUNT FOR DEN = 'W1' .AND. DTOC(LEFT) = '  /  /  ' TO CNTW1
  342. COUNT FOR DEN = 'W2' .AND. DTOC(LEFT) = '  /  /  ' TO CNTW2
  343. STORE 'Y' TO LOOKING
  344. STORE 1 TO TRIPS
  345. GO TOP
  346. DO WHILE .NOT. EOF()
  347. DO WHILE LOOKING = 'y' .OR. LOOKING = 'Y'
  348. CLEAR
  349. ? CHR(10)+CHR(10)+CHR(10)
  350. ? '                             PACK STATISTICS            ì
  351.         '+DTOC(DATE())
  352. ?
  353. ? '       Ldrs      Cubs     Den 1     Den 2     Den 3     DenW1    ì
  354.   DenW2'
  355. ?
  356. ? STR(MLDR)+STR(MCUBS)+STR(CNT1)+STR(CNT2)+STR(CNT3)+STR(CNTW1)+STR(CNTW2)
  357. ?
  358. ?
  359. ?
  360. ? '                     Webelos approaching 11 years of age'
  361. ?
  362. SET HEADING OFF
  363. DISPLAY OFF     FIELDS '            ',SCOUT, DOB,'      ', DEN FOR ì
  364. DOB < DATE() - 3970 .AND. DTOC(LEFT) = '  /  /  '
  365. ?
  366. ?
  367. ? '                    Cub Scouts approaching 10 years of age'
  368. ?
  369. DISPLAY OFF     FIELDS '            ',SCOUT, DOB, '       ', DEN FOR DOB ì
  370. < DATE() - 3565 .AND. DEN <> 'W1' .AND. DEN <> 'W2' .AND. ì
  371. DTOC(LEFT) = '  /  /  '
  372.  
  373. * This routine computes tenure in unit
  374.  
  375. GO TOP
  376. SET DECIMALS TO 1
  377. DO WHILE .NOT. EOF()
  378.     IF DTOC(LEFT) = '  /  /  '
  379.     STORE (DATE() - JOINED)/30 TO MTENURE
  380.     ENDIF
  381.         IF DTOC(LEFT) <> '  /  /  '
  382.         STORE (LEFT-JOINED)/30 TO MROTATE
  383.         REPLACE ROTATE WITH MROTATE
  384.         REPLACE TENURE WITH MTENURE
  385.         ENDIF
  386. SKIP
  387. ENDDO
  388. AVERAGE TENURE TO FRED
  389. ?
  390. ? '              AVERAGE TENURE OF PRESENT CUBS '+STR(FRED)+'  ì
  391. Months'
  392. AVERAGE ROTATE FOR ROTATE > 0 TO MROTATE
  393. ?
  394. ? '              AVERAGE TENURE OF DEPARTED CUBS'+STR(MROTATE)+' ì
  395.  Months'
  396. ?
  397. *end of tenure routine
  398.  
  399. *? CHR(12)
  400. SET PRINT OFF
  401. TRIPS = TRIPS + 1
  402. IF TRIPS < 3
  403. WAIT 'Do You Want Hardcopy? (Y/N)' TO LOOKING
  404.     IF LOOKING = 'Y' .OR. LOOKING = 'y'
  405.         CLEAR
  406.         ? '                      ALIGN TOP OF PAPER WITH PRINTHEAD'
  407.         WAIT
  408.         SET PRINT ON
  409.         ? CHR(27)+CHR(99)+CHR(49)
  410.         ? CHR(27)+CHR(33)
  411.         LOOP
  412.         ELSE
  413.         ENDDO
  414.     ENDIF
  415. ENDIF
  416. RELEASE ALL
  417. CLEAR
  418. SET PRINT OFF
  419. RETURN
  420.  
  421.  
  422.  
  423. return
  424.  
  425. PROCEDURE lookldr.prg
  426.  
  427. *LOOKLDR.PRG
  428.  
  429. CLEAR
  430. ? '       The entire name is not required, just enough to identify him.'
  431. ?
  432. ? '                     Capitalization must be correct!'
  433. ?
  434. ?
  435. ACCEPT "Enter Leader's last name, first name  " to cubber
  436. FIND &CUBBER
  437. IF EOF() = .T.
  438. CLEAR
  439. @ 12,22 SAY "Couldn't find that Leader"
  440. ?
  441. ?
  442. ?
  443. ?
  444. ?
  445. ?
  446. ?
  447. ?
  448. WAIT
  449. RETURN
  450. ELSE
  451. SET FORMAT TO LOOKLDR
  452. EDIT
  453.  
  454.  
  455. return
  456.