78 lines
2.5 KiB
Plaintext
Executable File
78 lines
2.5 KiB
Plaintext
Executable File
*******************************************************************************
|
|
*
|
|
* 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
|