Pop-Up Calendar with RPG

GHENDER
220 pts.
Tags:
AS/400 development
RPG
RPG III
RPG ILE
RPG IV
Shared calendars
I found a link that would show me how to code a pop-up calendar on the AS400. However, when I went to that link, it was invalid. Does anyone know how to create RPG code for a pop-up calendar on the AS400?
Asked: Last updated:
Related Questions

Answer Wiki

Thanks. We'll let you know when a new response is added.

Try this

<b>RPGLE test program</b>
<pre>
h option(*nodebugio:*srcstmt) dftactgrp(*no) actgrp(*caller) indent(‘|’)
h bnddir(‘CALENDAR’)

d popupCalendar pr d

d testDate s d

/free
testDate = popupCalendar();
dump(a);
*inlr = *on;
/end-free
</pre>

<b>DDS for DSPF</b>
<pre>
A DSPSIZ(24 80 *DS3)
A R RCALNDR
A CA03(98 ‘CANCEL’)
A CA12(98 ‘CANCEL’)
A CA05(99 ‘TODAY’)
A RTNCSRLOC(*RECNAME &RECORD &FIELD)
A WINDOW(*DFT 9 20 *NOMSGLIN)
A HEADING 16A O 1 3DSPATR(HI)
A DSPATR(UL)
A COLOR(TRQ)
A 2 1’Su’
A COLOR(BLU)
A DSPATR(UL)
A 2 4’Mo’
A COLOR(BLU)
A DSPATR(UL)
A 2 7’Tu’
A COLOR(BLU)
A DSPATR(UL)
A 2 10’We’
A COLOR(BLU)
A DSPATR(UL)
A 2 13’Th’
A COLOR(BLU)
A DSPATR(UL)
A 2 16’Fr’
A COLOR(BLU)
A DSPATR(UL)
A 2 19’Sa’
A COLOR(BLU)
A DSPATR(UL)
A D01 2Y 0O 3 1EDTCDE(Z)
A 01 DSPATR(RI)
A 51 COLOR(TRQ)
A N51 COLOR(BLU)
A D02 2Y 0O 3 4EDTCDE(Z)
A 02 DSPATR(RI)
A 52 COLOR(TRQ)
A N52 COLOR(BLU)
A D03 2Y 0O 3 7EDTCDE(Z)
A 03 DSPATR(RI)
A 53 COLOR(TRQ)
A N53 COLOR(BLU)
A D04 2Y 0O 3 10EDTCDE(Z)
A 04 DSPATR(RI)
A 54 COLOR(TRQ)
A N54 COLOR(BLU)
A D05 2Y 0O 3 13EDTCDE(Z)
A 05 DSPATR(RI)
A 55 COLOR(TRQ)
A N55 COLOR(BLU)
A D06 2Y 0O 3 16EDTCDE(Z)
A 06 DSPATR(RI)
A 56 COLOR(TRQ)
A N56 COLOR(BLU)
A D07 2Y 0O 3 19EDTCDE(Z)
A 07 DSPATR(RI)
A 57 COLOR(TRQ)
A N57 COLOR(BLU)
A D08 2Y 0O 4 1EDTCDE(Z)
A 08 DSPATR(RI)
A 58 COLOR(TRQ)
A N58 COLOR(BLU)
A D09 2Y 0O 4 4EDTCDE(Z)
A 09 DSPATR(RI)
A 59 COLOR(TRQ)
A N59 COLOR(BLU)
A D10 2Y 0O 4 7EDTCDE(Z)
A 10 DSPATR(RI)
A 60 COLOR(TRQ)
A N60 COLOR(BLU)
A D11 2Y 0O 4 10EDTCDE(Z)
A 11 DSPATR(RI)
A 61 COLOR(TRQ)
A N61 COLOR(BLU)
A D12 2Y 0O 4 13EDTCDE(Z)
A 12 DSPATR(RI)
A 62 COLOR(TRQ)
A N62 COLOR(BLU)
A D13 2Y 0O 4 16EDTCDE(Z)
A 13 DSPATR(RI)
A 63 COLOR(TRQ)
A N63 COLOR(BLU)
A D14 2Y 0O 4 19EDTCDE(Z)
A 14 DSPATR(RI)
A 64 COLOR(TRQ)
A N64 COLOR(BLU)
A D15 2Y 0O 5 1EDTCDE(Z)
A 15 DSPATR(RI)
A 65 COLOR(TRQ)
A N65 COLOR(BLU)
A D16 2Y 0O 5 4EDTCDE(Z)
A 16 DSPATR(RI)
A 66 COLOR(TRQ)
A N66 COLOR(BLU)
A D17 2Y 0O 5 7EDTCDE(Z)
A 17 DSPATR(RI)
A 67 COLOR(TRQ)
A N67 COLOR(BLU)
A D18 2Y 0O 5 10EDTCDE(Z)
A 18 DSPATR(RI)
A 68 COLOR(TRQ)
A N68 COLOR(BLU)
A D19 2Y 0O 5 13EDTCDE(Z)
A 19 DSPATR(RI)
A 69 COLOR(TRQ)
A N69 COLOR(BLU)
A D20 2Y 0O 5 16EDTCDE(Z)
A 20 DSPATR(RI)
A 70 COLOR(TRQ)
A N70 COLOR(BLU)
A D21 2Y 0O 5 19EDTCDE(Z)
A 21 DSPATR(RI)
A 71 COLOR(TRQ)
A N71 COLOR(BLU)
A D22 2Y 0O 6 1EDTCDE(Z)
A 22 DSPATR(RI)
A 72 COLOR(TRQ)
A N72 COLOR(BLU)
A D23 2Y 0O 6 4EDTCDE(Z)
A 23 DSPATR(RI)
A 73 COLOR(TRQ)
A N73 COLOR(BLU)
A D24 2Y 0O 6 7EDTCDE(Z)
A 24 DSPATR(RI)
A 74 COLOR(TRQ)
A N74 COLOR(BLU)
A D25 2Y 0O 6 10EDTCDE(Z)
A 25 DSPATR(RI)
A 75 COLOR(TRQ)
A N75 COLOR(BLU)
A D26 2Y 0O 6 13EDTCDE(Z)
A 26 DSPATR(RI)
A 76 COLOR(TRQ)
A N76 COLOR(BLU)
A D27 2Y 0O 6 16EDTCDE(Z)
A 27 DSPATR(RI)
A 77 COLOR(TRQ)
A N77 COLOR(BLU)
A D28 2Y 0O 6 19EDTCDE(Z)
A 28 DSPATR(RI)
A 78 COLOR(TRQ)
A N78 COLOR(BLU)
A D29 2Y 0O 7 1EDTCDE(Z)
A 29 DSPATR(RI)
A 79 COLOR(TRQ)
A N79 COLOR(BLU)
A D30 2Y 0O 7 4EDTCDE(Z)
A 30 DSPATR(RI)
A 80 COLOR(TRQ)
A N80 COLOR(BLU)
A D31 2Y 0O 7 7EDTCDE(Z)
A 31 DSPATR(RI)
A 81 COLOR(TRQ)
A N81 COLOR(BLU)
A D32 2Y 0O 7 10EDTCDE(Z)
A 32 DSPATR(RI)
A 82 COLOR(TRQ)
A N82 COLOR(BLU)
A D33 2Y 0O 7 13EDTCDE(Z)
A 33 DSPATR(RI)
A 83 COLOR(TRQ)
A N83 COLOR(BLU)
A D34 2Y 0O 7 16EDTCDE(Z)
A 34 DSPATR(RI)
A 84 COLOR(TRQ)
A N84 COLOR(BLU)
A D35 2Y 0O 7 19EDTCDE(Z)
A 35 DSPATR(RI)
A 85 COLOR(TRQ)
A N85 COLOR(BLU)
A D36 2Y 0O 8 1EDTCDE(Z)
A 36 DSPATR(RI)
A 86 COLOR(TRQ)
A N86 COLOR(BLU)
A D37 2Y 0O 8 4EDTCDE(Z)
A 37 DSPATR(RI)
A 87 COLOR(TRQ)
A N87 COLOR(BLU)
A D38 2Y 0O 8 7EDTCDE(Z)
A 38 DSPATR(RI)
A 88 COLOR(TRQ)
A N88 COLOR(BLU)
A D39 2Y 0O 8 10EDTCDE(Z)
A 39 DSPATR(RI)
A 89 COLOR(TRQ)
A N89 COLOR(BLU)
A D40 2Y 0O 8 13EDTCDE(Z)
A 40 DSPATR(RI)
A 90 COLOR(TRQ)
A N90 COLOR(BLU)
A D41 2Y 0O 8 16EDTCDE(Z)
A 41 DSPATR(RI)
A 91 COLOR(TRQ)
A N91 COLOR(BLU)
A D42 2Y 0O 8 19EDTCDE(Z)
A 42 DSPATR(RI)
A 92 COLOR(TRQ)
A N92 COLOR(BLU)
A 9 1’Go to’
A COLOR(BLU)
A MONTH 2N 0B 9 7CHECK(RZ)
A RANGE(1 12)
A DSPATR(UL)
A COLOR(TRQ)
A YEAR 4N 0B 9 10CHECK(RZ)
A DSPATR(UL)
A RANGE(1 9999)
A COLOR(TRQ)
A 9 15’F5=Now’
A DSPATR(RI)
A COLOR(BLU)
A RECORD 10A H
A FIELD 10A H
A SAVEMONTH 2N 0H
A SAVEYEAR 4N 0H
A R DUMMY ASSUME
A 1 2′ ‘
</pre>

