159 lines
4.3 KiB
Plaintext
Executable File
159 lines
4.3 KiB
Plaintext
Executable File
******************************************************************************
|
|
*
|
|
* Delete items from a database file
|
|
*
|
|
* Module %M% Version %I% Date %H%
|
|
*
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
|
* The copyright notice above does not evidence any actual or intended
|
|
* publication of such source code.
|
|
*
|
|
*******************************************************************************
|
|
*
|
|
* Maintenence log - insert most recent change descriptions at top
|
|
*
|
|
* Date.... GTAR# WHO Description.........................................
|
|
* 10/14/98 23801 SAP Change copyrights.
|
|
* 04/12/96 18194 KAM Disallow Fptr delete if MODFPTRS tunable set
|
|
* 09/07/95 17314 EAP Use READVU to lock record without reading it
|
|
* 10/19/94 15135 PVW Get RU lock before updating record
|
|
* 03/08/94 12297 JSW Added PI/Open flavor
|
|
* 10/23/91 8650 GMH Added code to verify record deleted.
|
|
* 09/19/90 7481 JWT fix DELETE with quoted arguments
|
|
* 04/23/90 7037 JWT fix PDICT test
|
|
* 04/20/90 7035 JWT internal getuno for signature generation
|
|
* 04/13/90 5780 JWT pick flavor dont prompt with active select list
|
|
* 04/13/90 6709 JWT Make delete BASIC so indexs get updated
|
|
*
|
|
*******************************************************************************
|
|
|
|
ID = "%W%"
|
|
|
|
DIM COMMAND(100)
|
|
|
|
OPEN 'VOC' TO VOCFILE
|
|
ELSE
|
|
CALL *UVPRINTMSG(20026,"")
|
|
RETURN
|
|
END
|
|
WORK = TRIM(@SENTENCE)
|
|
MATPARSE COMMAND FROM WORK , ' '
|
|
DKEY = 0
|
|
DELCOUNT = 0
|
|
FILE = ''
|
|
NAME = ''
|
|
TOKENS = INMAT()
|
|
FOR I = 2 TO TOKENS
|
|
IF I = 2
|
|
THEN
|
|
READ VDESC FROM VOCFILE,COMMAND(I)
|
|
THEN
|
|
IF VDESC[1,1] = 'K' OR VDESC[1,1] = 'k'
|
|
THEN
|
|
IF VDESC<2> = 20 OR VDESC<2> = 204
|
|
THEN
|
|
DKEY = VDESC<2>
|
|
GOTO BP:
|
|
END
|
|
END
|
|
END
|
|
END
|
|
IF FILE = ''
|
|
THEN
|
|
IF DKEY = 20 THEN FILE = "DICT ":COMMAND(I)
|
|
ELSE IF DKEY = 204 THEN FILE = "PDICT ":COMMAND(I)
|
|
ELSE FILE = COMMAND(I)
|
|
END
|
|
ELSE
|
|
IF NAME = '' THEN NAME = COMMAND(I) ELSE NAME := @FM:COMMAND(I)
|
|
END
|
|
BP: NEXT I
|
|
CLOSE VOCFILE
|
|
|
|
IF FILE = ''
|
|
THEN
|
|
CALL *UVPRINTMSG(10057,"")
|
|
RETURN
|
|
END
|
|
|
|
OPEN FILE TO UDATA
|
|
ELSE
|
|
CALL *UVPRINTMSG(10060,FILE)
|
|
RETURN
|
|
END
|
|
|
|
CALL *UVPRINTMSG(1132,"")
|
|
|
|
READNEXT NEXTID
|
|
THEN
|
|
FLAVOR = SYSTEM(1001)
|
|
IF FLAVOR = 1 OR FLAVOR = 4 OR FLAVOR = 64
|
|
THEN
|
|
OLDPROMPT = SYSTEM(26)
|
|
PROMPT ' '
|
|
CALL *UVPRINTMSG(1334,"")
|
|
CALL *UVPRINTMSG(1364, NEXTID)
|
|
INPUT YES.OR.NO
|
|
PROMPT = OLDPROMPT
|
|
YES.OR.NO = YES.OR.NO[1,1]
|
|
IF YES.OR.NO # "y" AND YES.OR.NO # "Y" THEN GOTO DONE:
|
|
END
|
|
LOOP
|
|
GOSUB DELITEM:
|
|
READNEXT NEXTID ELSE GOTO DONE:
|
|
REPEAT
|
|
END
|
|
ELSE
|
|
LOOP
|
|
IF NAME = "" THEN GOTO DONE:
|
|
NEXTID = NAME<1>
|
|
IF NEXTID[1,1] = NEXTID[1] AND LEN(NEXTID) > 1
|
|
THEN
|
|
IF NEXTID[1,1] = "'" OR NEXTID[1,1] = "\" OR NEXTID[1,1] = '"'
|
|
THEN
|
|
NEXTID = NEXTID[2,LEN(NEXTID)-2]
|
|
END
|
|
END
|
|
DEL NAME<1>
|
|
GOSUB DELITEM:
|
|
REPEAT
|
|
END
|
|
|
|
DONE: CLOSE UDATA
|
|
CALL *UVPRINTMSG(1365,DELCOUNT)
|
|
RETURN
|
|
|
|
DELITEM: * DELETE ITEM FROM OPEN FILE
|
|
|
|
IF (NOT(SYSTEM(62)) AND (FILE = 'VOC'))
|
|
THEN
|
|
READ REC FROM UDATA,NEXTID
|
|
THEN
|
|
IF REC[1,1] = 'F' OR REC[1,1] = 'f'
|
|
THEN
|
|
CALL *UVPRINTMSG(020553,"")
|
|
CALL *UVPRINTMSG(10054,NEXTID)
|
|
RETURN
|
|
END
|
|
END
|
|
END
|
|
|
|
READVU REC FROM UDATA,NEXTID,0
|
|
ELSE
|
|
RELEASE UDATA,NEXTID
|
|
CALL *UVPRINTMSG(10055,NEXTID)
|
|
RETURN
|
|
END
|
|
|
|
DELETE UDATA,NEXTID
|
|
|
|
* FOR GTAR 8650, Reread record to see if exists *
|
|
REC=""
|
|
READV REC FROM UDATA,NEXTID,0 ELSE
|
|
DELCOUNT = DELCOUNT + 1
|
|
END
|
|
|
|
RETURN
|
|
END
|