SeanHoppe.com › EXTOL EDI Examples › EXTOL External Call RPG Programs › EXTOL RPG Program: RTVDTM
H/TITLE Retrieve system date/time to output
H Y
Z* CRTRPGPGM
Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
*
W* Warning: This program does not set on the LR indicator
*
H* Company : ExtoL, Inc.
H* System : ExtoL EDI Integrator
H* Date generated: 11/22/93
H* (C) Copyright : ExtoL, Inc. 1988,1993
*
H* SYNOPSIS :
H* Use system API QWCCVTDT to obtain system date and/or time
H* in various formats. Since this program returns without
H* setting on LR, it may also be used to return the last date/time
H* value retrieved without re-retrieving it again from the system.
H* This is useful when the same date-time tag is desired in several
H* output locations.
*
* "Local" refers to data in an application interface file field
* "Standard" refers to data in an EDI data element
* "Incoming" translation is standard to local
* "Outgoing" translation is local to standard
*
* This program is designed to be called by either incoming or
* outgoing translator programs as an "external process" code table.
* In either case, it only used the "qualifier" as input; it may be
* attached to any element-field mapping. If the direction code is
* "I", the output is to the "local" parameter; if the direction code
* is "O", the output is to the "standard" parameter. The normal
* "input" parameter is unused in either case.
*
* The parameters are the standard "type 1" (short) parameter list
* for external process code translation.
*
* Parameter Length Description
* _________ __ ____________________________________________
* P0RTN 7 Return code: ' ' if OK, error MSGID otherwise
* P1CDTT 1 Direction: 'I'=incoming, 'O'=outgoing
* P2TABL 10 Code table ref (unused in this pgm)
* P3CDST 80 Date/time in standard form
* P4CDQD 80 Code qualifier: format codes
* P5CDLC 80 Date/time in local form
*
*
* The "code qualifier" parameter is used to specify the formats
* of both the standard and local outputs, and whether the system
* clock is to be retrieved or the prior retrieval is used.
* Legal format codes are as follows:
*
* Code Output format
* __________ _____________
* date formats:
* *ISO CCYY-MM-DD
* *YMD YYMMDD
* *ZMD YYYYMMDD
* *MDY MMDDYY
* *MDZ MMDDYYYY
* *DMY DDMMYY
* *DMZ DDMMYYYY
* *CMD CYYMMDD where C = century digit (0 = 19xx; 1 = 20xx)
*
* time formats:
* *HMS HHMMSS
* *HMSSSS HHMMSSsss where sss = milliseconds (000-999)
* *HM HHMM (useful for X12 time element)
*
* EXTOL internal date-time stamp format:
* *DTS CYYMMDDHHMMSSss (= first 15 digits of API *YMD)
*
* any full date format may be combined with either full time format:
* *YMDHMS YYMMDDHHMMSS
* *ZMDHMSSSS YYYYMMDDHHMMSSsss
* *YMDHM YYMMDDHHMM
* (etc.)
*
* For all of the above, the first character "*" causes a system call
* to retrieve the current date/time. Replacing the "*" with "L"=Last
* causes a copy of the last date/time to be used. If retrieving the
* date and time into separate outputs, it it recommended that the "*"
* is used on the first call, and the "L" of the second call. This
* will prevent the possibility of midnight rollover problems.
*
* Examples:
* 1. Get current date and time into separate fields:
* use "*YMD" for a date field, then use "LHMS" for a time field.
* 2. Copy the same date/time into separate fields:
* use "LYMD" for a date field, then use "LHMS" for a time field.
*
* Limitations:
* The system clock format in the AS/400 will reach it's maximum
* value on May 10, 2071 at 11:56:53.684.
*
*
* Output is 2-17 numeric characters (depending on format code)
* left justified in the 80-character parameter field. Leading
* zeros are used as necessary to fit standard format lengths.
* The remainder of the parameter field is filled with blanks.
*
* Output format examples for Nov. 26, 1993 at time 12:34:56.789
* Qualifier: output data:
* ____ ____________________
* *ISO '1993-11-26 '
* *YMD '931126 '
* *ZMD '19931126 '
* *MDY '112693 '
* *HMS '123456 '
* *HMSSSS '123456789 '
* *DTS '093112612345678 '
* *ZMDHMSSSS '19931126123456789 '
* *HM '1234 '
*
*================================================================
*
E DQ 10 1 qualifier
E DO 17 1 data - output
E DS 16 1 system format
* (=CYYMMDDHHMMSSsss)
* Data structures:
I DS
* Output data (standard or local; any format)
I 1 17 DO
I 1 17 DOF
I DS
* Saved value of last date/time retrieved:
* in System API format "*YMD" == CYYMMDDHHMMSSsss
I 1 1 SCENT
I 2 3 SYEAR
I 4 5 SMONTH
I 6 7 SDAY
I 8 9 SHOUR
I 10 11 SMIN
I 12 13 SSEC
I 14 16 SMSEC
I 1 16 DS
I 1 7 SCMD
I 2 7 SYMD
I 4 7 SMD
I 8 11 SHM
I 8 13 SHMS
I 8 16 SHMSSS
I 1 16 DSF
I 1 15 DTS
I 2 16 XDSF
I DS
* for forming MDY and MDZ strings
I 1 4 SMD2
I 5 6 SYY2
I 5 8 SZY2
I 1 6 SMDY
I 1 8 SMDZ
I DS
* for forming DMY and DMZ strings
I 1 2 SD2
I 3 4 SM2
I 5 6 SYY3
I 5 8 SZY3
I 1 6 SDMY
I 1 8 SDMZ
I DS
* in 4-digit year format "*ZMD" == YYYYMMDDHHMMSSsss
I 1 2 ZCENT
I 3 4 ZYEAR
I 1 4 ZYEAR4
I 5 6 ZMONTH
I 7 8 ZDAY
I 9 10 ZHOUR
I 11 12 ZMIN
I 13 14 ZSEC
I 15 17 ZMSEC
I 1 8 SZMD
I 1 17 ZSF
I 3 17 XZSF
I DS
* Qualifier substrings
I 1 1 Q1
I 2 4 Q0204
I 2 3 Q0203
I 4 4 Q0404
I 5 6 Q0506
I 5 7 Q0507
I 5 10 Q0510
I 2 10 Q0210
I 1 10 DQ
I 1 10 DQF
*
IERRSTR IDS
I I 96 B 1 40BYTPRV
I I 0 B 5 80BYTAVL
I 9 15 EXCPID
I 16 16 RESERV
I 17 96 EXCPDT
* Named constants
* Long qualifier strings:
I 'ZMDHMSSSS' C ZMDSSS
*
* Named constants for forcing upper case
I 'ABCDEFGHIJKLMNOPQRST-C UP
I 'UVWXYZ'
I 'abcdefghijklmnopqrst-C LO
I 'uvwxyz'
*
*
* Parameter declarations
I DS
* I : Code trans directions 1
I 1 1 P1CDTT
* I : Code table reference 10
I 2 11 P2TABL
* B : Code in standard form 80
I 12 91 P3CDST
* B : Code qualifier data 80
I 92 171 P4CDQD
* B : Code in local form 80
I 172 251 P5CDLC
*
/EJECT
*****************************************************************
* Entry parameters
C *ENTRY PLIST
C PARM P0RTN 7
C P1CDTT PARM WP0001 1 Code trans dire
C P2TABL PARM WP0002 10 Code table refe
C P3CDST PARM P3CDST WP0003 80 Code in standar
C P4CDQD PARM P4CDQD WP0004 80 Code qualifier
C P5CDLC PARM P5CDLC WP0005 80 Code in local f
*****************************************************************
*
C MOVE *BLANK DOF
C LO:UP XLATEP4CDQD DQF
*
* Retrieve current date/time if first char of qualifier is "*":
C Q1 IFEQ '*'
C MOVEL*ZEROS DSF
C MOVEL*ZEROS ZSF
* Retrieve date/time according to system YMD format
C CALL 'QWCCVTDT' 99
C PARM '*CURRENT'INPFMT 10
C PARM *BLANK INPVAR 16
C PARM '*YMD 'OUTFMT 10
C PARM *BLANK OUTVAR 16
C PARM ERRSTR
C BYTAVL IFGT 0
C *IN99 OREQ '1'
* A "Return code" of non-blank will be logged as a translation error:
C MOVELEXCPID P0RTN *Return code
C ELSE
C MOVELOUTVAR DSF
C MOVELXDSF XZSF
C SCENT IFEQ '0'
C MOVEL'19' ZCENT
C ELSE
C MOVEL'20' ZCENT
C END
* A "Return code" of blank means no error:
C MOVEL*BLANK P0RTN *Return code
C END
*
C END
*
C MOVE *ZEROS DI 30
* Return appropriate substring in appropriate format:
* CASE: Format is "xCMD"
C Q0204 IFEQ 'CMD'
C MOVELSCMD DOF
C Z-ADD8 DI
C ELSE
* CASE: Format is "xHMS "
C Q0210 IFEQ 'HMS '
C MOVELSHMS DOF
C ELSE
* CASE: Format is "xHMSSSS "
C Q0210 IFEQ 'HMSSSS '
C MOVELSHMSSS DOF
C ELSE
* CASE: Format is "xHM "
C Q0210 IFEQ 'HM '
C MOVELSHM DOF
C ELSE
* CASE: Format is "xYMD"
C Q0204 IFEQ 'YMD'
C MOVELSYMD DOF
C Z-ADD7 DI
C ELSE
* CASE: Format is "xDTS"
C Q0204 IFEQ 'DTS'
C MOVELDTS DOF
C ELSE
* CASE: Format is "xZMD"
C Q0204 IFEQ 'ZMD'
C MOVELSZMD DOF
C Z-ADD9 DI
C ELSE
* CASE: Format is "xISO"
C Q0210 IFEQ 'ISO '
C MOVELZYEAR4 DOF
C CAT '-':0 DOF
C CAT ZMONTH:0 DOF
C CAT '-':0 DOF
C CAT ZDAY:0 DOF
C ELSE
* CASE: Format is "xMDx"
C Q0203 IFEQ 'MD'
C MOVELSMD SMD2
* CASE: Format is "xMDY"
C Q0404 IFEQ 'Y'
C MOVELSYEAR SYY2
C MOVELSMDY DOF
C Z-ADD7 DI
C ELSE
* CASE: Format is "xMDZ"
C Q0404 IFEQ 'Z'
C MOVELZYEAR4 SZY2
C MOVELSMDZ DOF
C Z-ADD9 DI
C END
C END
C ELSE
* CASE: Format is "xDMx"
C Q0203 IFEQ 'DM'
C MOVELSDAY SD2
C MOVELSMONTH SM2
* CASE: Format is "xDMY"
C Q0404 IFEQ 'Y'
C MOVELSYEAR SYY3
C MOVELSDMY DOF
C Z-ADD7 DI
C ELSE
* CASE: Format is "xDMZ"
C Q0404 IFEQ 'Z'
C MOVELZYEAR4 SZY3
C MOVELSDMZ DOF
C Z-ADD9 DI
C END
C END
* . . . (other cases unfinished for now ...)
*
C END
C END
C END
C END
C END
C END
C END
C END
C END
C END
*
* Add HMS or HMSSSS if appropriate:
C DI IFGT 0
C Q0507 ANDEQ'HMS'
* CASE: Format is "xHMS "
C Q0510 IFEQ 'HMS '
C MOVEASHMS DO,DI
C ELSE
* CASE: Format is "xHMSSSS "
C Q0510 IFEQ 'HMSSSS'
C MOVEASHMSSS DO,DI
* . . . (other cases unfinished for now ...)
*
C END
C END
C END
*
* Add HM if appropriate:
C DI IFGT 0
C Q0506 ANDEQ'HM'
* CASE: Format is "xHMS "
C Q0510 IFEQ 'HM '
C MOVEASHM DO,DI
* . . . (other cases unfinished for now ...)
*
C END
C END
*
* CASE: PAR.Code trans directions is Inward translation
C P1CDTT IFEQ 'I'
C MOVELDOF P5CDLC
C ELSE
* CASE: PAR.Code trans directions is Outward translation
C P1CDTT IFEQ 'O'
C MOVELDOF P3CDST
C END
*
C END
*
* Exit program
C RETRN