tldm-universe/Ardent/UV/BP/SET-FILE

78 lines
2.5 KiB
Plaintext
Raw Normal View History

2024-09-09 21:51:08 +00:00
*******************************************************************************
*
* SET-FILE verb basic subroutine definition
*
* 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.
* 10/19/94 15138 PVW Get RU lock before updating record
* 08/22/89 5084 JWT allow prompting for Q-pointer name to be disabled
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************
*
* SET-FILE will establish a VOC Q-pointer.
* command line syntax: SET-FILE { ACCT { FILE { NAME } } }
* if NAME is omitted, NAME is prompted for and if '' is entered then
* 'QFILE' is used.
* if either ACCT or FILE are omitted then the user will be prompted
* for an ACCT/FILE name.
* if VOC cannot be opened or NAME is already in VOC as a non Qtype,
* Q-pointer is not established.
* NO validation is done on the inputs.
* The prompting for the Q-pointer name can be disabled by changing the
* initial value of PROMPT.FOR.NAME from 1 to 0
*
********************************************************************************
PROMPT.FOR.NAME = 1
DIM COMMAND(4)
OPEN 'VOC' TO VOC ELSE STOP 'Sorry, unable to access VOC.'
WORK = TRIM(@SENTENCE)
MATPARSE COMMAND FROM WORK , ' '
ACCT = ''
FILE = ''
NAME = ''
TOKENS = INMAT()
IF TOKENS > 1 THEN
BEGIN CASE
CASE TOKENS = 2
ACCT = COMMAND(2)
CASE TOKENS = 3
FILE = COMMAND(3)
ACCT = COMMAND(2)
CASE 1
NAME = COMMAND(4)
FILE = COMMAND(3)
ACCT = COMMAND(2)
END CASE
END
PROMPT ' '
IF PROMPT.FOR.NAME
THEN
IF NAME = '' THEN PRINT 'Q name: ': ; INPUT NAME
END
IF NAME = '' THEN NAME = 'QFILE'
READU TESTREC FROM VOC,NAME THEN
IF TESTREC<1> # 'Q' THEN
RELEASE VOC,NAME
STOP NAME:' is already in VOC as type ':TESTREC<1>:'. Cannot overwrite.'
END
END
IF ACCT = '' THEN PRINT 'Account:': ; INPUT ACCT
IF FILE = '' THEN PRINT 'File: ': ; INPUT FILE
WRITE 'Q':@FM:ACCT:@FM:FILE ON VOC,NAME
PRINT 'Q-pointer written to VOC file.'
END