Shareware Overload/ShartewareOverload.cdr/database/pssst.zip/PSDELETP.PRG

Text File | 1986-07-17 | 12KB | 327 lines

* PSDELETP.PRG
*
* A DBASE II 16BIT COMMAND FILE to allow deletion of records from
* the PHONE datafile. The selection may be the scan mode which
* allows viewing/deleting, either by selecting a letter or going through
* the entire alphabet letter by letter.
*
* Version 1
* By LTC Denny Hugg
* ANGSC/DOS Andrews AFB MD 16 Jul 1985
*
* Version 2
* modified by Maj Jim McMurry
* ANGSC/DOSC Truax Field, WI 15 Jun 1986
*
* --- makes extensive use of the technique where we write to the last
* --- column of line 22 to get the display on line 23 without screen jump.
*
*
USE PSPHONE
GO BOTTOM
* --- for use in checking if selected record is in range
STORE # TO last
* --- displays will be alphabetical based on last name as that is how
* --- PSPHONEI is indexed.  Deletions will be automatically updated
USE PSPHONE INDEX PSPHONEI
* --- we won't pack unless a deletion has been made
STORE 'N' TO needpack
STORE '           ' TO mlname
DO WHILE T
   SET EXACT ON
   GO TOP
   ERASE
   IF mlname = '           '
      STORE 'TELEPHONE RECORD VIEW/DELETE';
             TO heading
      DO PSHEADING
      STORE '           ' TO select
* --- done this way so the record will be re-displayed with asterisk
      @  0, 0 SAY gcuron
      @ 22,79 SAY '         Enter Name To Delete, (S)can , Or ';
                  +'<RETURN> To Exit ';
              GET select PICTURE '!!!!!!!!!!!'
      READ NOUPDATE
      @  0, 0 SAY gcuroff
   ENDIF
   IF select = '           '
      IF needpack = 'N'
         @ 22,79 SAY gclearline
         @ 10, 0 SAY ' '
         STORE 10 TO line
         STORE 'No Last Name Entered ' + gfirstname + ;
             + ' Returning To Phone Menu' TO prompt
         DO PSPROMPT
         STORE 1 TO counter
         DO WHILE counter < gdelay
            STORE counter + 1 TO counter
         ENDDO
      ELSE
         ERASE
         STORE ' ' TO select
         @ 22,12 SAY 'Permanently Delete Records Marked ';
                    +'This Session? (Y/N) ';
                 GET select PICTURE '!'
         READ
         @ 22, 0  SAY gclearline
         IF select = 'N'
            STORE 10 TO line
            STORE 'Removing Deletion Flags From Marked Records' TO prompt
            DO PSPROMPT
            RECALL ALL
         ELSE
            STORE 10 TO line
            STORE 'Permanently Deleting Marked Records '+gfirstname TO prompt
            DO PSPROMPT
            PACK
         ENDIF
      ENDIF
      USE
      RELEASE ALL EXCEPT g*
      SET EXACT OFF
      RETURN
   ENDIF
   IF $(select,1,1) = ' '
      * --- he added some leading space(s)
      STORE 1 TO pointer
      * --- locate the first non-empty character
      DO WHILE $(select,pointer,1) = ' '
         STORE pointer + 1 TO pointer
      ENDDO
      * --- get the non-empty characters
      STORE $(select,pointer,LEN(select)-pointer + 1) TO select
   ENDIF
   RELEASE pointer
   STORE TRIM(select) TO mlname
* --- give the guy a way out
   DO CASE
      CASE mlname <> 'S'
         ERASE
         STORE 1 TO line
         STORE 'SEARCH BY LAST NAME' TO prompt
         DO PSPROMPT
         FIND &mlname
         IF # = 0
            @ 22,79 SAY '                         '+;
                        'That Name Is Not In The Database'
            STORE 0 TO counter
            DO WHILE counter < gdelay
               STORE counter + 1 TO counter
            ENDDO
            STORE '           ' TO mlname
