Retro1.org codex

*DECK DLCKDA
USETEXT DLFPDEF 
USETEXT DLNOD 
PROC DLCKDA(DATEF, ERRCODE); # CHECK DATE IN DISPLAY CODE              #
*IF DEF,IMS 
 #
*1DC  DLCKDA
* 
*     1. PROC NAME           AUTHOR              DATE.
*        DLCKDA              P.C.TAM             78/11/07 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        CHECK DATE FIELD FOR VALIDITY. 
* 
*     3. METHOD USED. 
*        CHECK EACH DIGIT FOR VALID NUMBER DIGIT, 
*        CHECK YEAR TO BE GREATER THAN 0
*        CHECK MONTH TO BE BETWEEN 1 AND 12,
*        CHECK DAY FOR VALID DATE.
* 
*     4. ENTRY PARAMETERS.
*        DATEF               DATE INPUT 
* 
*     5. EXIT PARAMETERS. 
*        ERRCODE             RETURN CODE FOR ERROR
* 
*     6. COMDECKS CALLED AND SYMPL TEXT USED. 
*        DLFPDEF   DLNOD
* 
*     7. ROUTINES CALLED. 
*        NONE.
* 
*     8. DAYFILE MESSAGES.
*        NONE.
* 
 #
*ENDIF
 
# 
      LOCAL VARIABLES 
# 
 
 
      ITEM
      DATEF      U,          # DATE FIELD                              #
      ERRCODE    I,          # ERROR RETURN CODE                       #
      D1         I,          # DIGIT ONE                               #
      D2         I,          # DIGIT TWO                               #
      D3         I,          # DIGIT THREE                             #
      D4         I,          # DIGIT FOUR                              #
      D5         I,          # DIGIT FIVE                              #
      D6         I,          # DIGIT SIX                               #
      YY         I,          # YEAR                                    #
      MM         I,          # MONTH                                   #
      DD         I,          # DATE                                    #
      TEMP1      I;          # TEMPORARY VARIABLE                      #
 
# ******************************************************************** #
      BEGIN 
      D1 = C<0,1>DATEF - O"33"; 
      D2 = C<1,1>DATEF - O"33"; 
      D3 = C<2,1>DATEF - O"33"; 
      D4 = C<3,1>DATEF - O"33"; 
      D5 = C<4,1>DATEF - O"33"; 
      D6 = C<5,1>DATEF - O"33"; 
      YY = D1 * 10 + D2;     # YEAR                                    #
      MM = D3 * 10 + D4;     # MONTH                                   #
      DD = D5 * 10 + D6;     # DAY                                     #
      TEMP1 = YY/4; 
      IF YY - TEMP1 * 4 EQ 0
      THEN
        NOD[2] = 29;         # LEAP YEAR                               #
      ELSE
        NOD[2] = 28;
      IF C<6,4>DATEF EQ 0 AND      # DATE MUST BE 6 CHARS LONG         #
         (0 LQ D1 AND D1 LQ 9) AND
         (0 LQ D2 AND D2 LQ 9) AND
         (0 LQ D3 AND D3 LQ 9) AND
         (0 LQ D4 AND D4 LQ 9) AND
         (0 LQ D5 AND D5 LQ 9) AND
         (0 LQ D6 AND D6 LQ 9) AND
         0 LQ YY AND YY LQ 99 AND  # YEAR BETWN 0 AND 99               #
         1 LQ MM AND MM LQ 12 AND  # MONTH BETWEEN 1 AND 12            #
         1 LQ DD AND DD LQ NOD[MM] # DATE BETWEEN 1 AND 30             #
      THEN
        ERRCODE = 0;
      ELSE
        ERRCODE = 1;
      END 
TERM