C -------------------------------------- SUBROUTINE DATEIN(DAY,MONTH,YEAR) C -------------------------------------- C THIS PROGRAM GETS THE DATE FROM TT: C IN RT-11 FORMAT (EITHER D-MMM-YY OR C DD-MMM-YY), AND RETURNS THE VALIDATED C INTEGER RESULTS TO THE CALLER. C -------------------------------------- C DATA DEFINITION C -------------------------------------- INTEGER*2 I !GENERAL PURPOSE COUNTER. INTEGER*2 DAY !DAY (1 TO DAYS(MONTH)). INTEGER*2 MONTH !MONTH (1 TO 12). INTEGER*2 YEAR !YEAR (79 TO 82) INTEGER*2 DAYS(12) !DAYS PER MONTH (FIXED). LOGICAL*1 DATE(10) !CHAR STRING DATE FROM TT: LOGICAL*1 ERROR !GENERAL PURPOSE ERROR FLAG. LOGICAL*1 MONTHS(37) !CHAR STRING OF ALL MONTHS. LOGICAL*1 AMONTH(4) !CURRENT MONTH STRING. LOGICAL*1 BADVAL !LIMIT COMPARISON FUNCTION. DATA DAYS/31,28,31,30,31,30,31,31,30,31,30,31/ CALL SCOPY('JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC',MONTHS) C -------------------------------------- $PAGE C -------------------------------------- C MAIN PROCEDURE C -------------------------------------- 1 CONTINUE !HERE ON RESTART. GET-THE-DATE-STRING-FROM-TT DECODE-THE-DAY-AND-YEAR DETERMINE-THE-MONTH VALIDATE-THE-INTEGER-DATE-VALUES-OBTAINED RETURN !WHEN THE DATE IS VALID TO GET-THE-DATE-STRING-FROM-TT TYPE 100 100 FORMAT(/'$DATE? ') CALL GETSTR(5,DATE,9,ERROR) IF (ERROR) TRY-AGAIN FIN TO DECODE-THE-DAY-AND-YEAR SELECT (INDEX(DATE,'-')) (2)DECODE(8,200,DATE,ERR=1000)DAY,YEAR (3)DECODE(9,210,DATE,ERR=1000)DAY,YEAR (OTHERWISE) TRY-AGAIN FIN YEAR=YEAR+1900 200 FORMAT(I1,5X,I2) 210 FORMAT(I2,5X,I2) FIN TO DETERMINE-THE-MONTH MONTH=0 DO (I=1,12) CALL SUBSTR(MONTHS,AMONTH,(I-1)*3+1,3) IF (INDEX(DATE,AMONTH).NE.0) MONTH=I FIN FIN $PAGE TO VALIDATE-THE-INTEGER-DATE-VALUES-OBTAINED IF (BADVAL(YEAR,1979,1980)) TRY-AGAIN IF (BADVAL(MONTH,1,12)) TRY-AGAIN IF (BADVAL(DAY,1,DAYS(MONTH))) TRY-AGAIN FIN TO TRY-AGAIN 1000 TYPE 1010 1010 FORMAT(' DATIME-I-Bad date data!'/' FORMAT IS "DD-MMM-YY"') GO TO 1 FIN END