Softcode Date Routine Service Program

 
     H/TITLE ** Common Date Routine Service Program **
     H DEBUG(*YES)
     H COPYRIGHT('Copyright (C) 2005 Logical Systems Design')
     H nomain
      *---
      /copy qrpglesrc,swcmmn_pr
      *---
      * Global variables
     D Alert           S             27    inz('Error Message')
     D CurrDate        S               D
     D CurrTime        S               T
     D DateISO         S              8  0
     D DateUSA         S              8  0
     D DateYMD         S              8  0
     D DayJul          S              3  0
     D err_msg         S            255
     D FirstOfMn       S               D
     D FirstOfQ        S               D
     D FirstOfYr1      S               D
     D FirstOfYr2      S               D
     D FirstQ          S              8
     D HourMin         S              4  0
     D JulDate         S              5  0
     D LastOfMn        S               D
     D LastOfQ         S               D
     D MonthDay        S              4  0
     D MonthQtr        S              2  0
     D n               S              3  0 inz(1)
     D Now             S               T
     D Quarter         S              3  0
     D ResultDy        S               D
     D ResultMn        S               D
     D ResultYr        S               D
     D Stamped         S               Z
     D TimeOfDay       S              6  0
     D TimeString      S             26
     D Today           S               D
     D Warning         S             27    inz('Warning Message')
     D WeekDay         S              3  0
     D WorkDate        S               D

     D DspTxtMsg       PR
     D  InString                    255
     D  InTitle                      27    options(*nopass)

      *//=================================================================//
      * Date today in ISO format  (CCYYMMDD)
      *//=================================================================//

     P DateToday       B                   export
     D DateToday       PI             8S 0
     D DateToday       S              8  0
      /free
         DateToday = %dec(%char(%date():*iso0):8:0);
         RETURN DateToday;
      /end-free
     P DateToday       E

      *//=================================================================//
      * Time in 6 digit format (HHMMSS)
      *//=================================================================//

     P TimeNow         B                   export
     D TimeNow         PI             6S 0
     D TimeOfDay       S              6  0
      /free
         TimeOfDay = %dec(%char(%time():*hms0):6:0);
         RETURN TimeofDay;
      /end-free
     P TimeNow         E

      *------------------------------------------
      * Return the day of the week
      *------------------------------------------
     P DayOfWeek       B                   export
     D DayOfWeek       PI             3S 0
     D   DateIn                        D   CONST options(*nopass)
      /free
         // To return a number based on 1=Monday, use 01 for day.
         // for 1=Sunday, use 07 for day.
         IF %parms < 1                                               ;
            WeekDay = %rem(%diff(%date():d'0001-01-01':*d) : 7) + 1  ;
         ELSE                                                        ;
            WeekDay = %rem(%diff(DateIn:d'0001-01-01':*d) : 7) + 1   ;
         ENDIF                                                       ;
         RETURN WeekDay                                              ;
      /end-free
     P DayOfWeek       E

     P ISOdate         B                   export
     D ISOdate         PI             8S 0
     D DateToday       S              8  0
      /free
         DateToday = %dec(%char(%date():*iso0):8:0);
         RETURN DateToday;
      /end-free
     P ISOdate         E

     P USAdate         B                   export
     D USAdate         PI             8S 0
     D DateToday       S              8  0
      /free
         DateToday = %dec(%char(%date():*usa0):8:0);
         RETURN DateToday;
      /end-free
     P USAdate         E

     P MDYdate         B                   export
     D MDYdate         PI             6S 0
     D DateToday       S              6  0
      /free
         DateToday = %dec(%char(%date():*mdy0):6:0);
         RETURN DateToday;
      /end-free
     P MDYdate         E

     P YMDdate         B                   export
     D YMDdate         PI             6S 0
     D DateToday       S              6  0
      /free
         DateToday = %dec(%char(%date():*ymd0):6:0);
         RETURN DateToday;
      /end-free
     P YMDdate         E

     P DMYdate         B                   export
     D DMYdate         PI             6S 0
     D DateToday       S              6  0
      /free
         DateToday = %dec(%char(%date():*dmy0):6:0);
         RETURN DateToday;
      /end-free
     P DMYdate         E

     P CYMDdate        B                   export
     D CYMDdate        PI             7S 0
     D DateToday       S              7  0
      /free
         DateToday = %dec(%char(%date():*cymd0):7:0);
         RETURN DateToday;
      /end-free
     P CYMDdate        E

     P JulianDate      B                   export
     D JulianDate      PI             5S 0
      /free
            JulDate = %dec(%char(%date():*jul0):5:0)                 ; // return current date
         RETURN JulDate                                              ;
      /end-free
     P JulianDate      E

     P DayOfYear       B                   export
     D DayOfYear       PI             3S 0
      /free
        // Get the Julian day, the current day of the year
        DayJul = %diff(CurrDate-%days(%subdt(CurrDate:*d))           :
                 d'0001-01-01' + %years(%subdt(CurrDate:*y) - 1)     :
                 *d)  + %subdt(CurrDate:*d)                          ;
         RETURN DayJul                                               ;
      /end-free
     P DayOfYear       E

     P TimeStamped     B                   export
     D TimeStamped     PI              z
      /free
         stamped = %date() + %time()                                 ;
         RETURN stamped                                              ;
      /end-free
     P TimeStamped     E

     P CvtToJulian     B                   export
     D CvtToJulian     PI             5S 0
     D  DateIn                        8S 0 Const options(*nopass)
     D  FormatIn                      5    Const options(*nopass)

     D DteFormat       S              5
     D GrgDate         S              8S 0
     D JulianDate      S              5S 0
     D NbrParms        S              3S 0
     D InvalidDate     S               n

      /free
         //-----------------------------------------------------------
         // If date format omitted, default to ISO format
         // If no date received default to current date
         //-----------------------------------------------------------
         InvalidDate = *OFF                                          ;
         IF %parms > 1                                               ;
            DteFormat = UpperCase(FormatIn:%size(FormatIn))          ;
         ELSE                                                        ;
            DteFormat = '*ISO'                                       ;
         ENDIF                                                       ;
         IF %parms < 1                                               ;
            GrgDate = DateToday()                                    ;
         ELSE                                                        ;
            GrgDate = DateIn                                         ;
         ENDIF                                                       ;

         InvalidDate = CheckDate(GrgDate : DteFormat)                ; // check date
         IF InvalidDate                                              ;
            JulDate = -3                                             ;
         ELSE                                                        ;
            JulDate = %dec(%char(workDate:*jul0):5:0)                ; // return Julian date
         ENDIF                                                       ;

         RETURN JulDate                                              ;

      /end-free
     P CvtToJulian     E
      *------------------------------------------
      * Convert to 6-digit date
      *------------------------------------------
     P CvtToDate6      B                   export
     D CvtToDate6      PI             6S 0
     D  FmtOut                        5    Const
     D  DateIn                        8S 0 Const options(*nopass)
     D  FormatIn                      5    Const options(*nopass)

     D DteFormat       S              5
     D GrgDate         S              8S 0
     D Date6           S              6S 0
     D NbrParms        S              3S 0
     D InvalidDate     S               n

      /free
         //-----------------------------------------------------------
         // If date format omitted, default to ISO format
         // If no date received default to current date
         //-----------------------------------------------------------
         InvalidDate = *OFF                                          ;
         IF %parms > 2                                               ;
            DteFormat = UpperCase(FormatIn:%size(FormatIn))          ;
         ELSE                                                        ;
            DteFormat = '*ISO'                                       ;
         ENDIF                                                       ;
         IF %parms < 2                                               ;
            GrgDate = DateToday()                                    ;
         ELSE                                                        ;
            GrgDate = DateIn                                         ;
         ENDIF                                                       ;

         InvalidDate = CheckDate(GrgDate : DteFormat)                ; // check date
         IF InvalidDate                                              ;
            Date6 = -1                                               ;
         ELSE                                                        ;
            SELECT                                                   ;
               WHEN FmtOut = '*YMD'                                  ;
                  Date6 = %dec(%char(workDate:*ymd0):6:0)            ;
               WHEN FmtOut = '*DMY'                                  ;
                  Date6 = %dec(%char(workDate:*dmy0):6:0)            ;
               OTHER                                                 ;
                  Date6 = %dec(%char(workDate:*mdy0):6:0)            ;
            ENDSL                                                    ;
         ENDIF                                                       ;
         RETURN Date6                                                ;

      /end-free
     P CvtToDate6      E
      *------------------------------------------
      * Convert to 8-digit date
      *------------------------------------------
     P CvtToDate8      B                   export
     D CvtToDate8      PI             8S 0
     D  FmtOut                        5    Const
     D  DateIn                        8S 0 Const options(*nopass)
     D  FormatIn                      5    Const options(*nopass)

     D DteFormat       S              5
     D GrgDate         S              8S 0
     D Date8           S              8S 0
     D NbrParms        S              3S 0
     D InvalidDate     S               n

      /free
         //-----------------------------------------------------------
         // If date format omitted, default to ISO format
         // If no date received default to current date
         //-----------------------------------------------------------
         InvalidDate = *OFF                                          ;
         IF %parms > 2                                               ;
            DteFormat = UpperCase(FormatIn:%size(FormatIn))          ;
         ELSE                                                        ;
            DteFormat = '*ISO'                                       ;
         ENDIF                                                       ;
         IF %parms < 2                                               ;
            GrgDate = DateToday()                                    ;
         ELSE                                                        ;
            GrgDate = DateIn                                         ;
         ENDIF                                                       ;

         InvalidDate = CheckDate(GrgDate : DteFormat)                ; // check date
         IF InvalidDate                                              ;
            Date8 = -1                                               ;
         ELSE                                                        ;
            SELECT                                                   ;
               WHEN FmtOut = '*ISO'                                  ;
                  Date8 = %dec(%char(workDate:*iso0):8:0)            ;
               WHEN FmtOut = '*USA'                                  ;
                  Date8 = %dec(%char(workDate:*usa0):8:0)            ;
               OTHER                                                 ;
                  Date8 = -3                                         ;
            ENDSL                                                    ;
         ENDIF                                                       ;
         RETURN Date8                                                ;

      /end-free
     P CvtToDate8      E
      *------------------------------------------
      * Convert to 7-digit date
      *------------------------------------------
     P CvtToDate7      B                   export
     D CvtToDate7      PI             7S 0
     D  FmtOut                        5    Const
     D  DateIn                        8S 0 Const options(*nopass)
     D  FormatIn                      5    Const options(*nopass)

     D DteFormat       S              5
     D GrgDate         S              8S 0
     D Date7           S              7S 0
     D NbrParms        S              3S 0
     D InvalidDate     S               n

      /free
         InvalidDate = *OFF                                          ; //----------------------
         IF %parms > 2                                               ; // if date format omitted
            DteFormat = UpperCase(FormatIn:%size(FormatIn))          ;
         ELSE                                                        ; // date format
            DteFormat = '*ISO'                                       ;
         ENDIF                                                       ; //----------------------
         IF %parms < 2                                               ; // if no date received
            GrgDate = DateToday()                                    ; // default date to
         ELSE                                                        ; // current date
            GrgDate = DateIn                                         ; //----------------------
         ENDIF                                                       ;

         InvalidDate = CheckDate(GrgDate : DteFormat)                ; // check date
         IF InvalidDate                                              ;
            Date7 = -1                                               ;
         ELSE                                                        ;
            Date7 = %dec(%char(workDate:*cymd0):7:0)                 ;
         ENDIF                                                       ;

         RETURN Date7                                                ;
      /end-free
     P CvtToDate7      E
      *------------------------------------------
      * Check to see if the date is valid
      *------------------------------------------
     P CheckDate       B                   EXPORT
     D CheckDate       PI              n
     D  DateValue                     8S 0 Const
     D  DateFormat                    5A   Const options(*nopass)
     D  DateMessage                    n   Const options(*nopass)

     D NbrParms        S              3  0
     D DateError       S               n
     D ShowMessage     S               n
     D Work8           S              8
     D Work7           S              7
     D Work6           S              6
     D format          S              5

      /free
         DateError = *OFF                                            ;
         IF %parms > 1                                               ;
            format = UpperCase(DateFormat:%size(DateFormat))         ;
         ELSE                                                        ;
            format = '*ISO'                                          ;
         ENDIF                                                       ;
         IF %parms = 3                                               ;
            ShowMessage = DateMessage                                ;
         ELSE                                                        ;
           ShowMessage = *off                                        ;
         ENDIF                                                       ;
        SELECT                                                       ;

        WHEN format = '*ISO'                                         ;
           work8 = %editc(DateValue: 'X')                            ;
           TEST(DE) *ISO0 work8                                      ;
           IF %error                                                 ;
              EXSR @error                                            ;
           ELSE                                                      ;
              workDate = %date(work8:*ISO0)                          ;
           ENDIF                                                     ;

        WHEN format = '*USA'                                         ;
           work8 = %editc(DateValue: 'X')                            ;
           TEST(DE) *USA0  work8                                     ;
           IF %error                                                 ;
              EXSR @error                                            ;
           ELSE                                                      ;
              workDate = %date(work8:*USA0)                          ;
           ENDIF                                                     ;

        WHEN format = '*MDY'                                         ;
           work6 = %subst(%editc(DateValue:'X'):3:6)                 ;
           work6 = %xlate(' ':'0':work6)                             ;
           TEST(DE) *MDY0 work6                                      ;
           IF %error                                                 ;
              EXSR @error                                            ;
           ELSE                                                      ;
              workDate = %date(work6:*MDY0)                          ;
           ENDIF                                                     ;
        WHEN format = '*YMD'                                         ;
           work6 = %subst(%editc(DateValue:'X'):3:6)                 ;
           TEST(DE) *YMD0 work6                                      ;
           IF %error                                                 ;
              EXSR @error                                            ;
           ELSE                                                      ;
              workDate = %date(work6:*YMD0)                          ;
           ENDIF                                                     ;
        WHEN format = '*DMY'                                         ;
           work6 = %subst(%editc(DateValue:'X'):3:6)                 ;
           TEST(DE) *DMY0  work6                                     ;
           IF %error                                                 ;
              EXSR @error                                            ;
           ELSE                                                      ;
              workDate = %date(work6:*DMY0)                          ;
           ENDIF                                                     ;
        WHEN format = '*CYMD'                                        ;
           work7 = %subst(%editc(DateValue:'X'):2:7)                 ;
           TEST(DE) *CYMD0 work7                                     ;
           IF %error                                                 ;
              EXSR @error                                            ;
           ELSE                                                      ;
              workDate = %date(work7:*CYMD0)                         ;
           ENDIF                                                     ;
        OTHER                                                        ;
           format = '*UNKNOWN'                                       ;
           EXSR @error                                               ;
        ENDSL                                                        ;

        IF not DateError                                             ;
           IF %dec(%char(workDate:*iso0):8:0) > 20391231
              or %dec(%char(workDate:*iso0):8:0) < 19391231          ;
              err_msg = 'date out of window range'                   ;
              DspTxtMsg(err_msg: warning)                            ;
           ENDIF                                                     ;
         ENDIF                                                       ;

         RETURN DateError                                            ;

         BEGSR @error                                                ;
           IF ShowMessage                                            ;
           err_msg    = %char(DateValue) + ' is not a valid '        +
                        %trim(format) + ' date.'                     ;
           DspTxtMsg(err_msg: alert)                                 ;
           ENDIF                                                     ;
           DateError = *ON                                           ;
         ENDSR                                                       ;

      /end-free
     P CheckDate       E

      *------------------------------------------
      * Set the day of a date to a specific day
      *------------------------------------------
     P SetDay          B                   export
     D SetDay          PI              D
     D  DaysIn                        2S 0 Const
     D  DateIn                         D   OPTIONS(*nopass)
     D  BaseDate       S               D
      /free
         IF %parms > 1                                               ;
            BaseDate = DateIn                                        ;
         ELSE                                                        ;
            BaseDate = %date()                                       ;
         ENDIF                                                       ;
        IF DaysIn < 1 or DaysIn > 31                                 ;
           err_msg =  %char(DaysIn) + ' is not a valid day value'    ;
           DspTxtMsg(err_msg: alert)                                 ;
        ELSE                                                         ;
           MONITOR                                                   ;
           ResultDy = BaseDate - %days(%subdt(BaseDate:*d) - 1) +
                    %days(DaysIn - 1)                                ;
           ON-ERROR                                                  ;
              err_msg =  'Result is not a valid date'                ;
              DspTxtMsg(err_msg: alert)                              ;
              ResultDy = BaseDate                                    ;
           ENDMON                                                    ;
        ENDIF                                                        ;
         RETURN ResultDy                                             ;
      /end-free
     P SetDay          E

      *--------------------------------------------
      * Set the month of a date to a specific month
      *--------------------------------------------
     P SetMonth        B                   export
     D SetMonth        PI              D
     D  MnthIn                        2S 0 Const
     D  DateIn                         D   OPTIONS(*nopass)
     D  BaseDate       S               D
      /free
         IF %parms > 1                                               ;
            BaseDate = DateIn                                        ;
         ELSE                                                        ;
            BaseDate = %date()                                       ;
         ENDIF                                                       ;
         IF mnthIn < 1 or MnthIn > 12                                ;
           err_msg =  %char(MnthIn) + ' is not a valid month value'  ;
           DspTxtMsg(err_msg: alert)                                 ;
         ELSE                                                        ;
           MONITOR                                                   ;
              ResultMn = BaseDate - %months(%subdt(BaseDate:*m) - 1) +
                    %months(MnthIn - 1)                              ;
           ON-ERROR                                                  ;
              err_msg =  'Result is not a valid date'                ;
              DspTxtMsg(err_msg: alert)                              ;
              ResultMn = BaseDate                                    ;
           ENDMON                                                    ;
         ENDIF                                                       ;
         RETURN ResultMn                                             ;
      /end-free
     P SetMonth        E

      *--------------------------------------------
      * Set the year of a date to a specific year
      *--------------------------------------------
     P SetYear         B                   export
     D SetYear         PI              D
     D  YearIn                        4S 0 Const
     D  DateIn                         D   OPTIONS(*nopass)
     D  BaseDate       S               D
      /free
         IF %parms > 1                                               ;
            BaseDate = DateIn                                        ;
         ELSE                                                        ;
            BaseDate = %date()                                       ;
         ENDIF                                                       ;
         IF YearIn < 1939 or  YearIn > 2040                          ;
            err_msg =  %char(YearIn) + ' is out of year date  range' ;
            DspTxtMsg(err_msg: alert)                                ;
         ELSE                                                        ;
           MONITOR                                                   ;
               ResultYr = BaseDate - %years(%subdt(BaseDate:*y) - 1) +
                    %years(YearIn - 1)                               ;
           ON-ERROR                                                  ;
              err_msg =  'Result is not a valid date'                ;
              DspTxtMsg(err_msg: alert)                              ;
              ResultYr = BaseDate                                    ;
           ENDMON                                                    ;
         ENDIF                                                       ;

         RETURN ResultYr                                             ;
      /end-free
     P SetYear         E

      *--------------------------------------------
      * Get the quarter
      *--------------------------------------------
     P GetQuarter      B                   export
     D GetQuarter      PI             3S 0
     D   DateIn                       8S 0 CONST options(*nopass)
     D InvalidDate     S               n
     D DteFormat       S              5    INZ('*ISO')
     D DateValue       S              8S 0
      /free
         IF %parms < 1;
            Quarter = %div(%subdt(%date():*m) - 1 : 3) + 1           ;
         ELSE                                                        ;
            DateValue = DateIn                                       ;
            InvalidDate = CheckDate(DateValue:DteFormat)             ;
            IF not InvalidDate                                       ;
               Quarter = %div(%subdt(WorkDate:*m) - 1 : 3) + 1       ;
            ENDIF                                                    ;
         ENDIF                                                       ;
         RETURN Quarter                                              ;
      /end-free
     P GetQuarter      E

      *--------------------------------------------
      * Find the date the quarter started
      *--------------------------------------------
     P QuarterStarted  B                   export
     D QuarterStarted  PI             8S 0
     D   DateIn                       8S 0 CONST options(*nopass)
     D InvalidDate     S               n
     D DteFormat       S              5    INZ('*ISO')
     D DateOut         S              8S 0
     D DateValue       S              8S 0
      /free
         InvalidDate = *off                                          ;
         IF %parms < 1                                               ;
            Quarter = GetQuarter()                                   ;
            DateValue = DateToday()                                  ;
         ELSE                                                        ;
            DateValue = DateIn                                       ;
            InvalidDate = CheckDate(DateValue:DteFormat)             ;
            IF not InvalidDate                                       ;
               Quarter = GetQuarter(DateValue)                       ;
            ENDIF                                                    ;
         ENDIF                                                       ;
         IF InvalidDate                                              ;
            DateOut = -3                                             ;
         ELSE                                                        ;
            MonthQtr = (Quarter - 1) * 3 + 1                         ;
            FirstQ = %subst(%char(DateValue):1:4)                    +
                     %editc(MonthQtr:'X') + '01'                     ;
            DateOut = %dec(FirstQ :8 :0)                             ;
         ENDIF                                                       ;
         RETURN DateOut                                              ;
      /end-free
     P QuarterStarted  E

      *--------------------------------------------
      * Find the date the quarter ended
      *--------------------------------------------
     P QuarterEnded    B                   export
     D QuarterEnded    PI             8S 0
     D   DateIn                       8S 0 CONST options(*nopass)
     D InvalidDate     S               n
     D DteFormat       S              5    INZ('*ISO')
     D DateOut         S              8S 0
     D DateValue       S              8S 0
      /free
         InvalidDate = *off                                          ;
         IF %parms < 1                                               ;
            DateISO = %dec(%char(%date():*iso0):8:0)                 ;
         ELSE                                                        ;
            DateValue = DateIn                                       ;
            InvalidDate = CheckDate(DateValue:DteFormat)             ;
            IF not InvalidDate                                       ;
               DateISO = QuarterStarted(DateValue)                   ;
            ENDIF                                                    ;
         ENDIF                                                       ;
         IF InvalidDate                                              ;
            DateOut = -3                                             ;
         ELSE                                                        ;
            FirstOfQ = %date(FirstQ:*iso0)                           ;
            LastOfQ = FirstOfQ + %months(3) - %days(1)               ;
            DateOut = %dec(%char(LastOfQ:*iso0):8:0)                 ;
         ENDIF                                                       ;
         RETURN DateOut                                              ;
      /end-free
     P QuarterEnded    E
      *--------------------------------------------
      * Date text
      *--------------------------------------------
     P DateText        B                   export
     D DateText        PI            30A
     D  DateType                      1    CONST
     D   DateIn                       8S 0 CONST options(*nopass)

     D  DateAlpha      S              8
     D  DateCode       S              1
     D  DateString     S             30
     D  DateValue      S              8S 0
     D  Date6E         S              8
     D  Date8E         S             10
     D  DayName        S             10
     D  InvalidDate    S               n
     D  MonthName      S             10
     D  ThisMonth      S              2s 0
     D  WeekDay        S              3s 0
     D                 DS
     D DayTable                      70A   Inz('Monday    +
     D                                          Tuesday   +
     D                                          Wednesday +
     D                                          Thursday  +
     D                                          Friday    +
     D                                          Saturday  +
     D                                          Sunday    ')
     D Days                          10A   Dim(7) Overlay(DayTable)
     D                 DS
     D MonthTable                   120    Inz('January   +
     D                                          February  +
     D                                          March     +
     D                                          April     +
     D                                          May       +
     D                                          June      +
     D                                          July      +
     D                                          August    +
     D                                          September +
     D                                          October   +
     D                                          November  +
     D                                          December  ')
     D  Months                       10A   DIM(12) overlay(MonthTable)
     D
      /free
         InvalidDate = *off                                          ;
         IF %parms < 2                                               ;
            DateAlpha = %char(%date():*iso0)                         ;
         ELSE                                                        ;
            DateValue = DateIn                                       ;
            InvalidDate = CheckDate(DateValue:'*ISO')                ;
            IF not InvalidDate                                       ;
               DateAlpha = %editc(DateValue:'X')                     ;
            ENDIF                                                    ;
         ENDIF                                                       ;
         IF not InvalidDate                                          ;
            ThisMonth = %dec(%subst(DateAlpha:5:2):2:0)              ;
            WeekDay   = DayofWeek(%date(DateAlpha:*iso0))            ;
            DayName = Days(WeekDay)                                  ;
            MonthName = Months(ThisMonth)                            ;
            DateString = *blanks                                     ;
            DateCode = UpperCase(DateType:%size(DateType))           ;
            SELECT                                                   ;
               WHEN DateCode = 'D'                                   ;
                  DateString = DayName                               ;
               WHEN DateCode = 'F'                                   ;
                  DateString = %trim(DayName) + ', '                 +
                               %trim(MonthName) + ' '                +
                               %trim(%subst(DateAlpha:7:2)) + ', '   +
                               %trim(%subst(DateAlpha:1:4))          ;
               WHEN DateCode = 'I'                                   ;
                  Date8E = %char(%date():*iso)                       ;
                  DateString = %trim(DayName) + ', ' + Date8E        ;
               WHEN DateCode = 'M'                                   ;
                  DateString = MonthName                             ;
               WHEN DateCode = 'T'                                   ;
                  Date6E = %char(%date():*mdy)                       ;
                  DateString = %trim(DayName) + ', ' + Date6E        ;
               OTHER                                                 ;
                  DateString = 'Unrecognized format.'                ;
            ENDSL                                                    ;
         ELSE                                                        ;
               DateString = 'Invalid date requested.'                ;
         ENDIF                                                       ;
         RETURN DateString                                           ;
      /end-free
     P DateText        E

     P DspTxtMsg       B

     D DspTxtMsg       PI
     D  InString                    255
     D  InTitle                      27    options(*nopass)

     DMsgBox           pr                  extpgm('QUILNGTX')
     D LngTxt                       255a
     D TextLen                       10i 0 const
     D TxtTitle                       7a
     D TxtMsgF                       20a
     D ErrCode                       16a

     d Text            s            255a   inz(*blank)
     d String          s            255a   inz(*blank)
     d Title           s              7a   inz(*blank)
     d MessageF        s             20a   inz(*blank)
     d Error           s             16a
     d TitleString     s             27    varying inz(*blank)
     d tx              s              2  0
     d BlankString     s             27    inz(*blank)
     D JobType         S              1

      /free

         title = *blanks;
         messagef = *blanks;

         IF %parms = 1;
             String = inString;
         ENDIF;

         IF %parms = 2;
            String = inString;
            TitleString = %trim(inTitle);
         ENDIF;

         IF TitleString <> *blank;
            IF %len(titlestring)< 27;
               tx = ((27-%len(titlestring))/2);
               titlestring = %subst(blankstring:1:tx)
                           + titlestring;
               titlestring = titlestring
                           + %subst(blankstring:1:%len(titlestring));
               IF %subst(titlestring:1:1)=*blank;
                 %subst(titlestring:1:1)='.';
               endif;
               IF %subst(titlestring:27:1)=*blank;
                  %subst(titlestring:27:1)='.';
               ENDIF;
               title=%subst(titlestring:1:7);
               messageF=%subst(titlestring:8:20);
            ENDIF;
         ENDIF;

         JobType = GetJobAtr();
        //* B/atch I/nteractive P/restart?
         IF JobType = 'I';
            Text=%trim(String);
            Error='';
            MsgBox(Text: %len(Text): Title: MessageF:  Error);
         ENDIF;
         RETURN;

      /end-free

     P DspTxtMsg       E