<b>RPGLE for Service Program</b>
<pre>
h nomain option(*nodebugio:*srcstmt) indent(‘|’)
fcalendar cf e workstn usropn

d popupCalendar pr d

d isHoliday pr n
d pDate d const

d getMonthNameLong…
d pr 9a
d pMonth 2p 0 const

d getMonthNameShort…
d pr 3a
d pMonth 2p 0 const

d getDayNameLong…
d pr 9a
d pDayOfWeek 1p 0 const

d getDayNameShort…
d pr 3a
d pDayOfWeek 1p 0 const

d getDayOfWeek pr 1p 0
d pDate d const

d dayDS ds
d d01
d d02
d d03
d d04
d d05
d d06
d d07
d d08
d d09
d d10
d d11
d d12
d d13
d d14
d d15
d d16
d d17
d d18
d d19
d d20
d d21
d d22
d d23
d d24
d d25
d d26
d d27
d d28
d d29
d d30
d d31
d d32
d d33
d d34
d d35
d d36
d d37
d d38
d d39
d d40
d d41
d d42
d dayArray 2s 0 dim(42) overlay(dayDS)

d testDateA ds
d testDate d inz
d testYear 4s 0 overlay(testDate:1)
d testMonth 2s 0 overlay(testDate:6)
d testDay 2s 0 overlay(testDate:9)