* --- get back a little quicker
            LOOP
         ELSE
            @ 4, 0 SAY 'Rec #   Last Name    First    Rank    O/S    U #';
                      +'   Type     Location   Phone'
            @ 5, 0 SAY gline
            @ 5,78 SAY ' '
            STORE 0 TO line
            DO WHILE .NOT. EOF .AND. !(lname) = mlname
* --- stops the screen after a screenful or two - can be expanded if necessary
* --- but that would take more than 29 Smith or Jones'
               IF line = 8 .OR. line = 19
                  @ 22,79 SAY '                   '+;
                              'More To Come ... Strike Any Key To Continue'
                  SET CONSOLE OFF
                  WAIT
                  SET CONSOLE ON
                  ERASE
                  STORE 1 TO line
                  STORE 'SEARCH BY LAST NAME' TO prompt
                  DO PSPROMPT
            @ 4, 0 SAY 'Rec #   Last Name    First    Rank    O/S    U #';
                      +'   Type     Location   Phone'
                  @ 5, 0 SAY gline
                  @ 5,78 SAY ' '
                  STORE 0 TO line
               ENDIF
               IF *
                  SKIP
                  LOOP
               ENDIF
               DISPLAY  ' '+lname+'  '+fname+'  '+rank+'   '+;
                        offsym+'   '+unitno+'   '+unitype+'   '+icao+;
                       '   '+state+'   '+avnop+'-'+avnos
               STORE line + 1 TO line
               SKIP
            ENDDO
            STORE '1' TO recno
            STORE '     ' TO select
            @  0, 0 SAY gcuron
            @ 22,79 SAY '             '+;
                        'Enter # To Delete Or <RETURN> To Try Another Name ';
                    GET select PICTURE '99999'
            READ NOUPDATE
            @  0, 0 SAY gcuroff
            @ 22,79 SAY gclearline
            IF select = '     '
               STORE '           ' TO mlname
               LOOP
            ENDIF
            IF $(select,1,1) = ' '
               * --- he added some leading space(s)
               STORE 1 TO pointer
                * --- locate the first non-empty character
               DO WHILE $(select,pointer,1) = ' '
                  STORE pointer + 1 TO pointer
               ENDDO
               * --- get the non-empty characters
               STORE $(select,pointer,LEN(select)-pointer + 1) TO select
            ENDIF
            RELEASE pointer
            STORE TRIM(select) TO recno
            IF recno <> ' '
