home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pssst.zip / PSINPUTP.PRG < prev    next >
Text File  |  1986-07-17  |  7KB  |  203 lines
  1.  
  2. * PSINPUTP.PRG
  3. *
  4. * A DBASE II 16BIT COMMAND FILE to allow input of phone information
  5. * to PHONE.DBF.  Went with this fancy schmancy one to try to eliminate
  6. * duplicate entries as this database may get quite large
  7. *
  8. * Version 1
  9. * By LTC Denny Hugg
  10. * ANGSC/DOS Andrews AFB MD 16 Jul 1985
  11. *
  12. * Version 2
  13. * modified by Maj Jim McMurry
  14. * ANGSC/DOSC Truax Field, WI 15 Jun 1986
  15. *
  16. USE PSPHONE
  17. GO BOTTOM
  18. STORE # TO last
  19. USE PSPHONE INDEX PSPHONEI
  20. ERASE
  21. * --- we won't reindex unless we need to
  22. STORE 'N' TO oneadded
  23. STORE ' ' TO response
  24. DO WHILE T
  25.    ERASE
  26.    STORE 'T E L E P H O N E   E N T R Y  /  E D I T' TO heading
  27.    DO PSHEADING
  28.    @ 22,79 SAY '                          ';
  29.               +'<RETURN>  To Exit This Module'
  30.    @  0, 0 SAY gcuron
  31.    STORE '           ' TO select
  32.    @ 22,26 SAY 'Enter Last Name ' GET select PICTURE '!!!!!!!!!!!'
  33.    READ NOUPDATE
  34.    @  0, 0 SAY gcuroff
  35.    @ 22, 0 SAY gclearline
  36.    @ 22,79 SAY gclearline
  37.    @ 10, 0 SAY ' '
  38. * --- give the guy a way out
  39. * --- we also want no leading blanks 'cause FIND won't find next time
  40.    IF select = '           '
  41.       STORE 10 TO line
  42.       STORE 'No Last Name Entered ... Returning To Phone Menu' TO prompt
  43.       DO PSPROMPT
  44.       IF oneadded = 'N'
  45.          STORE 1 TO counter
  46.          DO WHILE counter < gdelay
  47.             STORE counter + 1 TO counter
  48.          ENDDO
  49.       ELSE
  50.          * --- packing because of problems adding to an indexed file
  51.          * --- in dBase II
  52.          PACK
  53.       ENDIF
  54.       RELEASE ALL EXCEPT g*
  55.       USE
  56.       RETURN
  57.    ENDIF
  58.    IF $(select,1,1) = ' '
  59.       * --- he added some leading space(s)
  60.       STORE 1 TO pointer
  61.       * --- locate the first non-empty character
  62.       DO WHILE $(select,pointer,1) = ' '
  63.          STORE pointer + 1 TO pointer
  64.       ENDDO
  65.       * --- get the non-empty characters
  66.       STORE $(select,pointer,LEN(select)-pointer + 1) TO select
  67.    ENDIF
  68.    RELEASE pointer
  69. * --- use FIND just to see if one's there because it's so fast
  70. * --- won't find un-capitalized names in the old database
  71. * --- got to expect some losses in a big war
  72.    STORE TRIM(select) TO mlname
  73.    FIND &mlname
  74. * --- if at the end of the file
  75.    IF # = 0
  76.       @ 22,21 SAY 'This Is A New Name ... Enter The Data'
  77.       STORE 0 TO counter
  78.       DO WHILE counter < gdelay
  79.          STORE counter + 1 TO counter
  80.       ENDDO
  81.       APPEND BLANK
  82.       STORE 'Y' TO oneadded
  83.       REPLACE lname WITH mlname
  84.       STORE last + 1 TO last
  85.    ELSE
  86.       ERASE
  87.       STORE 1 TO line
  88.       STORE 'ALL ' + mlname + "S" TO prompt
  89.       DO PSPROMPT
  90.       @ 4, 0 SAY 'Rec #   Last Name    First    Rank    O/S    U #';
  91.                 +'   Type     Location   Phone'
  92.       @ 5, 0 SAY gline
  93. * --- the find command finds the first record meeting the requirements
  94. * --- extremely fast.  The display/skip combo below results in about
  95. * --- a 300% time savings over a plain vanilla DISPLAY command as
  96. * --- you don't have to go through the entire database.
  97.       STORE 0 TO line
  98.       DO WHILE .NOT. EOF .AND. !(lname) = mlname
  99.          IF line = 8 .OR. line = 19
  100.             @ 22,79 SAY '                   '+;
  101.                      'More To Come ... Strike Any Key To Continue'
  102.             SET CONSOLE OFF
  103.             WAIT
  104.             SET CONSOLE ON
  105.             ERASE
  106.             STORE 1 TO line
  107.             STORE 'ALL ' + mlname + "S" TO prompt
  108.             DO PSPROMPT
  109.             @ 4, 0 SAY 'Rec #   Last Name    First    Rank    O/S    U #';
  110.                       +'   Type     Location   Phone'
  111.             @ 5, 0 SAY gline
  112.             STORE 0 TO line
  113.          ENDIF
  114.          DISPLAY  ' '+lname+'  '+fname+'  '+rank+'   '+;
  115.                   offsym+'   '+unitno+'   '+unitype+'   '+icao+;
  116.                   '   '+state+'   '+avnop+'-'+avnos
  117.          STORE line + 1 TO line
  118.          SKIP
  119.       ENDDO
  120.       STORE '     ' TO select
  121.       @  0, 0 SAY gcuron
  122.       @ 22,79 SAY '             ';
  123.                  +'Enter # To Work On Or <RETURN> To Add A New Record ';
  124.               GET select PICTURE '99999'
  125.       READ NOUPDATE
  126.       @  0, 0 SAY gcuroff
  127.       IF select = '     '
  128.          APPEND BLANK
  129.          REPLACE lname WITH mlname
  130.          STORE last + 1 TO last
  131.          STORE 'Y' TO oneadded
  132.       ELSE
  133.          IF $(select,1,1) = ' '
  134.             * --- he added some leading space(s)
  135.             STORE 1 TO pointer
  136.             * --- locate the first non-empty character
  137.             DO WHILE $(select,pointer,1) = ' '
  138.                STORE pointer + 1 TO pointer
  139.             ENDDO
  140.             * --- get the non-empty characters
  141.             STORE $(select,pointer,LEN(select)-pointer + 1) TO select
  142.          ENDIF
  143.          RELEASE pointer
  144.          STORE TRIM(select) TO answer
  145.          IF VAL(answer) > last
  146.             ERASE
  147.             STORE 10 TO line
  148.             STORE "That Record Isn't In the Database ... We'll Try Again";
  149.                   TO prompt
  150.             DO PSPROMPT
  151.             STORE 0 TO counter
  152.             DO WHILE counter < gdelay
  153.                STORE counter + 1 TO counter
  154.             ENDDO
  155.             LOOP
  156.          ENDIF
  157.          GO VAL(answer)
  158.       ENDIF
  159.    ENDIF
  160.    ERASE
  161.    STORE 2 TO line
  162.    STORE 'T E L E P H O N E   E N T R Y  /  E D I T' TO prompt
  163.    DO PSPROMPT
  164.    @  0, 0 SAY gcuron
  165. * --- we're going to force caps to make it look uniform
  166.    @  5, 4 SAY 'Rank      ';
  167.            GET  rank PICTURE '!!!!!'
  168.    @  5,24 SAY 'First Name ';
  169.            GET  fname PICTURE '!!!!!!!'
  170.    @  5,49 SAY 'Last Name '
  171.    @  5,60 SAY  lname
  172.    @  7, 4 SAY 'Unit No.  ';
  173.            GET  unitno PICTURE '999'
  174.    @  9, 4 SAY 'ICAO      ';
  175.            GET  icao PICTURE '!!!'
  176.    @  9,29 SAY 'State ';
  177.            GET  state PICTURE '!!'
  178.    @ 11, 4 SAY 'Unit Type ';
  179.            GET  unitype PICTURE '!!!!!!'
  180.    @ 13, 4 SAY 'Off/Sym   ';
  181.            GET  offsym PICTURE '!!!!'
  182.    @ 15, 4 SAY 'Phone     ';
  183.            GET  avnop PICTURE '999'
  184.    @ 15,17 SAY '-';
  185.            GET  avnos PICTURE '9999'
  186.    @ 17, 4 SAY 'Subject   ';
  187.            GET  subject PICTURE '!!!!!!!!!!!!!!!!'
  188. * --- he can use small letters for remarks if he wants to
  189.    @ 19, 4 SAY 'Remarks   ';
  190.            GET  rem1
  191.    @ 20,14 GET  rem2
  192.    READ
  193.    @  0, 0 SAY gcuroff
  194. ENDDO T
  195. * --- EOF PSINPUTP.PRG
  196. RG
  197. 1) = ' '
  198.             * --- he added some leading space(s)
  199.             STORE 1 TO pointer
  200.             * --- locate the first non-empty character
  201.             DO WHILE $(select,pointer,1) = ' '
  202.                STORE pointer + 1 TO pointer
  203.             END