....
/************************************************************/
/** (c) Copyright Velocity Software, Inc. 1990,1994 */
/************************************************************/
/* */
/* ESAMAP/VMPAF History File Data Extraction Procedure */
/* */
/* Usage: ESAPAFHF return mode variables */
/* */
/* where return is STACK or the output file name, */
/* mode is the mode of a read/write disk, */
/* and variables lists the variables to be extracted */
/* in the form */
/* fname.ftype.variable [...] */
/* */
/* This procedure is invoked by VMPAF and is not intended */
/* for direct end-user use. */
/* */
/************************************************************/
Address Command
Parse Upper Arg route fmode varlist
vlist = varlist
filevars. = ''
nfiles = 0
Do While vlist <> ''
Parse Var vlist fname'.'.'.'var vlist
If var = 'TOD' Then var = 'STOPTIME'
If var = 'INTERVAL' Then var = 'SECONDS'
If filevars.fname = ''
Then Do
'ESTATE ESASYS' fname '*'
If RC > 0 Then Do
Say "File 'ESASYS" fname"' not found on disk."
Say "Variable" var "bypassed."
Iterate
End
nfiles = nfiles + 1
fileid.nfiles = fname
filevars.fname = var
End
Else filevars.fname = filevars.fname var
End
If nfiles = 0
Then Do
Say 'No data extracted.'
Exit 32
End
Do f = 1 To nfiles
fname = fileid.f
vars = filevars.fname
Call Extract
End
If route = 'STACK'
Then Do
'MAKEBUF'
Queue varlist
Do d = 1 To nd
Queue vvalues.d
End
End
Else Do
fileid = route 'WORK' fmode
'ERASE' fileid
'EXECIO 1 DISKW' fileid '( VAR VARLIST'
If RC > 0 Then Do
Say "Error" RC "writing '"fileid"' on disk."
Exit RC
End
'EXECIO' nd 'DISKW' fileid '( FINIS STEM VVALUES.'
If RC > 0 Then Do
Say "Error" RC "writing '"fileid"' on disk."
Exit RC
End
End
Exit
/************************************/
/* Obtain variable names and values */
/************************************/
Extract:
'ERASE ESAPAFEX ESAEXTR' fmode
l = QUEUED()
'MAKEBUF'
bufno = RC
Do i = 1 To WORDS(vars) By 9
Queue "EXTRACT:"
Queue "X = '"WORD(vars,i)"'"
w = MIN(i + 8, WORDS(vars))
Do j = 2 To w
Queue "Y = '"WORD(vars,j)"'"
End
End
l = QUEUED() - l
'EXECIO' l 'DISKW ESAPAFEX ESAEXTR' fmode '( FINIS'
'DROPBUF' bufno
'EXEC ESAEXTR' fname '( PARM ESAPAFEX NOMINMAX TO' fmode
If RC > 0
Then Do
Say 'Error' RC 'from ESAEXTR for' fname 'history.'
Exit RC
End
'MAKEBUF'
bufno = RC
fileid = fname 'EXTRACT' fmode
'LISTFILE' fileid '( ALLOC NOHEADER STACK'
If RC > 0 Then Do
Say "File '"fileid"' not found on disk."
Exit RC
End
Parse Pull . . . . . records .
'DROPBUF' bufno
vvalues. = ''
todword = FIND(vars,'STOPTIME')
Do records
'EXECIO 1 DISKR' fileid '( VAR DATA'
If RC > 0 Then Do
Say "Error" RC "reading file '"fileid"' from disk."
Exit RC
End
Parse Var data date time vvalues
If date = '*HDR'
Then Do
nd = 0
Iterate
End
If todword > 0
Then Do
If time > WORD(vvalues,todword)
Then Do
day = SUBSTR(date,5,2)
day = RIGHT(day-1,2,'0')
date = OVERLAY(day,date,5,2)
End
vvalues = SUBWORD(vvalues,1,todword-1) ,
'19'date || time ,
SUBWORD(vvalues,todword+1)
End
nd = nd + 1
vvalues.nd = vvalues.nd || vvalues || ' '
End
'EXECIO 0 DISKR' fileid '( FINIS'
Return
