Web users have gotten used to what has become a standard approach to entering dates, namely a calendar where you can scroll by year and month, and then select a day.
The following code shows such a calendar implemented in Natural as a helproutine. The same code could be inserted in any object.
First, here is a program:
DEFINE DATA LOCAL
1 #DATE-N (N8)
1 REDEFINE #DATE-N
2 #YYP (N4)
2 #MMP (N2)
2 #DDP (N2)
END-DEFINE
*
SET KEY PF1=HELP
*
**MOVE 11 TO #MMP
*
- UNCOMMENT THE MOVE ABOVE TO SEE THE EFFECT
- OF A PARTIAL SELECTION
INPUT (AD=M)
5/10 ‘ENTER DATE (YYYYMMDD) OR HIT PF1 FOR HELP’
#DATE-N(EM=99999999 HE=‘CALEND10’)
*
IF #DATE-N NE 0
WRITE 5/10 ‘YOU SELECTED YEAR:’ #YYP
2X ‘MONTH:’ #MMP 2X ‘DAY:’ #DDP
ELSE
WRITE 5/10 ‘YOU DID NOT ENTER ANYTHING’
END-IF
*
END
And here is the helproutine
- THERE ARE MANY THINGS TO NOTE ABOUT THIS HELPROUTINE.
- IT IS ONLY DESIGNED TO WORK FOR THE YEARS 2000-2010.
- YOU CAN EXTEND THE ARRAY #STARTING-DAY TO ENCOMPASS
- ADDITIONAL YEARS.
- HITTING ENTER IS THE SAME AS HITTING PF2 (PICK).
- MONTH NAMES ARE IN ENGLISH. USING ANOTHER LANGUAGE
- MIGHT REQUIRE CHANGING THE FORMAT TO BE LARGER THAN A10.
- IF THERE IS A MONTH OR YEAR IN #DATE-N, THE
- HELPROUTINE WILL USE IT FOR THE STARTING DISPLAY.
DEFINE DATA PARAMETER
1 #DATE-N (N8)
1 REDEFINE #DATE-N
2 #YYP (N4)
2 #MMP (N2)
2 #DDP (N2)
LOCAL
1 #MM (A2) INIT <’ 1’>
1 #DD (A2)
1 #YY (A4)
1 #WEEK (N2/1:6,1:7)
1 REDEFINE #WEEK
2 #WEEK-STRING (N2/1:42)
1 #WEEK-LINE (N2)
1 #WEEK-DAY (N2)
1 #DATN (A8)
1 #DAYS-IN-MONTH (N2/1:12)
CONST <31,28,31,30,31,30,31,31,30,31,30,31>
1 #STARTING-DAY (N1/2000:2010) INIT <7,2,3,4,5,7,1,2,3,5,6>
1 #MONTH-OF-DAYS (N2/1:31)
INIT <1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31>
1 #START (N4)
1 #END (N4)
1 #END-MINUS-ONE (N4)
1 #MONTH-TEXT (A10/1:12)
INIT <‘JANUARY’,‘FEBRUARY’,‘MARCH’,‘APRIL’,‘MAY’,‘JUNE’,‘JULY’,
‘AUGUST’,‘SEPTEMBER’,‘OCTOBER’,‘NOVEMBER’,‘DECEMBER’>
1 #MONTH-YEAR-FOR-MAP (A15)
1 #DATE (D)
1 #DATE-A (A8)
1 #A (A1) /* HOLDS DAY OF THE WEEK
1 #DUMMY (P5) /* USED FOR LEAP YEAR TESTS
1 #REM (P5) /* USED FOR LEAP YEAR TESTS
END-DEFINE
*
FORMAT KD=ON
SET KEY PF2 NAMED ‘PICK’ PF4 NAMED ‘<MON’ PF6 NAMED ‘>MON’
PF8 NAMED ‘<YEAR’ PF10 NAMED ‘>YEAR’
- FIRST, ESTABLISH STARTING YEAR AND MONTH
- EITHER USE #YYP AND #MMP FROM THE “CALLER”
- OR USE THE CURRENT YEAR AND MONTH FOR MISSING DATA
IF #YYP = 0
MOVE EDITED *DATX (EM=YYYY) TO #YY
COMPUTE #YYP = VAL (#YY)
END-IF
*
IF #MMP = 0
MOVE EDITED *DATX (EM=MM) TO #MM
COMPUTE #MMP = VAL (#MM)
END-IF
*
- NOW FIGURE OUT WHAT THAT MONTH LOOKS LIKE
PERFORM MONTH-TO-SCREEN
*
DEFINE SUBROUTINE MONTH-TO-SCREEN
COMPRESS #MONTH-TEXT (#MMP) #YYP INTO #MONTH-YEAR-FOR-MAP
**
** NOW GET THE STARTING DAY OF WEEK FOR CURRENT YEAR - MONTH
MOVE #MMP TO SUBSTRING (#DATE-A,1,2)
MOVE ‘01’ TO SUBSTRING (#DATE-A,3,2)
MOVE #YYP TO SUBSTRING (#DATE-A,5,4)
MOVE EDITED #DATE-A TO #DATE (EM=MMDDYYYY)
MOVE EDITED #DATE (EM=O) TO #A
COMPUTE #START = VAL (#A) + 1
IF #START = 8
MOVE 1 TO #START
END-IF
COMPUTE #END = #DAYS-IN-MONTH (#MMP)
COMPUTE #END-MINUS-ONE = #END - 1
**
** FIX FOR LEAP YEAR FEBRUARY
*
REPEAT
IF #MMP NE 2
ESCAPE BOTTOM
END-IF
*
DIVIDE 400 INTO #YYP GIVING #DUMMY REMAINDER #REM
IF #REM = 0
ADD 1 TO #END
ADD 1 TO #END-MINUS-ONE
ESCAPE BOTTOM
END-IF
*
DIVIDE 100 INTO #YYP GIVING #DUMMY REMAINDER #REM
IF #REM = 0
ESCAPE BOTTOM
END-IF
*
DIVIDE 4 INTO #YYP GIVING #DUMMY REMAINDER #REM
IF #REM = 0
ADD 1 TO #END
ADD 1 TO #END-MINUS-ONE
ESCAPE BOTTOM
END-IF
*
ESCAPE BOTTOM
END-REPEAT
*
RESET #WEEK-STRING (*)
MOVE #MONTH-OF-DAYS (1:#END) TO
#WEEK-STRING (#START:#START+#END-MINUS-ONE)
ESCAPE ROUTINE
END-SUBROUTINE
- NOW DISPLAY THE STARTING MONTH
INPUT (IP=OFF AD=M ZP=OFF)
1/2 ‘SUN MON TUE WED THU FRI SAT’
2/2 #WEEK (1,)
3/2 #WEEK (2,)
4/2 #WEEK (3,)
5/2 #WEEK (4,)
6/2 #WEEK (5,)
7/2 #WEEK (6,)
8/2 #MONTH-YEAR-FOR-MAP (AD=O SG=OFF)
IF *PF-NAME = ‘>MON’
ADD 1 TO #MMP
IF #MMP GT 12
COMPUTE #MMP = 12
REINPUT ‘ERROR, MONTH IS DECEMBER CANNOT GO FORWARD’
END-IF
PERFORM MONTH-TO-SCREEN
REINPUT FULL ’ ’
END-IF
IF *PF-NAME = ‘<MON’
SUBTRACT 1 FROM #MMP
IF #MMP LT 1
COMPUTE #MMP = 1
REINPUT ‘ERROR, MONTH IS JANUARY CANNOT GO BACKWARD’
END-IF
PERFORM MONTH-TO-SCREEN
REINPUT FULL ’ ’
END-IF
IF *PF-NAME = ‘>YEAR’
ADD 1 TO #YYP
PERFORM MONTH-TO-SCREEN
REINPUT FULL ' '
END-IF
IF *PF-NAME = ‘<YEAR’
SUBTRACT 1 FROM #YYP
PERFORM MONTH-TO-SCREEN
REINPUT FULL ' '
END-IF
IF *PF-NAME = ‘PICK’ OR *PF-KEY = ‘ENTR’
COMPUTE #WEEK-LINE = *CURS-LINE - 1
COMPUTE #WEEK-DAY = ((*CURS-COL - 2) / 4 ) + 1
MOVE #WEEK (#WEEK-LINE,#WEEK-DAY) TO #DDP
IF #DDP = 0
REINPUT ‘YOU DID NOT SELECT A DAY’
END-IF
ESCAPE ROUTINE
END-IF
END
Questions or suggestions, please post, or e-mail me at steve@slr-assoc.com
steve
