New Date Intrinsics for MPE/iX

 
$standard_level 'hp_modcal'$
 
Program dateintr(input,output);
 
     {Constants for the different date types.}
const
      hp_dt_mpe_time_stamp_fmt   = 1;
      hp_dt_packed_yymmdd_fmt    = 2;
      hp_dt_packed_yyddd_fmt     = 3;
      hp_dt_new_calendar_fmt     = 4;
 
      hp_dt_posix_time_stamp_fmt = 10;
 
      hp_dt_calendar_fmt         = 14;
      hp_dt_int_yymmdd_fmt       = 15;
      hp_dt_int_mmddyy_fmt       = 16;
      hp_dt_int_ddmmyy_fmt       = 17;
      hp_dt_int_yyyymmdd_fmt     = 18;
 
      hp_dt_ascii_yymmdd_fmt     = 25;
      hp_dt_ascii_mmddyy_fmt     = 26;
      hp_dt_ascii_ddmmyy_fmt     = 27;
 
      hp_dt_mm3000_yymmdd_fmt    = 35;
      hp_dt_mm3000_mmddyy_fmt    = 36;
      hp_dt_mm3000_ddmmyy_fmt    = 37;
      hp_dt_ascii_yyyymmdd_fmt   = 38;
 
      {Type definitions for the program}
type
    pac_20       = packed array [1..20] of char;
    iptr_type    = ^integer;
 
VAR
    date2_pac        : pac_20;      {Dates in packed character arrays.}
    fmt_pac          : pac_20;
    print_pac        : pac_20;
 
    cutoff           : integer;     {To represent cutoff date.}
    date1            : integer;     {Working dates.}
    date1_18         : integer;
    date2_18         : integer;
    date3_18         : integer;
    i                : integer;     {temp variables.}
    inptype          : integer;
    j                : integer;
    outtype          : integer;
    print_len        : integer;     {Length of formatted date.}
    temp_date        : integer;     {Another temp variable}
 
    status           : integer;
 
function HPCALENDAR : integer; intrinsic;
procedure HPFMTCALENDAR; intrinsic;
function HPDATEVALIDATE : integer; intrinsic;
procedure HPDATEFORMAT ; intrinsic;
procedure HPDATECONVERT ; intrinsic;
procedure HPDATEOFFSET ; intrinsic;
procedure HPDATEDIFF ; intrinsic;

begin
       {Initialize the variables.}
     cutoff  := 50;
     inptype := hp_dt_int_ddmmyy_fmt;
 
     date2_pac := '960121'; {The YYMMDD date in Supported format '25'.}
     date1     := 230196;   {The DDMMYY date in Supported format '17'.}
 
 
           {conversion from one non standard formatto another}
     HPDATECONVERT(inptype,date1,hp_dt_ascii_yymmdd_fmt,fmt_pac,
                status,cutoff);
     if( status <> 0) then
            writeln('HPDATECONVERT intrinsic returned error',status);
 
        {Convert 'date1' to the YYYYMMDD integer format. With 50}
        {as the cutoff year.                                    }
     outtype := hp_dt_int_yyyymmdd_fmt;
     HPDATECONVERT(inptype,date1,outtype,date1_18,status,cutoff);
     if( status <> 0) then
            writeln('HPDATECONVERT intrinsic returned error',status);
 
 
        {Convert the 'date2_pac' to a YYMMDD integer format.}
        {Default cutoff is assumed (i.e., 50)               }
     HPDATECONVERT(hp_dt_ascii_yymmdd_fmt,date2_pac,
      outtype,date2_18,status);
     if( status <> 0) then
        writeln('HPDATECONVERT intrinsic returned error',status);
 
        {compute the difference between the two dates}
     HPDATEDIFF(outtype, date1_18,date2_18,temp_date,status,cutoff);
 
     if( temp_date <  0) then
             writeln(date1,' is #',temp_date,
      'days later compared to ',date2_pac)
     else if (temp_date > 0) then
         writeln(date2_pac,' is #',temp_date,
          'days later compared to ',date1)
     else writeln(date1,' is same as ',date2_pac);
 
 
        {offset date1_18 by the difference to get the     }
        {value of date2_18 through HPDATEOFFSET intrinsic.}
     HPDATEOFFSET(outtype,date1_18,temp_date,date3_18,status,cutoff);
     if( (date3_18 <> date2_18 ) and (status = 0)) then
             writeln('Error Malfunction of HPDATEOFFSET intrinsic');
 
        {Use the flexibility in converting the date to a display }
        {string. Use '#0' to NULL terminate the format           }
        {specification string.                                   }
     fmt_pac := 'YY.ZMM.ZDD'#0;
     print_len := 11; { 11 characters including #0 in fmt_pac }
     HPDATEFORMAT(outtype,date1_18,fmt_pac,print_pac,print_len,status);

     if( status <> 0) then
             writeln('HPDATEFORMAT intrinsic returned error',status);
 
     writeln('The converted date is: ',print_pac);
 
        {The following demonstrates how a byte array can be      }
        {passed in place of an integer. We are storing the       }
        {integer 230196 in a packed array of characters, which is}
        {an equivalent of a byte array. We subsequently cast the }
        {address of this array to an integer pointer to read the }
        {integer value out of it.                                }
     HPDATECONVERT(hp_dt_int_yyyymmdd_fmt,date1_18,
         hp_dt_int_ddmmyy_fmt,fmt_pac,status);
 
     $push, type_coercion 'storage'$
     if( iptr_type (addr(fmt_pac))^ = date1 ) then
             writeln( 'Program worked fine! ')
     else    writeln( 'Error, in using byte array parameters !');
     $pop$
 
end.

230196 is #     2days later compared to 960121
The converted date is : 96.1.23
Program worked fine!

       IDENTIFICATION DIVISION.
       PROGRAM-ID.   DATEINTR.
       REMARKS. SAMPLE PROGRAM USING DATE INTRINSICS
       DATA DIVISION.
       WORKING-STORAGE SECTION.
      *Date code for YYMMDD is 25, for YYYYMMDD is 38
       01 INDATE-CODE                  PIC S9(9) VALUE 25.
       01 OUTDATE-CODE                 PIC S9(9) VALUE 38.
       01 SPLITYEAR                    PIC S9(9) VALUE 70.
       01 OUTDATE-YYYYMMDD             PIC X(8) VALUE SPACES.
       01 INDATE-YYMMDD                PIC X(6) VALUE SPACES.
       01 STATUS-VAR.
          05 S-INFO                    PIC S9(4) COMP VALUE 0.
          05 S-SUBSYS                  PIC S9(4) COMP VALUE 0.
 
       PROCEDURE DIVISION.
       CONVERT-DATE-PARA.
          DISPLAY 'Enter the date in YYMMDD format:'
          ACCEPT INDATE-YYMMDD
          CALL INTRINSIC "HPDATECONVERT" USING
                                         INDATE-CODE
                                         INDATE-YYMMDD
                                         OUTDATE-CODE
                                         OUTDATE-YYYYMMDD
                                         STATUS-VAR
                                         SPLITYEAR
          IF S-INFO NOT = 0
             PERFORM DISPLAY-ERROR
          ELSE
             DISPLAY "Convert Date in YYYYMMDD = " OUTDATE-YYYYMMDD
          END-IF
          STOP RUN.
 
       DISPLAY-ERROR.
          DISPLAY "HPDATECONVERT FAILED. ERROR = " S-INFO.