/********************************************************************/ 00050003 /* @Z40LB35*/ 00100003 /* PROCEDURE NAME - DATES (ACCESS METHOD SERVICES) @Z40LB35*/ 00150003 /* @Z40LB35*/ 00200003 /* FUNCTION - THIS COMMON INCLUDED PROCEDURE PROVIDES @Z40LB35*/ 00250003 /* THE AMS SERVICES WITH THE BASIC FUNCTION OF @Z40LB35*/ 00300003 /* CONVERTING A ONE VALUE DATE SUCH AS 99999 TO @Z40LB35*/ 00350003 /* '00 99 0999' OR OBTAINING THE CURRENT DATE AND@Z40LB35*/ 00400003 /* ADJUSTING IT BY EITHER ADDING OR SUBTRACTING @Z40LB35*/ 00450003 /* DAYS TO THAT DATE. THE DATE WILL BE ADJUSTED @Z40LB35*/ 00500003 /* FOR ANY LEAP YEARS. THE DATE WILL ALSO BE @Z40LB35*/ 00550003 /* ADJUSTED TO FIT WITHIN THE RANGE 0 TO 99999. @Z40LB35*/ 00600003 /* @Z40LB35*/ 00650003 /* ENTRY POINT - DATES @Z40LB35*/ 00700003 /* @Z40LB35*/ 00750003 /* LINKAGE - 'CALL DATES (DATESAGL)' @Z40LB35*/ 00800003 /* '%INCLUDE SYSLIB(IDCDF55)' @Z40LB35*/ 00850003 /* @Z40LB35*/ 00900003 /* INPUT - ADDRESS OF ARGUMENT LIST (DATESAGL) @Z40LB35*/ 00950003 /* @Z40LB35*/ 01000003 /* OUTPUT - A RETURN CODE IN REGISTER 15 @Z40LB35*/ 01050003 /* (0) - DATES SUCCESSFUL @Z40LB35*/ 01100003 /* @Z40LB35*/ 01150003 /* - A CONVERTED DATE (00 YY DDDD) IN BINARY @Z40LB35*/ 01200003 /* @Z40LB35*/ 01250003 /* EXIT NORMAL - RETURNS TO CALLER WITH CONDITION @Z40LB35*/ 01300003 /* CODE ZERO @Z40LB35*/ 01350003 /* @Z40LB35*/ 01400003 /* EXIT ERROR - NONE @Z40LB35*/ 01450003 /* @Z40LB35*/ 01500003 /* CHANGE ACTIVITY - NONE @Z40LB35*/ 01550003 /* @Z40LB35*/ 01600003 /********************************************************************/ 01650003 DATES: PROC; /*@Z40LB35*/ 01700003 /*DECLARATION FOR DATES PROCEDURE @Z40LB35*/ 01750003 DCL TIMEVAR CHAR(8); /*TIME VARIABLE - UTIME @Z40LB35*/ 01800003 /*USED IN UTIME CALL @Z40LB35*/ 01850003 DCL 1 DATEVAR CHAR(4), /*DATE VARIABLE - UTIME @Z40LB35*/ 01900003 2 * CHAR(1), /*FILLER - RESERVED @Z40LB35*/ 01950003 2 DATEPACK CHAR(3); /*DATE RETURN - PACKED @Z40LB35*/ 02000003 /*DECIMAL FORMAT @Z40LB35*/ 02050003 /*THE FOLLOWING STRUCTURE IS THE DATE RETURNED @Z40LB35*/ 02100003 DCL 1 CONVDATE BDY(WORD) BASED(DATRETRN), 02150003 2 CONVYEAR FIXED(15), /*YEAR - RANGE 0 - 99 @Z40LB35*/ 02200003 2 CONVDAYS FIXED(15); /*DAYS - RANGE 0 - 999 @Z40LB35*/ 02250003 /*THE FOLLOWING DECLARES ARE INTERNAL FIELDS @Z40LB35*/ 02300003 DCL DATEBIN FIXED(31); /*USED TO UNPACK DATE @Z40LB35*/ 02350003 DCL QUITSW BIT(1); /*USED TO CONTROL LOOPS @Z40LB35*/ 02400003 DCL ADJDAYS FIXED(31); /*USED TO ADJUST DAYS @Z40LB35*/ 02450003 /*THE FOLLOWING ARE STATIC CONSTANTS @Z40LB35*/ 02500003 DCL REGYEAR FIXED(15) INIT(365); /*@Z40LB35*/ 02550003 /*NUM DAYS IN REG YEAR @Z40LB35*/ 02600003 DCL LEAPYEAR FIXED(15) INIT(366); /*@Z40LB35*/ 02650003 /*NUM DAYS IN LEAP YEAR @Z40LB35*/ 02700003 DCL MAXYEAR FIXED(15) INIT(99); /*@Z40LB35*/ 02750003 /*HIGHEST YEAR @Z40LB35*/ 02800003 DCL MAXDAYS FIXED(15) INIT(999); /*@Z40LB35*/ 02850003 /*HIGHEST DAYS @Z40LB35*/ 02900003 DCL MINYEAR FIXED(15) INIT(0); /*@Z40LB35*/ 02950003 /*LOWEST YEAR @Z40LB35*/ 03000003 DCL MINDAYS FIXED(15) INIT(0); /*@Z40LB35*/ 03050003 /*LOWEST DAYS @Z40LB35*/ 03100003 DCL NOREMAIN FIXED(15) INIT(0); /*@Z40LB35*/ 03150003 /*NO REMAINDER AFTER DIV @Z40LB35*/ 03200003 @EJECT; /*@Z40LB35*/ 03250003 /* THIS IS THE START OF THIS PROCEDURE @Z40LB35*/ 03300003 /* HERE INITIALIZATION TAKES PLACE. @Z40LB35*/ 03350003 /* THE PARM LIST HEADER IS INITIALIZED, @Z40LB35*/ 03400003 /* THE TRACE POINT 'DTST' IS RECORDED, AND @Z40LB35*/ 03450003 /* THE DATE IS SET TO ZERO. @Z40LB35*/ 03500003 UTRACE = 'DTST'; /*@Z40LB35*/ 03550003 DATHEAD = 'DATESAGL'; /*@Z40LB35*/ 03600003 CONVDATE = 0; /*@Z40LB35*/ 03650003 /* DETERMINE IF CALLER WANTS THE CURRENT DATE @Z40LB35*/ 03700003 /* ADJUSTED WITH DAYS ADD OR SUBTRACTED. @Z40LB35*/ 03750003 IF DATDAYOP = ON THEN 03800003 DO; /*@Z40LB35*/ 03850003 /* IF CALLER WANTS TO ADJUST CURRENT DATE, @Z40LB35*/ 03900003 /* ISSUE UTIME TO RETRIEVE CURRENT DATE, @Z40LB35*/ 03950003 /* CONVERT THE DATE FROM PACKED DECIMAL TO @Z40LB35*/ 04000003 /* BINARY, AND SEPARATE THE YEARS FROM THE @Z40LB35*/ 04050003 /* DAYS. @Z40LB35*/ 04100003 ADJDAYS = DATDAYS; /*@Z40LB35*/ 04150003 UTIME (GDTTBL,TIMEVAR,DATEVAR); /*@Z40LB35*/ 04200003 CVB(DATEBIN,DATEPACK); /*@Z40LB35*/ 04250003 CONVYEAR = DATEBIN/1000; /*@Z40LB35*/ 04300003 CONVDAYS = DATEBIN - (CONVYEAR*1000); /*@Z40LB35*/ 04350003 /*INITIALIZE QUITSW OFF FOR LOOP CONTROL @Z40LB35*/ 04400003 QUITSW = OFF; /*@Z40LB35*/ 04450003 /*DETERMINE IF CALLER WANTS DAYS ADDED TO @Z40LB35*/ 04500003 /*CURRENT DATE. @Z40LB35*/ 04550003 IF DATADD = ON THEN 04600003 /*IF CALLER WANTS DAYS ADDED, LOOP THOUGH @Z40LB35*/ 04650003 /*THE FOLLOWING DO LOOP UNTIL QUITSW IS SET @Z40LB35*/ 04700003 DO WHILE QUITSW = OFF; /*@Z40LB35*/ 04750003 /*TEST FOR LEAP YEAR - EVERY FOUTH YEAR IS LEAP @Z40LB35*/ 04800003 /*YEAR. IF NO REMAINDER AFTER DIVIDING BY FOUR @Z40LB35*/ 04850003 /*THEN THE YEAR BEING PROCESSED IS A LEAP YEAR @Z40LB35*/ 04900003 IF CONVYEAR//4 = NOREMAIN THEN 04950003 /*DETERMINE IF THE DAYS BEING ADDED CAN BE @Z40LB35*/ 05000003 /*ADDED TO CURRENT YEAR BEING PROCESSED WITHOUT @Z40LB35*/ 05050003 /*AN OVERFLOW INTO THE NEXT YEAR. @Z40LB35*/ 05100003 IF (ADJDAYS + CONVDAYS) > LEAPYEAR THEN 05150003 /*SUBTRACT LEAP YEAR DAYS (366) FROM DAYS @Z40LB35*/ 05200003 /*AND INCREMENT YEAR BY ONE @Z40LB35*/ 05250003 DO; /*@Z40LB35*/ 05300003 ADJDAYS = ADJDAYS - LEAPYEAR; /*@Z40LB35*/ 05350003 CONVYEAR = CONVYEAR + 1; /*@Z40LB35*/ 05400003 END; /*@Z40LB35*/ 05450003 ELSE 05500003 /*INCREMENT DAYS AND SET QUITSW TO FALL OUT @Z40LB35*/ 05550003 /*OF DO LOOP @Z40LB35*/ 05600003 DO; /*@Z40LB35*/ 05650003 CONVDAYS = ADJDAYS + CONVDAYS; /*@Z40LB35*/ 05700003 QUITSW = ON; /*@Z40LB35*/ 05750003 END; /*@Z40LB35*/ 05800003 ELSE 05850003 /*DETERMINE IF THE DAYS BEING ADDED CAN BE @Z40LB35*/ 05900003 /*ADDED TO CURRENT YEAR BEING PROCESSED WITHOUT @Z40LB35*/ 05950003 /*AN OVERFLOW INTO THE NEXT YEAR. @Z40LB35*/ 06000003 IF (ADJDAYS + CONVDAYS) > REGYEAR THEN 06050003 /*SUBTRACT REG YEAR DAYS (365) FROM DAYS @Z40LB35*/ 06100003 /*AND INCREMENT YEAR BY ONE @Z40LB35*/ 06150003 DO; /*@Z40LB35*/ 06200003 ADJDAYS = ADJDAYS - REGYEAR; /*@Z40LB35*/ 06250003 CONVYEAR = CONVYEAR + 1; /*@Z40LB35*/ 06300003 END; /*@Z40LB35*/ 06350003 ELSE 06400003 /*INCREMENT DAYS AND SET QUITSW TO FALL OUT @Z40LB35*/ 06450003 /*OF DO LOOP @Z40LB35*/ 06500003 DO; /*@Z40LB35*/ 06550003 CONVDAYS = CONVDAYS + ADJDAYS; /*@Z40LB35*/ 06600003 QUITSW = ON; /*@Z40LB35*/ 06650003 END; /*@Z40LB35*/ 06700003 END; /*@Z40LB35*/ 06750003 @EJECT; /*@Z40LB35*/ 06800003 /*IF DAYS ARE TO BE SUBTRACTED FROM CURRENT, @Z40LB35*/ 06850003 /*DO THE FOLLOWING DO GROUP @Z40LB35*/ 06900003 ELSE 06950003 /*DO THE FOLLOWING WHILE THE QUITSW IS NOT SET @Z40LB35*/ 07000003 DO WHILE QUITSW = OFF; /*@Z40LB35*/ 07050003 /*TEST FOR LEAP YEAR - EVERY FOUTH YEAR IS LEAP @Z40LB35*/ 07100003 /*YEAR. IF NO REMAINDER AFTER DIVIDING BY FOUR @Z40LB35*/ 07150003 /*THEN THE YEAR BEING PROCESSED IS A LEAP YEAR @Z40LB35*/ 07200003 IF (CONVYEAR-1)//4 = NOREMAIN THEN 07250003 /*TEST TO SEE IF THE YEAR CAN BE DECREMENTED @Z40LB35*/ 07300003 IF ADJDAYS >= LEAPYEAR THEN 07350003 /*SUBTRACT LEAP YEAR DAYS (366) FROM DAYS @Z40LB35*/ 07400003 /*AND DECREMENT YEAR BY ONE @Z40LB35*/ 07450003 DO; /*@Z40LB35*/ 07500003 ADJDAYS = ADJDAYS - LEAPYEAR; /*@Z40LB35*/ 07550003 CONVYEAR = CONVYEAR - 1; /*@Z40LB35*/ 07600003 END; /*@Z40LB35*/ 07650003 ELSE 07700003 /*IF NO FULL YEAR, TEST FOR OVERFLOW @Z40LB35*/ 07750003 IF (CONVDAYS-ADJDAYS) <= 0 THEN 07800003 /*IF YEAR RUNS BACK INTO LAST YEAR, @Z40LB35*/ 07850003 /*ADJUST DAYS, SUBTRACT YEAR AND SET QUITSW @Z40LB35*/ 07900003 DO; /*@Z40LB35*/ 07950003 CONVDAYS = CONVDAYS + LEAPYEAR - ADJDAYS; 08000003 CONVYEAR = CONVYEAR - 1; /*@Z40LB35*/ 08050003 QUITSW = ON; /*@Z40LB35*/ 08100003 END; /*@Z40LB35*/ 08150003 ELSE 08200003 /*IF YEAR DOES NOT RUNS BACK INTO LAST YEAR, @Z40LB35*/ 08250003 /*ADJUST DAYS AND SET QUITSW @Z40LB35*/ 08300003 DO; /*@Z40LB35*/ 08350003 CONVDAYS = CONVDAYS - ADJDAYS; /*@Z40LB35*/ 08400003 QUITSW = ON; /*@Z40LB35*/ 08450003 END; /*@Z40LB35*/ 08500003 /*ELSE THIS IS A NORMAL YEAR(NON-LEAP YEAR) @Z40LB35*/ 08550003 ELSE 08600003 /*TEST TO SEE IF THE YEAR CAN BE DECREMENTED @Z40LB35*/ 08650003 IF ADJDAYS >= REGYEAR THEN 08700003 /*SUBTRACT REG YEAR DAYS (365) FROM DAYS @Z40LB35*/ 08750003 /*AND DECREMENT YEAR BY ONE @Z40LB35*/ 08800003 DO; /*@Z40LB35*/ 08850003 ADJDAYS = ADJDAYS - REGYEAR; /*@Z40LB35*/ 08900003 CONVYEAR = CONVYEAR - 1; /*@Z40LB35*/ 08950003 END; /*@Z40LB35*/ 09000003 ELSE 09050003 /*IF NO FULL YEAR, TEST FOR OVERFLOW @Z40LB35*/ 09100003 IF (CONVDAYS-ADJDAYS) <= 0 THEN 09150003 /*IF YEAR RUNS BACK INTO LAST YEAR, @Z40LB35*/ 09200003 /*ADJUST DAYS, SUBTRACT YEAR AND SET QUITSW @Z40LB35*/ 09250003 DO; /*@Z40LB35*/ 09300003 CONVDAYS = CONVDAYS + REGYEAR - ADJDAYS; 09350003 CONVYEAR = CONVYEAR - 1; /*@Z40LB35*/ 09400003 QUITSW = ON; /*@Z40LB35*/ 09450003 END; /*@Z40LB35*/ 09500003 ELSE 09550003 /*IF YEAR DOES NOT RUNS BACK INTO LAST YEAR, @Z40LB35*/ 09600003 /*ADJUST DAYS AND SET QUITSW @Z40LB35*/ 09650003 DO; /*@Z40LB35*/ 09700003 CONVDAYS = CONVDAYS - ADJDAYS; /*@Z40LB35*/ 09750003 QUITSW = ON; /*@Z40LB35*/ 09800003 END; /*@Z40LB35*/ 09850003 END; /*@Z40LB35*/ 09900003 END; /*@Z40LB35*/ 09950003 @EJECT; /*@Z40LB35*/ 10000003 /*DETERMINE IF THE CALLER WANTS THE DATE @Z40LB35*/ 10050003 /*CONVERTED @Z40LB35*/ 10100003 IF DATDTEOP= ON THEN 10150003 /*IF CALLER WANTS DATE CONVERTED, CONVERT THE @Z40LB35*/ 10200003 /*DATE BY SEPARATING THE YEARS FROM THE DAYS @Z40LB35*/ 10250003 DO; /*@Z40LB35*/ 10300003 CONVYEAR = DATDATE/1000; /*@Z40LB35*/ 10350003 CONVDAYS = DATDATE - (CONVYEAR * 1000); /*@Z40LB35*/ 10400003 END; /*@Z40LB35*/ 10450003 /*HERE THE DETERMINATION WILL BE MADE TO SEE @Z40LB35*/ 10500003 /*IF THE LIMITS ARE VIOLATED @Z40LB35*/ 10550003 /*IF SO, FORCE THE DATE TO FALL WITHIN THE @Z40LB35*/ 10600003 /*LIMITS (0 99999) @Z40LB35*/ 10650003 IF CONVYEAR > MAXYEAR THEN 10700003 DO; /*@Z40LB35*/ 10750003 CONVYEAR = MAXYEAR; /*@Z40LB35*/ 10800003 CONVDAYS = MAXDAYS; /*@Z40LB35*/ 10850003 END; /*@Z40LB35*/ 10900003 ELSE 10950003 IF CONVYEAR < MINYEAR | CONVDAYS < MINDAYS THEN 11000003 DO; /*@Z40LB35*/ 11050003 CONVYEAR = MINYEAR; /*@Z40LB35*/ 11100003 CONVDAYS = MINDAYS; /*@Z40LB35*/ 11150003 END; /*@Z40LB35*/ 11200003 /*RETURN TO CALLER WITH RETURN CODE ZERO @Z40LB35*/ 11250003 UDUMP (GDTTBL,'DTND'); /*@Z40LB35*/ 11300003 RETURN CODE(RCOK); /*@Z40LB35*/ 11350003 END DATES; /*@Z40LB35*/ 11400003