....
/************************************************************/ /** (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