tldm-universe/Ardent/UV/BP/DELETE

******************************************************************************
*
*	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