d ds
d returnDate d
d year 4s 0 overlay(returnDate:1)
d month 2s 0 overlay(returnDate:6)
d day 2s 0 overlay(returnDate:9)

d ds
d field
d fieldType 1a overlay(field)
d fieldValue 2s 0 overlay(field:*next)

d offset s 5i 0
d idx s 5i 0

p popupCalendar b export
d popupCalendar pi d
c open calendar
c eval returnDate = %date()

c dou saveMonth = month and saveYear = year
c and not *in99
c eval *in(*) = ‘0’
c eval heading = %trim(getMonthNameLong(month))
c + ‘ ‘ + %editc(year:’X’)
c eval offset = (%len(heading) –
c %len(%trim(heading)))/2
c for idx = 1 to offset by 1
c eval heading = ‘ ‘ + heading
c endfor

c eval testMonth = month
c eval testYear = year
c eval testDay = 1
c eval idx = getDayOfWeek(testDate)
c eval dayArray = 0

c dou %error
c eval dayArray(idx) = testDay
c eval *in(idx) = (testDate = %date())
c eval *in(idx + 50) = isHoliday(testDate)
c eval idx += 1
c eval testDay += 1
c test(de) testDateA
c enddo

c eval saveMonth = month
c eval saveYear = year
c exfmt rcalndr
c if *in99
c close calendar
c return %date()
c endif
c enddo

c if fieldType = ‘D’
c eval day = dayArray(fieldValue)
c else
c eval day = 0
c endif
c if day = 0 or *in98
c clear returnDate
c endif
c close calendar
c return returnDate
p popupCalendar e

