home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pssst.zip / PSREORDR.PRG < prev    next >
Text File  |  1986-07-16  |  6KB  |  187 lines

  1. * PSREORDR.PRG
  2. *
  3. * A DBASE II 16BIT COMMAND FILE which looks for duplicate priorities
  4. * then forces change
  5. *
  6. * Version 1
  7. * By LTC Denny Hugg
  8. * ANGSC/DOS Andrews AFB MD 16 Jul 1985
  9. *
  10. * Version 2
  11. * modified by Maj Jim McMurry
  12. * ANGSC/DOSC Truax Field, WI 15 Jun 1986
  13. *
  14. ERASE
  15. STORE 'P R I O R I T Y   R E - O R D E R I N G' TO heading
  16. DO PSHEADING
  17. USE &gsusfile
  18. GO BOTTOM
  19. STORE # TO last
  20. IF last = 0
  21.    STORE 10 TO line
  22.    STORE 'You Have No Suspense Items ' + gfirstname TO prompt
  23.    DO PSPROMPT
  24.    STORE 12 TO line
  25.    STORE ' Returning To Priority Management Menu' TO prompt
  26.    DO PSPROMPT
  27.    STORE 0 TO timer
  28.    DO WHILE TIMER < gdelay
  29.       STORE timer + 1 TO timer
  30.    ENDDO
  31.    USE
  32.    RETURN
  33. ENDIF
  34. * --- indexed on priority
  35. USE &gsusfile INDEX &gpryindex
  36. * --- find the last zero priority
  37. STORE 0 TO lastzero
  38. DO WHILE priority = '0.00'
  39.    STORE # TO lastzero
  40.    SKIP
  41.    LOOP
  42. ENDDO
  43. IF EOF
  44.    STORE 10 TO line
  45.    STORE 'You Have No Priorities To Analyze' +gfirstname TO prompt
  46.    DO PSPROMPT
  47.    STORE 12 TO line
  48.    STORE 'Returning To Priority Management Menu' TO prompt
  49.    DO PSPROMPT
  50.    STORE 0 TO timer
  51.    DO WHILE timer < gdelay
  52.       STORE timer + 1 TO timer
  53.    ENDDO
  54.    USE
  55.    RELEASE ALL EXCEPT g*
  56.    RETURN
  57. ENDIF
  58. DO WHILE T
  59.    ERASE
  60.    @ 10,21 SAY 'Searching For Duplicate Priorities ...'
  61.    STORE 'N' TO duplicate
  62.    * --- find duplicate priorities
  63.    DO WHILE .NOT. EOF .AND. duplicate = 'N'
  64.       STORE priority TO oldprio
  65.       STORE # TO firstdup
  66.       SKIP
  67.       STORE priority TO newprio
  68.       * --- the priorities are the same
  69.       IF .NOT. EOF .AND. oldprio = newprio .AND. priority <> '0.00'
  70.          STORE 'Y' TO duplicate
  71.       ENDIF
  72.    ENDDO
  73.    IF duplicate = 'Y'
  74.       * --- position on first duplicate
  75.       GO firstdup
  76.       ERASE
  77.       STORE 1 TO line
  78.       STORE 'DUPLICATE PRIORITIES' TO prompt
  79.       DO PSPROMPT
  80.       @  4, 0 SAY 'Rec #  Prio  Description'
  81.       @  4,70 SAY 'Due Date'
  82.       @  5, 0 SAY gline
  83.       * --- display the duplicates
  84.       DO WHILE .NOT. EOF .AND. priority = oldprio
  85.          DISPLAY priority + '  ' + descrip + '  ' + duedate
  86.          SKIP
  87.       ENDDO
  88.       STORE '     ' TO select
  89.       @  0, 0 SAY gcuron
  90.       DO WHILE select = '     '
  91.          @ 22,79 SAY '              ';
  92.                     +'You Have Duplicates ... Enter Record # To Change ';
  93.                  GET select PICTURE '99999'
  94.          READ NOUPDATE
  95.       ENDDO
  96.       @  0, 0 SAY gcuroff
  97.       @ 22,79 SAY gclearline
  98.       IF $(select,1,1) = ' '
  99.          * --- he added some leading space(s)
  100.          STORE 1 TO pointer
  101.          * --- locate the first non-empty character
  102.          DO WHILE $(select,pointer,1) = ' '
  103.             STORE pointer + 1 TO pointer
  104.          ENDDO
  105.          * --- get the non-empty characters
  106.          STORE $(select,pointer,LEN(select)-pointer + 1) TO select
  107.       ENDIF
  108.       * --- we may use this if the record doesn't exist
  109.       STORE TRIM(select) TO recno
  110.       STORE '0000' TO zeros
  111.       STORE $(zeros,1,5-LEN(recno)) + recno TO recno
  112.       IF VAL(recno) > last
  113.          @ 22,79 SAY gclearline
  114.          @ 22,79 SAY '                        ';
  115.                    + 'There Is No ' + recno + ' In Your Database'
  116.          STORE 1 TO timer
  117.          DO WHILE timer < gdelay
  118.             STORE timer + 1 TO timer
  119.          ENDDO
  120.          GO firstdup
  121.          STORE '     ' TO select
  122.          LOOP
  123.       ENDIF
  124.       RELEASE select
  125.       GO VAL(recno)
  126.       STORE '    ' TO mpriority
  127.       @  0, 0 SAY gcuron
  128.       @ 22,79 SAY '             '+;
  129.                 'The Present Priority is '+priority+' ... Enter New Priority ';
  130.               GET mpriority PICTURE '9.99'
  131.       READ NOUPDATE
  132.       @  0, 0 SAY gcuroff
  133.       * --- fill in other zeros as priority is a character field
  134.       STORE TRIM(mpriority) TO mpriority
  135.       IF mpriority = ' .' .OR. mpriority = '0.' .OR. mpriority = '0.0'
  136.          STORE '0.00' TO mpriority
  137.       ELSE
  138.          STORE '00' TO zeros
  139.          STORE mpriority + $(zeros,1,4-LEN(mpriority)) TO mpriority
  140.       ENDIF
  141.       IF mpriority <> priority
  142.          REPLACE priority with mpriority
  143.          * --- go back to beginning in case he made a low priority a high one
  144.          IF lastzero <> 0
  145.             GO lastzero
  146.          ELSE
  147.             * --- there were no 0 priorities
  148.             GO TOP
  149.          ENDIF
  150.       ELSE
  151.          @ 22,79 SAY gclearline
  152.          @ 22,79 SAY '                      ';
  153.                     +"That's The Same Priority ... Try Again'
  154.          * --- redisplay the list of records just as they were
  155.          GO firstdup
  156.       ENDIF
  157.    ELSE
  158.       @ 10, 0 SAY gclearline
  159.       STORE 10 TO line
  160.       STORE 'There Are No Duplicate Priorities In Your File ';
  161.                            + gfirstname TO prompt
  162.       DO PSPROMPT
  163.       STORE 12 TO line
  164.       STORE 'Proceeding To View Your Priorities Now' TO prompt
  165.       DO PSPROMPT 
  166.       STORE 0 TO timer
  167.       DO WHILE timer < gdelay
  168.          STORE timer + 1 TO timer
  169.       ENDDO
  170.       USE
  171.       RELEASE ALL EXCEPT g*
  172.       DO PSVIEWPR
  173.       RETURN
  174.    ENDIF
  175. ENDDO T
  176. * EOF PSREORDR.PRG
  177. pointer + 1 TO pointer
  178.          ENDDO
  179.          * --- get the non-empty characters
  180.          STORE $(select,pointer,LEN(select)-pointer + 1) TO select
  181.       ENDIF
  182.       * --- we may use this if the record doesn't exist
  183.       STORE TRIM(select) TO recno
  184.       STORE '0000' TO zeros
  185.       STORE $(zeros,1,5-LEN(recno)) + recno TO recno
  186.       IF VAL(recno) > last
  187.          @ 22,7