home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pssst.zip / PSVIEWPR.PRG < prev   
Text File  |  1986-07-16  |  7KB  |  231 lines

  1. * PSVIEWPR.PRG
  2. *
  3. * A DBASE II 16BIT COMMAND FILE to allow viewing tasks in order of
  4. * priority and forcing a choice between duplicate priorities.  Suspense
  5. * items may be removed from, or relocated on the priority list.
  6. * This was the first shot at forcing elimination of duplicates, but it
  7. * seemed too slow when there were a lot of them.  This is designed to
  8. * be used now after they've been ordered with PSREORDR, however, it
  9. * still catches duplicates
  10. *
  11. * Version 1
  12. * By LTC Denny Hugg
  13. * ANGSC/DOS Andrews AFB MD 16 Jul 1985
  14. *
  15. * Version 2
  16. * modified by Maj Jim McMurry
  17. * ANGSC/DOSC Truax Field, WI 15 Jun 1986
  18. *
  19. ERASE
  20. STORE 'V I E W   P R I O R I T Y   I T E M S' TO heading
  21. DO PSHEADING
  22. USE &gsusfile
  23. GO BOTTOM
  24. STORE # TO last
  25. IF last = 0
  26.    STORE 10 TO line
  27.    STORE 'You Have No Suspense Items To Prioritize ' + gfirstname TO prompt
  28.    DO PSPROMPT
  29.    STORE 12 TO line
  30.    STORE 'Returning To Priority Management Menu' TO prompt
  31.    DO PSPROMPT
  32.    STORE 0 TO timer
  33.    DO WHILE TIMER < gdelay
  34.       STORE timer + 1 TO timer
  35.    ENDDO
  36.    USE
  37.    RELEASE ALL EXCEPT g*
  38.    RETURN
  39. ENDIF
  40. * --- indexed on priority
  41. USE &gsusfile INDEX &gpryindex
  42. STORE 10 TO line
  43. STORE 'You May Remove Items From The Priority List' TO prompt
  44. DO PSPROMPT
  45. STORE 12 TO line
  46. STORE 'By Assigning Them Priority 0.00' TO prompt
  47. DO PSPROMPT
  48. STORE 0 TO timer
  49. DO WHILE timer < gdelay
  50.    STORE timer + 1 TO timer
  51. ENDDO
  52. DO WHILE T
  53.    * --- wish I could get past the 0's quicker without moving them
  54.    * --- out of the file.  That would be slower anyway
  55.    * --- this needs to stay in the loop as this procedure can be
  56.    * --- quite dynamic.  Shouldn't have many 0 priorities anyway
  57.    IF priority = '0.00'
  58.       SKIP
  59.       LOOP
  60.    ENDIF
  61.    IF EOF
  62.       * --- there's nobody home (anymore?)
  63.       @  9, O SAY gclearline
  64.       @ 10, 0 SAY gclearline
  65.       @ 11, 0 SAY gclearline
  66.       @ 12, 0 SAY gclearline
  67.       @ 13, 0 SAY gclearline
  68.       STORE 10 TO line
  69.       STORE 'You Have No Priorities To Analyze ' + gfirstname TO prompt
  70.       DO PSPROMPT
  71.       STORE 12 TO line
  72.       STORE 'Returning To Priority Management Menu' TO prompt
  73.       DO PSPROMPT
  74.       STORE 0 TO timer
  75.       DO WHILE timer < gdelay
  76.          STORE timer + 1 TO timer
  77.       ENDDO
  78.       USE
  79.       RELEASE ALL EXCEPT g*
  80.       RETURN
  81.    ENDIF
  82.    STORE 'N' TO needchange
  83.    STORE 0 TO counter
  84.    CLEAR GETS
  85.    ERASE
  86.    STORE 1 TO line
  87.    STORE 'VIEWING PRIORITIES' TO prompt
  88.    DO PSPROMPT
  89.    @  4, 0 SAY 'Rec #  Prio  Description'
  90.    @  4,70 SAY 'Due Date'
  91.    @  5, 0 SAY gline
  92.    @  5,78 SAY ' '
  93.    STORE # TO firstshown
  94.    DO WHILE .NOT. EOF .AND. counter < 15
  95.       DISPLAY priority + '  ' + descrip + '  ' + duedate
  96.       STORE priority TO oldrecord
  97.       SKIP
  98.       STORE counter + 1 TO counter
  99.       * --- flags us if any two records on the screen are the same priority
  100.       * --- but we'll only do it when necessary
  101.       IF needchange = 'N'
  102.          IF .NOT. EOF .AND. counter < 15
  103.             STORE priority to newrecord
  104.             IF oldrecord = newrecord
  105.                STORE 'Y' TO needchange
  106.             ENDIF
  107.          ENDIF
  108.       ENDIF
  109.    ENDDO
  110.    STORE '     ' TO select
  111.    @  0, 0 SAY gcuron
  112.    IF needchange = 'Y'
  113.       @ 22,79 SAY '         ';
  114.                 +'You Have Duplicate Priorities ... Enter Record # To Change ';
  115.               GET select PICTURE '99999'
  116.    ELSE
  117.       @ 22,79 SAY '           ';
  118.                  +'Enter # Of Priority To Change Or <RETURN> To Continue ';
  119.               GET select PICTURE '99999'
  120.    ENDIF
  121.    READ NOUPDATE
  122.    @  0, 0 SAY gcuroff
  123.    @ 22,79 SAY gclearline
  124.    IF select = '     '
  125.       * --- this is the only exit as we want him reviewing all priorities
  126.       IF EOF
  127.          ERASE
  128.          STORE 10 TO line
  129.          STORE 'Thats The End Of Your Records '+gfirstname TO prompt
  130.          DO PSPROMPT
  131.          STORE 12 TO line
  132.          STORE 'Returning To Priority Management Menu' TO prompt
  133.          DO PSPROMPT
  134.          STORE 0 TO timer
  135.          DO WHILE timer < gdelay
  136.             STORE timer + 1 TO timer
  137.          ENDDO
  138.          USE
  139.          RELEASE ALL EXCEPT g*
  140.          RETURN
  141.       ELSE
  142.          * --- a priority for everything and everything in it's priority
  143.          IF needchange = 'Y'
  144.             @ 22,79 SAY '                         ';
  145.                        +"You've Still Got Duplicates ..."
  146.             STORE 0 TO timer
  147.             DO WHILE timer < gdelay
  148.                STORE timer + 1 TO timer
  149.             ENDDO
  150.             GO firstshown
  151.             LOOP
  152.          ENDIF
  153.          * --- display the last item from the previous display in case
  154.          * --- it and the next item were duplicates
  155.          SKIP -1
  156.          LOOP
  157.       ENDIF
  158.    ELSE
  159.       IF $(select,1,1) = ' '
  160.          * --- he added some leading space(s)
  161.          STORE 1 TO pointer
  162.          * --- locate the first non-empty character
  163.          DO WHILE $(select,pointer,1) = ' '
  164.             STORE pointer + 1 TO pointer
  165.          ENDDO
  166.          * --- get the non-empty characters
  167.          STORE $(select,pointer,LEN(select)-pointer + 1) TO select
  168.       ENDIF
  169.       STORE TRIM(select) TO recno
  170.       * --- make the record number a standard length for display
  171.       STORE '0000' TO zeros
  172.       STORE $(zeros,1,5-LEN(recno)) + recno TO recno
  173.    ENDIF
  174.    * --- make sure he doesn't enter a bogus record number
  175.    IF VAL(recno) > last
  176.       @ 22,79 SAY gclearline
  177.       @ 22,79 SAY '                        ';
  178.                 + 'There Is No ' + recno + ' In Your Database'
  179.       STORE 1 TO timer
  180.       DO WHILE timer < gdelay
  181.          STORE timer + 1 TO timer
  182.       ENDDO
  183.       GO firstshown
  184.       LOOP
  185.    ENDIF
  186.    GO VAL(recno)
  187.    STORE '    ' TO mpriority
  188.    @  0, 0 SAY gcuron
  189.    @ 22,79 SAY '             '+;
  190.                'The Present Priority is '+priority+' ... Enter New Priority ';
  191.            GET mpriority PICTURE '9.99'
  192.    READ NOUPDATE
  193.    @  0, 0 SAY gcuroff
  194.    STORE TRIM(mpriority) TO mpriority
  195.    IF mpriority = ' .' .OR. mpriority = '0.' .OR. mpriority = '0.0'
  196.       STORE '0.00' TO mpriority
  197.    ELSE
  198.       STORE '00' TO zeros
  199.       STORE mpriority + $(zeros,1,4-LEN(mpriority)) TO mpriority
  200.    ENDIF
  201.    IF mpriority <> priority
  202.       REPLACE priority with mpriority
  203.       * --- go back to beginning in case he made a low priority a high one
  204.       GO TOP
  205.    ELSE
  206.       @ 22,79 SAY gclearline
  207.       @ 22,79 SAY '                      ';
  208.                  +"That's The Same Priority ... Try Again"
  209.       * --- redisplay the list of records just as they were
  210.       STORE 0 TO timer
  211.       DO WHILE timer < gdelay
  212.          STORE timer + 1 TO timer
  213.       ENDDO
  214.       GO firstshown
  215.    ENDIF
  216. ENDDO T
  217. * EOF PSVIEWPR.PRG
  218.  
  219. IP -1
  220.          LOOP
  221.       ENDIF
  222.    ELSE
  223.       IF $(select,1,1) = ' '
  224.          * --- he added some leading space(s)
  225.          STORE 1 TO pointer
  226.          * --- locate the first non-empty character
  227.          DO WHILE $(select,pointer,1) = ' '
  228.             STORE pointer + 1 TO pointer
  229.          ENDDO
  230.          * --- get the non-empty characters
  231.