tldm-universe/Ardent/UV/APP.PROGS/GET.FNAME.B

69 lines
2.3 KiB
Plaintext
Raw Permalink Normal View History

2024-09-09 21:51:08 +00:00
*******************************************************************************
*
* uniVerse port of PI/open GET.FILE.NAME
*
* 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.
*
*******************************************************************************
*
* Maintenance log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description.........................................
* 10/14/98 23801 SAP Change copyrights.
* 01/13/94 11809 FTW Chg to support 'K' & 'Keyword' in VOC items' attr1
* 01/20/93 10908 PVW Fix problem with DICT filename.
* 12/03/92 10214 PVW Fix for DATA stck problem
* 12/03/92 10214 PVW Change message to 001018
* 12/02/92 10214 PVW Change UVPRINTMSG to *UVPRINTMSG
* 11/12/92 10214 PVW Port PI/open EDITOR to replace uniVerse EDITOR.
*
*******************************************************************************
SUBROUTINE GET.FILE.NAME (NO.SELECT.LIST, SENT, FILE.DICT, FILE.NAME, PROMPT.FOR.FILE, SINGLE.FILE.ONLY)
$INCLUDE UNIVERSE.INCLUDE UV.COM
$INCLUDE UNIVERSE.INCLUDE KEYWORD.H
IF SENT THEN
POS = 2
TOKEN.SENT = SENT
GOSUB SCAN.TOKENS
SENT = FIELD(SENT," ",POS,9999)
END ELSE
IF FILE.NAME = "" THEN
IF PROMPT.FOR.FILE THEN
CALL *UVPRINTMSG(001018,"")
INPUT TOKEN.SENT
GOSUB SCAN.TOKENS
END
END
END
RETURN
SCAN.TOKENS:
FILE.NAME = FIELD(TOKEN.SENT," ",1)
READ TOKEN.RECORD FROM DEVSYS.VOC.FILE,FILE.NAME THEN
IF TOKEN.RECORD<1>[1,1] = "K" THEN
IF TOKEN.RECORD<2> = KW$DICT THEN
FILE.DICT = FILE.NAME
FILE.NAME = FIELD(TRIM(TOKEN.SENT)," ",2)
POS = 3
IF FILE.NAME = "" THEN
IF PROMPT.FOR.FILE THEN
CALL *UVPRINTMSG(001018,"")
INPUT FILE.NAME
END
POS = 2
END
END
END
END
RETURN
END