IBMi (AS400) fans only : How to check a date field ddmmyy



#IBMiSample

How to check the correctness of a numeric date field 6 with 0 decimals.

This program receives as input
1. a date in the DDMMYY format (p_data), for example p_data= 100612, that is June 10, 2012, an Error field (p_error).
2. a Flag field accepts date = 0 (p_zero).
3. returns a BLANK or 'E' value in the p_error field as a result of the check.


CHKDATA.RPGLE

      **free
       ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no)
        ALWNULL(*USRCTL) ;
        // Try with  STRDBG and
        // CALL CHKDATA PARM(X'0120718F' 'x' 'N') valid date
        // CALL CHKDATA PARM(X'0999999F' 'x' 'N') wrong date
        // CALL CHKDATA PARM(X'0000000F' 'x' 'Y') no date, but it is allowed
        // CALL CHKDATA PARM(X'0000000F' 'x' 'N') no date, it is not allowed
        dcl-pi CHKDATA;
          p_data packed(6);
          p_error char(1);
          p_zero  char(1); // Y=allows MyDate=000000
        end-pi;
        // **************************************************
        // start working
        // **************************************************
        p_error = *blanks;
          test(de) *dmy p_data ;
          dow 1=1;
            if (%error);
              if p_data = 0 and p_zero = 'Y';
                p_error = '0'; // MyDate is 0 and it is allowed
              else;
                p_error = 'E';
              endif;
              leave;
            endif;
            leave;
          enddo;
        *inlr = *on;




Thanks to the comments of my 4 readers I wrote a new CHKDATA.RPGLE version.

CHKDATA.RPGLE

**free
 ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no)
  ALWNULL(*USRCTL) ;
  // Try with  STRDBG and
  // CALL CHKDATA PARM(X'0120718F' 'x' 'N') valid date
  // CALL CHKDATA PARM(X'0999999F' 'x' 'N') wrong date
  // CALL CHKDATA PARM(X'0000000F' 'x' 'Y') no date, but it is allowed
  // CALL CHKDATA PARM(X'0000000F' 'x' 'N') no date, it is not allowed
  dcl-pi CHKDATA;
    p_data packed(6);// a date in the DDMMYY format
    p_error char(1); // E=wrong date 0=no date *blanks=date OK
    p_zero  char(1); // Y=allows MyDate=000000
  end-pi;
  // **************************************************
  // start working
  // **************************************************
  p_error = *blanks;
    test(de) *dmy p_data ;
    if (%error);
      p_error = 'E';
      if p_data = 0 and p_zero = 'Y';
        p_error = '0'; // MyDate is 0 and it is allowed
      endif;
    endif;
  *inlr = *on;

I appreciate all the comments made on this blog.

Comments

Popular posts from this blog

(IBM i fans only) Efficient WRKSPLF with WSF - How to Search string into spooled files, Sort, and Generate PDFs on IBMi

(IBM i fans only) Detecting and Handling Non-Printable Characters in DB2 SQL Using LOCATE() and REPLACE() Functions

(IBM i fans only) How to Sniff User Access