RPGLE - CALENDAR
**********************************************************************
* *
‚* Program Name : CALENDAR *
‚* Function : To Select date. *
* *
**********************************************************************
* šLogic :€It Uses output fields to display the date. *
* 1. Current date is obtained from system *
* 2. For the current month, the first day of *
* of the month and no. of days in the month *
* is calculated. *
* 3. Using this the datastructure is populated *
* then this value is copied to the display *
* fields. *
**********************************************************************
‚* Header Specifications
‚* =====================
*
H DFTACTGRP(*NO)
‚* Files Used
‚* ==========
*
š* Display file - Calendar
FCALENDARFMCF E WORKSTN
‚* Procedures Used
‚* ===============
*
š* To get the day of the week
D GetDay PR 1 0
D Date D Value
*
š* To get No of days in a month
D GetDate PR 2 0
D Date D Value
*
š* This will return the month(Text) for the numeric passed.
D GetMonth PR 9
D Month 2 0 Value
‚* Data Structures Used
‚* ====================
*
š* This DS is for Finding first day of the month.
D Date_DS_1 DS
D DS_1_Date D DATFMT(*USA) INZ
D DS_1_MM 2S 0 OVERLAY(DS_1_Date:1)
D DS_1_DD 2S 0 OVERLAY(DS_1_Date:4) inz(1)
D DS_1_YYYY 4S 0 OVERLAY(DS_1_Date:7)
*
š* This DS will hold current date values.
D Date_DS_2 DS
D DS_2_Date D DATFMT(*USA) INZ
D DS_2_MM 2S 0 OVERLAY(DS_2_Date:1) inz(5)
D DS_2_DD 2S 0 OVERLAY(DS_2_Date:4) inz(31)
D DS_2_YYYY 4S 0 OVERLAY(DS_2_Date:7) inz(2003)
‚* Variables Used
‚* ==============
*
D FirstDay S 1 0
D CurrDay S 1 0
D MaxDate S 2 0
D LiveMonth S 2 0
D LiveDate S 2 0
D LiveYear S 4 0
*
D Dates S 2 DIM(37)
D Count S 2 0
D Temp S 2 0
D I S 2 0
D Selected S N Inz(*Off)
D Res S 1
**********************************************************************
‚* M A I N L I N E P R O C E S S I N G *
**********************************************************************
˜* Exfmt the Calendar display till F3 or a date is Selected
C DoW Selected = *Off And *IN03 = *Off
˜* This calculates the date as per the (M+ or M-) and (Y+ or Y-)
˜* Triggered by the user and restores the display.
C Select
C When OptYearM = 1
C Eval DS_2_Date = DS_2_Date - %Years(1)
C MoveA '0010' *In(41)
C When OptMonthM = 1
C Eval DS_2_Date = DS_2_Date - %Months(1)
C MoveA '1000' *In(41)
C When OptMonthP = 1
C Eval DS_2_Date = DS_2_Date + %Months(1)
C MoveA '0100' *In(41)
C When OptYearP = 1
C Eval DS_2_Date = DS_2_Date + %Years(1)
C MoveA '0001' *In(41)
C EndSl
˜* Assigns the current values to the Datastructure one
˜* so that the maximum no of days and first day of the month
˜* is calculated.
C Eval Count = 0
C Eval DS_1_MM = DS_2_MM
C Eval DS_1_YYYY = DS_2_YYYY
˜* This gets the first day of the month
C Eval FirstDay = GetDay(DS_1_Date)
˜* This gets the Current day (Today)
C Eval CurrDay = GetDay(DS_2_Date)
˜* This gets the no of days in the month
C Eval MaxDate = GetDate(DS_1_Date)
˜* This gets the month(Text) of the month so that it can
˜* be displayed on the DSPF
C Eval Month = getMonth(DS_2_MM)
C Move DS_2_YYYY Year
˜* This Subroutine populates the Datastructure for the Current
˜* Selection(Month and Year)
C ExSr InitDates
˜* This Turns the required indicators for display
C ExSr SetIndicators
˜* This assigns the values from the datastructure to the DSPF fields
C ExSr SetValues
˜* Displays the Calendar for the Current month and Year Selection
C ExFmt CALENDAR
˜* If user strikes Enter key apart from F3 then we have to see
˜* whether user has chosed any date.
C If *In03 = *Off
C ExSr CheckSel
C EndIf
C EndDo
C If Selected = *On
C Move Dates(I) DS_2_DD
C DS_2_Date Dsply Res
C EndIf
C Eval *inlr = *on
**********************************************************************
‚* *INZSR ==> Initialize Sub-Routine *
**********************************************************************
C *INZSR BegSr
˜* Current date is retrieved for initial display
C Eval DS_2_Date = %Date()
C Eval LiveMonth = DS_2_MM
C Eval LiveYear = DS_2_YYYY
C Eval LiveDate = DS_2_DD
˜* This frames the string which is displayed at the bottom
C Eval OutPut = %Char(LiveDate) + ' ' +
C %Trim(getMonth(LiveMonth)) + ', ' +
C %Char(LiveYear)
C Eval *In41 = *On
C EndSr
**********************************************************************
‚* InitDates ==> Initialize the Datastructure *
‚* For Eg. consider the date September 2003 *
‚* 1. The month has got 30 days *
‚* 2. First day is Monday *
‚* Hence the DS is populated as follows: *
‚* --> DS(1) = *Blanks *
‚* --> DS(2) = '1' *
‚* --> DS(3) = '2' ..... *
‚* --> DS(32)= '30' *
‚* --> DS(33)= *Blanks ..... *
‚* --> DS(37)= *Blanks *
**********************************************************************
C InitDates BegSr
C Clear Dates
C Eval Temp = MaxDate + FirstDay
C For I = 1 to 37
C Select
C When I <= FirstDay Or I > Temp
C Eval Dates(I) = *BLANKS
C When I > FirstDay And I <= Temp
C Eval Count = Count + 1
C Move Count Dates(I)
C EndSl
C EndFor
C EndSr
**********************************************************************
‚* SetIndicators ==> Turn Reqd. Indicators for display *
**********************************************************************
C SetIndicators BegSr
C For I = 50 to 56
C Eval *In(I) = *Off
C EndFor
C For I = 60 to 96
C Eval *In(I) = *Off
C EndFor
C If LiveMonth = DS_2_MM And
C LiveYear = DS_2_YYYY
C Eval *In(50 + CurrDay) = *On
C Eval *In(60 + LiveDate + FirstDay - 1) = *On
C EndIf
C EndSr
**********************************************************************
‚* SetValues ==> Copies the DS to DSPF fields *
**********************************************************************
C SetValues BegSr
C Move Dates(1) SET1
C Move Dates(2) SET2
C Move Dates(3) SET3
C Move Dates(4) SET4
C Move Dates(5) SET5
C Move Dates(6) SET6
C Move Dates(7) SET7
C Move Dates(8) SET8
C Move Dates(9) SET9
C Move Dates(10) SET10
C Move Dates(11) SET11
C Move Dates(12) SET12
C Move Dates(13) SET13
C Move Dates(14) SET14
C Move Dates(15) SET15
C Move Dates(16) SET16
C Move Dates(17) SET17
C Move Dates(18) SET18
C Move Dates(19) SET19
C Move Dates(20) SET20
C Move Dates(21) SET21
C Move Dates(22) SET22
C Move Dates(23) SET23
C Move Dates(24) SET24
C Move Dates(25) SET25
C Move Dates(26) SET26
C Move Dates(27) SET27
C Move Dates(28) SET28
C Move Dates(29) SET29
C Move Dates(30) SET30
C Move Dates(31) SET31
C Move Dates(32) SET32
C Move Dates(33) SET33
C Move Dates(34) SET34
C Move Dates(35) SET35
C Move Dates(36) SET36
C Move Dates(37) SET37
C EndSr
**********************************************************************
‚* CheckSel ==> Checks whether user has msde any selection *
**********************************************************************
C CheckSel BegSr
C For I = 1 to 37
C If FLD = 'SET'+ %Char(I) and
C Dates(I) <> *Blanks
C Eval Selected = *ON
C Leave
C EndIf
C EndFor
C EndSr
**********************************************************************
‚* GetDay ==> This returns the day of the Date *
‚* The logic implemented is: *
‚* %Rem(((Date) - (Standard Date)) / 7) *
‚* The Standard date will be any Reference *
‚* Day. If the reminder is Zero then the *
‚* current day is standard day. If it is *
‚* '1' then its monday like so... *
**********************************************************************
P GetDay B
D GetDay PI 1 0
D Date D Value
D Days S 15P 0
D Day S 1 0
D Sunday C D'1999-12-19'
C Date SubDur Sunday Days:*DAYS
C Eval Day = %Rem(Days:7)
C If Day < 0
C Eval Day = Day + 7
C EndIf
C Return Day
P E
**********************************************************************
‚* GetDay ==> This returns the no of days in the month *
‚* The logic implemented is: *
‚* Difference between Current date and *
‚* (Current Date + One Month) in No of Days *
**********************************************************************
P GetDate B
D GetDate PI 2 0
D Date D Value
D Date1 S D
C Eval Date1 = Date + %Months(1)
C Return %Diff(Date1:Date:*D)
P E
**********************************************************************
‚* GetMonth ==> This returns the Month in Text for the *
‚* Numeric passed *
**********************************************************************
P GetMonth B
D GetMonth PI 9
D Month 2 0 VALUE
C Select
C When Month = 01
C Return 'January'
C When Month = 02
C Return 'February'
C When Month = 03
C Return 'March'
C When Month = 04
C Return 'April'
C When Month = 05
C Return 'May'
C When Month = 06
C Return 'June'
C When Month = 07
C Return 'July'
C When Month = 08
C Return 'August'
C When Month = 09
C Return 'September'
C When Month = 10
C Return 'October'
C When Month = 11
C Return 'November'
C When Month = 12
C Return 'December'
C Other
C Return ' '
C EndSl
P E
**======================================================
D D S
**======================================================
A*%%TS SD 20030717 173714 USC2643 REL-V5R1M0 5722-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A CF03(03 'EXIT')
A MOUBTN(*ULP ENTER)
A R CALENDAR
A*%%TS SD 20030717 173714 USC2643 REL-V5R1M0 5722-WDS
A WINDOW(7 25 14 35)
A RTNCSRLOC(&REC &FLD)
A FLD 10A H
A REC 10A H
A 1 14'Calendar'
A DSPATR(BL)
A DSPATR(HI)
A 2 2'Month. .:'
A COLOR(BLU)
A 3 2'Year. . :'
A COLOR(BLU)
A YEAR 4A O 3 12COLOR(TRQ)
A 5 2'SUN'
A N50 COLOR(YLW)
A 50 COLOR(WHT)
A 5 7'MON'
A N51 COLOR(BLU)
A 51 COLOR(WHT)
A 5 12'TUE'
A N52 COLOR(BLU)
A 52 COLOR(WHT)
A 5 17'WED'
A N53 COLOR(BLU)
A 53 COLOR(WHT)
A 5 22'THU'
A N54 COLOR(BLU)
A 54 COLOR(WHT)
A 5 27'FRI'
A N55 COLOR(BLU)
A 55 COLOR(WHT)
A 5 32'SAT'
A N56 COLOR(YLW)
A 56 COLOR(WHT)
A SET1 2A O 6 3
A N60 COLOR(YLW)
A 60 COLOR(WHT)
A SET2 2A O 6 8
A N61 COLOR(GRN)
A 61 COLOR(WHT)
A SET3 2A O 6 13
A N62 COLOR(GRN)
A 62 COLOR(WHT)
A SET4 2A O 6 18
A N63 COLOR(GRN)
A 63 COLOR(WHT)
A SET5 2A O 6 23
A N64 COLOR(GRN)
A 64 COLOR(WHT)
A SET6 2A O 6 28
A N65 COLOR(GRN)
A 65 COLOR(WHT)
A SET7 2A O 6 33
A N66 COLOR(YLW)
A 66 COLOR(WHT)
A SET8 2A O 7 3
A N67 COLOR(YLW)
A 67 COLOR(WHT)
A SET9 2A O 7 8
A N68 COLOR(GRN)
A 68 COLOR(WHT)
A SET15 2A O 8 3
A N74 COLOR(YLW)
A 74 COLOR(WHT)
A SET16 2A O 8 8
A N75 COLOR(GRN)
A 75 COLOR(WHT)
A SET22 2A O 9 3
A N81 COLOR(YLW)
A 81 COLOR(WHT)
A SET23 2A O 9 8
A N82 COLOR(GRN)
A 82 COLOR(WHT)
A SET29 2A O 10 3
A N88 COLOR(YLW)
A 88 COLOR(WHT)
A SET30 2A O 10 8
A N89 COLOR(GRN)
A 89 COLOR(WHT)
A SET36 2A O 11 3
A N95 COLOR(YLW)
A 95 COLOR(WHT)
A SET37 2A O 11 8
A N96 COLOR(GRN)
A 96 COLOR(WHT)
A SET10 2A O 7 13
A N69 COLOR(GRN)
A 69 COLOR(WHT)
A SET11 2A O 7 18
A N70 COLOR(GRN)
A 70 COLOR(WHT)
A SET12 2A O 7 23
A N71 COLOR(GRN)
A 71 COLOR(WHT)
A SET13 2A O 7 28
A N72 COLOR(GRN)
A 72 COLOR(WHT)
A SET14 2A O 7 33
A N73 COLOR(YLW)
A 73 COLOR(WHT)
A SET17 2A O 8 13
A N76 COLOR(GRN)
A 76 COLOR(WHT)
A SET18 2A O 8 18
A N77 COLOR(GRN)
A 77 COLOR(WHT)
A SET19 2A O 8 23
A N78 COLOR(GRN)
A 78 COLOR(WHT)
A SET20 2A O 8 28
A N79 COLOR(GRN)
A 79 COLOR(WHT)
A SET21 2A O 8 33
A N80 COLOR(YLW)
A 80 COLOR(WHT)
A SET24 2A O 9 13
A N83 COLOR(GRN)
A 83 COLOR(WHT)
A SET25 2A O 9 18
A N84 COLOR(GRN)
A 84 COLOR(WHT)
A SET26 2A O 9 23
A N85 COLOR(GRN)
A 85 COLOR(WHT)
A SET27 2A O 9 28
A N86 COLOR(GRN)
A 86 COLOR(WHT)
A SET28 2A O 9 33
A N87 COLOR(YLW)
A 87 COLOR(WHT)
A SET31 2A O 10 13
A N90 COLOR(GRN)
A 90 COLOR(WHT)
A SET32 2A O 10 18
A N91 COLOR(GRN)
A 91 COLOR(WHT)
A SET33 2A O 10 23
A N92 COLOR(GRN)
A 92 COLOR(WHT)
A SET34 2A O 10 28
A N93 COLOR(GRN)
A 93 COLOR(WHT)
A SET35 2A O 10 33
A N94 COLOR(YLW)
A 94 COLOR(WHT)
A OUTPUT 25A O 13 2COLOR(PNK)
A OPTMONTHM 2Y 0B 2 24PSHBTNFLD((*NUMCOL 2) (*GUTTER 2))
A 41 DSPATR(PC)
A PSHBTNCHC(1 '-')
A OPTMONTHP 2Y 0B 2 29PSHBTNFLD((*NUMCOL 2) (*GUTTER 2))
A 42 DSPATR(PC)
A PSHBTNCHC(1 '+')
A OPTYEARM 2Y 0B 3 24PSHBTNFLD((*NUMCOL 2) (*GUTTER 2))
A 43 DSPATR(PC)
A PSHBTNCHC(1 '-')
A OPTYEARP 2Y 0B 3 29PSHBTNFLD((*NUMCOL 2) (*GUTTER 2))
A 44 DSPATR(PC)
A PSHBTNCHC(1 '+')
A 4 1'__________________________________-
A _'
A COLOR(BLU)
A 12 1'__________________________________-
A _'
A COLOR(BLU)
A MONTH 9A O 2 12COLOR(TRQ)
A R DUMMY
A KEEP
A ASSUME
A 1 3' '
Thanks a lot for your work!
ReplyDeleteIt works like a charm. :-)
Greetings
Markus