* --- check if there's a number that big
               IF VAL(recno) > last
                  @ 22,79 SAY gclearline
                  @ 22,79 SAY '                         '+;
                              'There Is No '+recno+' ... Try Again'
                  STORE 0 TO counter
                  DO WHILE counter < gdelay
                     STORE counter + 1 TO counter
                  ENDDO
               ELSE
                  @ 22,79 SAY gclearline
                  @ 22,79 SAY '                        '+;
                              'Marking Record '+recno+' For Deletion'
                  STORE 0 TO counter
                  DO WHILE counter < gdelay
                     STORE counter + 1 TO counter
                  ENDDO
                  @ 22,79 SAY gclearline
                  GO VAL(recno)
                  DELETE
                  STORE 'Y' TO needpack
                  STORE '           ' TO mlname
               ENDIF
            ENDIF
         ENDIF
      CASE mlname = 'S'
         SET EXACT OFF
         @ 22,79 SAY gclearline
         STORE ' ' TO choice
         @ 22,79 SAY '                       ';
                    +'Letter To Scan Or <Return> For All ';
                 GET choice PICTURE '!'
         READ NOUPDATE
         IF choice = ' '
            STORE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' TO letters
            STORE 1 TO loops
         DO WHILE loops <= 26
         ELSE
            STORE choice TO letters
            STORE 1 TO loops
         DO WHILE loops <= 1
         ENDIF
            ERASE
            STORE $(letters,loops,1) TO scan
            STORE 1 TO line
            STORE 'SCANNING FIRST LETTER ' + scan TO prompt
            DO PSPROMPT
            FIND &scan
            STORE loops + 1 TO loops
            IF !($(lname,1,1)) <> scan
               STORE 10 TO line
               STORE 'There Are No Names Beginning With ' + scan TO prompt
               DO PSPROMPT
               STORE 1 TO counter
               DO WHILE counter < gdelay
                  STORE counter + 1 TO counter
               ENDDO
               @  9, 0 SAY gclearline
               @ 10, 0 SAY gclearline
               @ 11, 0 SAY gclearline
            ELSE
               @ 4, 0 SAY 'Rec #   Last Name    First    Rank    O/S    U #';
                         +'   Type     Location   Phone'
               @ 5, 0 SAY gline
               @ 5,78 SAY ' '
               STORE 0 TO line
               DO WHILE .NOT. EOF .AND. !($(lname,1,1)) = scan
                  IF line = 8 .OR. line = 19
                     @ 22,79 SAY '                   '+;
                                 'More To Come ... Strike Any Key To Continue'
                     SET CONSOLE OFF
                     STORE 1 TO line
                     STORE 'SCANNING FIRST LETTER ' + scan TO prompt
                     WAIT
                     SET CONSOLE ON
                     ERASE
                     DO PSPROMPT
               @ 4, 0 SAY 'Rec #   Last Name    First    Rank    O/S    U #';
                         +'   Type     Location   Phone'
                     @ 5, 0 SAY gline
                     @ 5,78 SAY ' '
                     STORE 0 TO line
                  ENDIF
                  IF *
                     SKIP
                     LOOP
                  ENDIF
                  DISPLAY  ' '+lname+'  '+fname+'  '+rank+'   '+;
                           offsym+'   '+unitno+'   '+unitype+'   '+icao+;
                          '   '+state+'   '+avnop+'-'+avnos
                  STORE line + 1 TO line
                  SKIP
               ENDDO
               STORE '     ' TO select
               @  0, 0 SAY gcuron
               @ 22,79 SAY '                 '+;
                           'Enter # To Delete Or <RETURN> To Continue ';
                       GET select PICTURE '99999'
               READ NOUPDATE
               @  0, 0 SAY gcuroff
               @ 22,79 SAY gclearline
               IF select <> '     '
                  IF $(select,1,1) = ' '
                     * --- he added some leading space(s)
                     STORE 1 TO pointer
                     * --- locate the first non-empty character
                     DO WHILE $(select,pointer,1) = ' '
                        STORE pointer + 1 TO pointer
                     ENDDO
                     * --- get the non-empty characters
                     STORE $(select,pointer,LEN(select)-pointer + 1) TO select
                  ENDIF
                  STORE TRIM(select) TO recno
                  IF VAL(recno) > last
                     @ 22,79 SAY gclearline
                     @ 22,79 SAY '                          ';
                                +'There Is No '+select+' ... Try Again'
                     STORE 0 TO counter
                     DO WHILE counter < gdelay
                        STORE counter + 1 TO counter
                     ENDDO
                  ELSE
* --- we'll send him back to same letter to display asterisk and give him
* --- a chance to delete another of the same first letter
                     STORE TRIM(select) TO select
                     STORE loops - 1 TO loops
                     @ 22,79 SAY '                          '+;
                                 'Record '+select+' Marked For Deletion'
                     STORE 1 TO counter
                     DO WHILE counter < gdelay
                        STORE counter + 1 TO counter
                     ENDDO
                     @ 22,79 SAY gclearline
                     GO VAL(recno)
                     DELETE
                     STORE 'Y' TO needpack
                  ENDIF
               ELSE
                  STORE '           ' TO mlname
               ENDIF
            ENDIF
         ENDDO
   ENDCASE
ENDDO T
* --- EOF PSDELETP.PRG

 gdelay
                     STORE counter + 1 TO counter
                  ENDDO
               ELSE
                  @ 22,79 SAY gclearline
                  @ 22,79 SAY '                        '+;
                              'Marking Record '+recn