RE: Mcsec in Timestamp, is it possible

[Scott Klement <klemscot@xxxxxxxxxxxx>]

On Tue, 13 Feb 2001, Buck Calabro wrote:

> Scott Klement posted an example a while ago.  You can find it in the
> archives:
> http://archive.midrange.com/rpg400-l/200101/msg00867.html
> 

Actually, that program only goes down to milliseconds...   I never
needed microseconds on the AS/400....  though UNIX/POSIX does it with
the gettimeofday() function.  

(10 minutes later)  In fact, here's an example:

     H BNDDIR('QC2LE')

     D gettimeofday    PR                  ExtProc('gettimeofday')
     D   timeval                      8A
     D   timezone                     8A

     D GetTimeZone     PR             5A

     D timeval         DS
     D   tv_secs                     10I 0
     D   tv_usecs                    10I 0

     D timezone        DS
     D   tzDir                        1A
     D   tzHour                       2S 0
     D   tzFrac                       2S 0

     D Junk            S              8A
     D Epoch           S               Z   INZ(z'1970-01-01-00.00.00.000000')
     D Current         S               Z


      ** get current time
     c                   callp     gettimeofday(timeval: junk)

      ** convert to a timestamp
     c     Epoch         adddur    tv_secs:*S    Current
     c                   adddur    tv_usecs:*MS  Current

      ** adjust for timezone
     c                   eval      timezone = GetTimeZone
     c                   if        tzDir = '-'
     c                   subdur    tzHour:*H     Current
     c                   else
     c                   adddur    tzHour:*H     Current
     c                   endif

      ** show it.
     c                   dsply                   Current

     c                   eval      *inlr = *on


     P*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P*  This gets the offset from Universal Coordinated Time (UTC)
     P*    from the system value QUTCOFFSET
     P*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P GetTimeZone     B
     D GetTimeZone     PI             5A
     D peRcvVar        S              1A   DIM(100)
     D peRVarLen       S             10I 0
     D peNumVals       S             10I 0
     D peSysValNm      S             10A
     D p_Offset        S               *
     D wkOffset        S             10I 0 BASED(p_Offset)
     D p_SV            S               *
     D dsSV            ds                  BASED(p_SV)
     D   dsSVSysVal                  10A
     D   dsSVDtaTyp                   1A
     D   dsSVDtaSts                   1A
     D   dsSVDtaLen                  10I 0
     D   dsSVData                     5A
     D dsErrCode       DS
     D  dsBytesPrv             1      4B 0 INZ(256)
     D  dsBytesAvl             5      8B 0 INZ(0)
     D  dsExcpID               9     15
     D  dsReserved            16     16
     D  dsExcpData            17    256
     C                   CALL      'QWCRSVAL'                           99
     C                   PARM                    peRcvVar
     C                   PARM      100           peRVarLen
     c                   PARM      1             peNumVals
     c                   PARM      'QUTCOFFSET'  peSysValNm
     c                   PARM                    dsErrCode
     c                   if        dsBytesAvl > 0  or  *IN99 = *On
     c                   return    *blanks
     c                   endif
     c                   eval      p_Offset = %addr(peRcvVar(5))
     c                   eval      p_SV = %addr(peRcvVar(wkOffset+1))
     c                   return    dsSVData
     P                 E

+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---