p isHoliday b export
d isHoliday pi n
d pDate d const
c if pDate = %date(‘2008-12-25’)
c return *on
c endif
c return *off
p isHoliday e

p getMonthNameLong…
p b export
d getMonthNameLong…
d pi 9a
d pMonth 2p 0 const
d months ds
d 9a inz(‘January’)
d 9a inz(‘February’)
d 9a inz(‘March’)
d 9a inz(‘April’)
d 9a inz(‘May’)
d 9a inz(‘June’)
d 9a inz(‘July’)
d 9a inz(‘August’)
d 9a inz(‘September’)
d 9a inz(‘October’)
d 9a inz(‘November’)
d 9a inz(‘December’)
d monthName 9a dim(12) overlay(months)
c return monthName(pMonth)
p getMonthNameLong…
p e

p getMonthNameShort…
p b export
d getMonthNameShort…
d pi 3a
d pMonth 2p 0 const
d months ds
d 3a inz(‘Jan’)
d 3a inz(‘Feb’)
d 3a inz(‘Mar’)
d 3a inz(‘Apr’)
d 3a inz(‘May’)
d 3a inz(‘Jun’)
d 3a inz(‘Jul’)
d 3a inz(‘Aug’)
d 3a inz(‘Sep’)
d 3a inz(‘Oct’)
d 3a inz(‘Nov’)
d 3a inz(‘Dec’)
d monthName 3a dim(12) overlay(months)
c return monthName(pMonth)
p getMonthNameShort…
p e

p getDayNameLong…
p b export
d getDayNameLong…
d pi 9a
d pDayOfWeek 1p 0 const
d days ds
d 9a inz(‘Sunday’)
d 9a inz(‘Monday’)
d 9a inz(‘Tuesday’)
d 9a inz(‘Wednesday’)
d 9a inz(‘Thursday’)
d 9a inz(‘Friday’)
d 9a inz(‘Saturday’)
d dayName 9a dim(7) overlay(days)
c return dayName(pDayOfWeek)
p getDayNameLong…
p e

p getDayNameShort…
p b export
d getDayNameShort…
d pi 3a
d pDayOfWeek 1p 0 const
d days ds
d 3a inz(‘Sun’)
d 3a inz(‘Mon’)
d 3a inz(‘Tue’)
d 3a inz(‘Wed’)
d 3a inz(‘Thu’)
d 3a inz(‘Fri’)
d 3a inz(‘Sat’)
d dayName 3a dim(7) overlay(days)
c return dayName(pDayOfWeek)
p getDayNameShort…
p e

p getDayOfWeek b export
d getDayOfWeek pi 1p 0
d pDate d const
d dayOfWeek s 1p 0
c eval dayOfWeek = %rem(
c %diff(testDate:d’0001-01-01′:*days)
c :7) + 2
c if dayOfWeek = 8
c eval dayOfWeek = 1
c endif
c return dayOfWeek
p getDayOfWeek e
</pre>

Discuss This Question: 5  Replies

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.
  • BigKat
    BTW In the Service Program I listed entered above, the IsHoliday function was only stubbed in to test it for later work, so the only holiday it knew was a hardcoded 12/25/2008. You would want to set that up to have the holidays applicable to your company, perhaps pulling from a holiday file or generate them based on the 4th Thursday of November etc...
    9,110 pointsBadges:
    report
  • Cwc
    Regarding holidays, here is a great approach that I ran across, as I was looking for a low maintenance solution for knowing when it's a holiday without requiring someone to remember to maintain a file of holiday dates. I incorporated the logic into a service program, tweaked it and converted it to free format, and it works great. http://www.mcpressonline.com/tips-techniques/rpg/techtip-considerations-for-holiday-determination.html
    4,290 pointsBadges:
    report
  • Cwc
    What is with the links not appearing?? Here's a retry:
    4,290 pointsBadges:
    report
  • Cwc
    http://www.mcpressonline.com/tips-techniques/rpg/techtip-considerations-for-holiday-determination.html
    4,290 pointsBadges:
    report
  • Cwc
    Three strikes and I'm out: http://www.mcpressonline.com/tips-techniques/rpg/techtip-considerations-for-holiday-determination.html
    4,290 pointsBadges:
    report

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

Thanks! We'll email you when relevant content is added and updated.

Following

Share this item with your network: