98 lines
3.1 KiB
Plaintext
98 lines
3.1 KiB
Plaintext
|
******************************************************************************
|
||
|
|
*
|
||
|
|
* ASCII.EXPORT - Generate Delimited ASCII output from &SAVEDLISTS&
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 12/15/93 11810 FTW Allow choice to include/exclude null in ASCII EXPT
|
||
|
|
* 07/23/92 9064 WLC Initial Release
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This subroutine reads the already opened &SAVEDLISTS& entry and generates
|
||
|
|
* a comma delimited ascii data file as output.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
SUBROUTINE ASCII.EXPORT(return.code)
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE UVEXPORT.H
|
||
|
|
|
||
|
|
return.code = NO.ERR
|
||
|
|
IF interactive THEN
|
||
|
|
IF XPTNUL = 0 OR XPTNUL = 1 THEN
|
||
|
|
expt.null = XPTNUL
|
||
|
|
END ELSE
|
||
|
|
IF rec.onfile AND XPTNUL = '' THEN expt.null = 0 ELSE expt.null = 1
|
||
|
|
END
|
||
|
|
msg = "Do you wish to export null fields? "
|
||
|
|
CALL *YES.NO.BOX.B(Y.N.Start,msg,expt.null)
|
||
|
|
IF XPTNUL # expt.null THEN
|
||
|
|
XPTNUL = expt.null
|
||
|
|
IF rec.onfile THEN WRITEV record<1> ON ss.file,record.name,1 ; READ.record<1> = record<1>
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IF XPTNUL = 0 OR XPTNUL = 1 THEN
|
||
|
|
expt.null = XPTNUL
|
||
|
|
END ELSE
|
||
|
|
IF XPTNUL = '' THEN expt.null = 0 ELSE expt.null = 1
|
||
|
|
XPTNUL = expt.null
|
||
|
|
WRITEV record<1> ON ss.file,record.name,1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
Gen.ASCII:
|
||
|
|
GOSUB read.data
|
||
|
|
IF return.code = -1 THEN return.code = NO.ERR; RETURN
|
||
|
|
num.done += 1
|
||
|
|
new.bar = INT((num.done / num.records) * 50)
|
||
|
|
IF new.bar > old.bar AND interactive THEN
|
||
|
|
PRINT @(15,10):
|
||
|
|
CALL *INVERSE.B(1)
|
||
|
|
PRINT SPACE(new.bar):
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
old.bar = new.bar
|
||
|
|
END
|
||
|
|
|
||
|
|
mv.count = 1;
|
||
|
|
field.count = COUNT(uvdata,@FM)+1
|
||
|
|
FOR fld = 1 TO field.count
|
||
|
|
mv = COUNT(uvdata<fld>,@VM)+1
|
||
|
|
IF mv > mv.count THEN mv.count = mv
|
||
|
|
NEXT fld
|
||
|
|
FOR value = 1 TO mv.count
|
||
|
|
line = ""
|
||
|
|
FOR fld = 1 To field.count
|
||
|
|
IF normalize AND (single.multi<fld> = "S") THEN
|
||
|
|
this.value = 1
|
||
|
|
END ELSE this.value = value
|
||
|
|
data = uvdata<fld,this.value>
|
||
|
|
* Quotes around text only...
|
||
|
|
IF NUM(data) AND data#'' THEN line := data ELSE line := '"':data:'"'
|
||
|
|
IF fld # field.count THEN line := ","
|
||
|
|
NEXT fld
|
||
|
|
WRITESEQ line ON SEQ.result ELSE return.code = WRITE.ERR; RETURN
|
||
|
|
NEXT value
|
||
|
|
GOTO Gen.ASCII
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
read.data:
|
||
|
|
* Get a record into data buffer
|
||
|
|
uvdata = ""
|
||
|
|
FOR i = 1 TO fcount
|
||
|
|
READSEQ data FROM SEQ.exp ELSE return.code = -1; RETURN
|
||
|
|
IF expt.null THEN
|
||
|
|
uvdata<i>=data
|
||
|
|
END ELSE
|
||
|
|
IF data # '' THEN uvdata<-1>=data
|
||
|
|
END
|
||
|
|
NEXT i
|
||
|
|
RETURN
|