home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
pssst.zip
/
PSDELETP.PRG
< prev
next >
Wrap
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