Re: ##EMailNumber 01-WNY-5123108 Date From 8 byte MATTOD receiverto *DTS format with API QWCCVTDT

On Tue, 8 May 2001 jmoreno@militarycars.com wrote:
> Hello all,
> 
>    I am working with the following for the last few days and have not
> ben able to convert the 8 byte receiver from the C / MI function, buitin
> function MATTOD "Materialize Time of Day"  to some more readeable
> format. Particularly *DTS that gives me microseconds pressision
> 

**PLEASE** don't post entire sections of the IBM manuals in your E-mail!!! 
We all have access to the manuals, their globally available on the web!
If you need to reference something, provide a LINK.

>    In the Midrange archives the following link provides a good
> background
> 
>    http://archive.midrange.com/rpg400-l/200001/msg00406.html
> 
>    Mr Bruce Vining suggested in the past that the QWCCDTDT would be
>    a good candidate to do this. Unfortunately I still have difficulty
>    figuring out how to create the handshake of these pieces

The message in the archives that you reference is not available since
archive.midrange.com is currently down. 
See http://www.midrange.com/status.htm for more info.
> 
>    For example a receiver of '826C57DD56E28000'  should be something
>    like 2001-05-08.hh.mm.ss.uuuuuu ....
> 
>    Yes, Yes .. I confess I want those precious microseconds :-)
> 
>     Need a little help from the bits and bytes gurus
> 

Next time, please tell us what language you're working in and what
release of OS/400 you're running.    This one line of text would've
helped FAR more than quoted the IBM manuals at me.

I posted a solution to get microseconds in RPG IV a few months ago.  
As I pointed out, I cannot reference the archives to give you a link,
so I'll just re-post the source code:

     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
+---