| w w w . P r o v a t o S y s . c o m |
| M i c h a e l C a t a l a n i |
| 9 0 1 . 5 8 1 . 8 7 9 1 |
|
|
|
The following is a pop up calendar written in RPG/free. This Calendar has several neat features:
There are two versions of the calendar program. The first is a standalone program which can be called like a procedure.
ie: Calendar ( CalendarDate )
or Calendar( CalendarDate : LineNumber : PositionNumber );
The second is a true function in a service program, which can return the selected date in an evaluation statement.
ie: OrderDate = Calendar_PopUp ( %date : LineNumber : PositionNumber );
Below is a screen shot of the Popup Calendar. Notice that the current date of April, 9, 2009, is in reverse image. The date of April 23, 2009, was the date that was passed to the program, and is highlighted in white since the cursor was positioned to this field automatically. The "<<" and ">>" symbols on either side of the month and year can be clicked on with the mouse in order to scroll through the month or year. You can also use the rollup / rolldown keys to scroll thru the months. You can use the mouse to click on a day to select it, or use the tab key to position to a day and use the enter key to select a date.
Self Contained Popup Calendar Program
CalendarD Display File
A*%%TS SD 20090401 202532 QPGMR REL-V6R1M0 5761-WDS
A*%%EC
A DSPSIZ(24 80 *DS3 -
A 27 132 *DS4)
A CHGINPDFT
A INDARA
A ENTFLDATR
A* (*DSPATR RI))
A R POPUP
A*%%TS SD 20090401 202532 QPGMR REL-V6R1M0 5761-WDS
A CF03(03 'Exit')
A PAGEUP(90)
A PAGEDOWN(91)
A KEEP
A RTNCSRLOC(&CSRRCD &CSRFLD &CSRPOS)
A 20 DSPMOD(*DS4)
A UNLOCK
A OVERLAY
A *DS3 WINDOW(&WINDOWLINE &WINDOWPOS 9 22 -
A *NOMSGLIN)
A *DS4 WINDOW(&WINDOWLINE &WINDOWPOS 9 22 -
A *NOMSGLIN)
A WDWTITLE((*TEXT ' F3-Cancel ') *BOT-
A TOM)
A MOUBTN(*ULP ENTER)
A ATTR01 1A P
A ATTR02 1A P
A ATTR03 1A P
A ATTR04 1A P
A ATTR05 1A P
A ATTR06 1A P
A ATTR07 1A P
A ATTR08 1A P
A ATTR09 1A P
A ATTR10 1A P
A ATTR11 1A P
A ATTR12 1A P
A ATTR13 1A P
A ATTR14 1A P
A ATTR15 1A P
A ATTR16 1A P
A ATTR17 1A P
A ATTR18 1A P
A ATTR19 1A P
A ATTR20 1A P
A ATTR21 1A P
A ATTR22 1A P
A ATTR23 1A P
A ATTR24 1A P
A ATTR25 1A P
A ATTR26 1A P
A ATTR27 1A P
A ATTR28 1A P
A ATTR29 1A P
A ATTR30 1A P
A ATTR31 1A P
A ATTR32 1A P
A ATTR33 1A P
A ATTR34 1A P
A ATTR35 1A P
A ATTR36 1A P
A ATTR37 1A P
A ATTR38 1A P
A ATTR39 1A P
A ATTR40 1A P
A ATTR41 1A P
A ATTR42 1A P
A CSRRCD 10A H
A CSRFLD 10A H
A WINDOWLINE 2S 0P
A WINDOWPOS 3S 0P
A CSRPOS 4S 0H
A ROW 3S 0H
A COL 3S 0H
A YEARHDG 4S 0O 1 17DSPATR(HI)
A 3 2'Su'
A COLOR(BLU)
A DSPATR(UL)
A 3 5'Mo'
A COLOR(BLU)
A DSPATR(UL)
A 3 8'Tu'
A COLOR(BLU)
A DSPATR(UL)
A 3 11'We'
A COLOR(BLU)
A DSPATR(UL)
A 3 14'Th'
A COLOR(BLU)
A DSPATR(UL)
A 3 17'Fr'
A COLOR(BLU)
A DSPATR(UL)
A 3 20'Sa'
A COLOR(BLU)
A DSPATR(UL)
A CALBLOCK01 2A B 4 2DSPATR(&ATTR01)
A 31 DSPATR(PC)
A CALBLOCK02 2A B 4 5DSPATR(&ATTR02)
A 32 DSPATR(PC)
A CALBLOCK03 2A B 4 8DSPATR(&ATTR03)
A 33 DSPATR(PC)
A CALBLOCK04 2A B 4 11DSPATR(&ATTR04)
A 34 DSPATR(PC)
A CALBLOCK05 2A B 4 14DSPATR(&ATTR05)
A 35 DSPATR(PC)
A CALBLOCK06 2A B 4 17DSPATR(&ATTR06)
A 36 DSPATR(PC)
A CALBLOCK07 2A B 4 20DSPATR(&ATTR07)
A 37 DSPATR(PC)
A CALBLOCK08 2A B 5 2DSPATR(&ATTR08)
A 38 DSPATR(PC)
A CALBLOCK09 2A B 5 5DSPATR(&ATTR09)
A 39 DSPATR(PC)
A CALBLOCK10 2A B 5 8DSPATR(&ATTR10)
A 40 DSPATR(PC)
A CALBLOCK11 2A B 5 11DSPATR(&ATTR11)
A 41 DSPATR(PC)
A CALBLOCK12 2A B 5 14DSPATR(&ATTR12)
A 42 DSPATR(PC)
A CALBLOCK13 2A B 5 17DSPATR(&ATTR13)
A 43 DSPATR(PC)
A CALBLOCK14 2A B 5 20DSPATR(&ATTR14)
A 44 DSPATR(PC)
A CALBLOCK15 2A B 6 2DSPATR(&ATTR15)
A 45 DSPATR(PC)
A CALBLOCK16 2A B 6 5DSPATR(&ATTR16)
A 46 DSPATR(PC)
A CALBLOCK17 2A B 6 8DSPATR(&ATTR17)
A 47 DSPATR(PC)
A CALBLOCK18 2A B 6 11DSPATR(&ATTR18)
A 48 DSPATR(PC)
A CALBLOCK19 2A B 6 14DSPATR(&ATTR19)
A 49 DSPATR(PC)
A CALBLOCK20 2A B 6 17DSPATR(&ATTR20)
A 50 DSPATR(PC)
A CALBLOCK21 2A B 6 20DSPATR(&ATTR21)
A 51 DSPATR(PC)
A CALBLOCK22 2A B 7 2DSPATR(&ATTR22)
A 52 DSPATR(PC)
A CALBLOCK23 2A B 7 5DSPATR(&ATTR23)
A 53 DSPATR(PC)
A CALBLOCK24 2A B 7 8DSPATR(&ATTR24)
A 54 DSPATR(PC)
A CALBLOCK25 2A B 7 11DSPATR(&ATTR25)
A 55 DSPATR(PC)
A CALBLOCK26 2A B 7 14DSPATR(&ATTR26)
A 56 DSPATR(PC)
A CALBLOCK27 2A B 7 17DSPATR(&ATTR27)
A 57 DSPATR(PC)
A CALBLOCK28 2A B 7 20DSPATR(&ATTR28)
A 58 DSPATR(PC)
A CALBLOCK29 2A B 8 2DSPATR(&ATTR29)
A 59 DSPATR(PC)
A CALBLOCK30 2A B 8 5DSPATR(&ATTR30)
A 60 DSPATR(PC)
A CALBLOCK31 2A B 8 8DSPATR(&ATTR31)
A 61 DSPATR(PC)
A CALBLOCK32 2A B 8 11DSPATR(&ATTR32)
A 62 DSPATR(PC)
A CALBLOCK33 2A B 8 14DSPATR(&ATTR33)
A 63 DSPATR(PC)
A CALBLOCK34 2A B 8 17DSPATR(&ATTR34)
A 64 DSPATR(PC)
A CALBLOCK35 2A B 8 20DSPATR(&ATTR35)
A 65 DSPATR(PC)
A CALBLOCK36 2A B 9 2DSPATR(&ATTR36)
A 66 DSPATR(PC)
A CALBLOCK37 2A B 9 5DSPATR(&ATTR37)
A 67 DSPATR(PC)
A CALBLOCK38 2A B 9 8DSPATR(&ATTR38)
A 68 DSPATR(PC)
A CALBLOCK39 2A B 9 11DSPATR(&ATTR39)
A 69 DSPATR(PC)
A CALBLOCK40 2A B 9 14DSPATR(&ATTR40)
A 70 DSPATR(PC)
A CALBLOCK41 2A B 9 17DSPATR(&ATTR41)
A 71 DSPATR(PC)
A CALBLOCK42 2A B 9 20DSPATR(&ATTR42)
A 72 DSPATR(PC)
A PMONTH 1A O 1 1COLOR(WHT)
A NMONTH 1A O 1 13COLOR(WHT)
A MONTHHDG 9A O 1 3COLOR(WHT)
A PYEAR 1A O 1 15COLOR(WHT)
A NYEAR 1A O 1 22COLOR(WHT)
A R ASSUME
A KEEP
A ASSUME
A 1 3' '
Calendar RPG Source
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* C a l e n d a r - Popup Calendar With Selection
*
* @copyrite 1997, 2009 Michael Catalani
* ProvatoSys www.ProvatoSys.com
* mcatalani@aol.com
* 901.581.8791
*
* Display a popup calendar and allow date selection
*
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
h dftactgrp( *no ) bnddir( 'QSNAPI' )
fCalendard cf e workstn
f indds( Display )
f usropn
d EarliestDate s d Inz( d'1900-01-01' )
d BlockPointer s 2 0
d TodayPointer s 3 0
d Looper s 2 0
d DayOfMonth s 2 0
d SelectedDate s d
d InitialDate s d Inz( d'0001-01-01' )
d WorkingDate s d
d Mode s 1A
d errDS s 16A Inz( *AllX'00' )
d CellBlock s 2s 0 Dim( 42 )
d CursorLine s 10i 0
d CursorPos s 10i 0
* Array Of Month Names
d MonthNames ds
d 9 Inz( ' January ' )
d 9 Inz( 'February ' )
d 9 Inz( ' March ' )
d 9 Inz( ' April ' )
d 9 Inz( ' May ' )
d 9 Inz( ' June ' )
d 9 Inz( ' July ' )
d 9 Inz( ' August ' )
d 9 Inz( 'September' )
d 9 Inz( ' October ' )
d 9 Inz( 'November ' )
d 9 Inz( 'December ' )
d MonthName 9 Dim( 12 ) OverLay( MonthNames )
* Calendar Block Fields Display Attributes Array
d Attributes ds
d Attr01 1 Inz( NormalImage )
d Attr02 1 Inz( NormalImage )
d Attr03 1 Inz( NormalImage )
d Attr04 1 Inz( NormalImage )
d Attr05 1 Inz( NormalImage )
d Attr06 1 Inz( NormalImage )
d Attr07 1 Inz( NormalImage )
d Attr08 1 Inz( NormalImage )
d Attr09 1 Inz( NormalImage )
d Attr10 1 Inz( NormalImage )
d Attr11 1 Inz( NormalImage )
d Attr12 1 Inz( NormalImage )
d Attr13 1 Inz( NormalImage )
d Attr14 1 Inz( NormalImage )
d Attr15 1 Inz( NormalImage )
d Attr16 1 Inz( NormalImage )
d Attr17 1 Inz( NormalImage )
d Attr18 1 Inz( NormalImage )
d Attr19 1 Inz( NormalImage )
d Attr20 1 Inz( NormalImage )
d Attr21 1 Inz( NormalImage )
d Attr22 1 Inz( NormalImage )
d Attr23 1 Inz( NormalImage )
d Attr24 1 Inz( NormalImage )
d Attr25 1 Inz( NormalImage )
d Attr26 1 Inz( NormalImage )
d Attr27 1 Inz( NormalImage )
d Attr28 1 Inz( NormalImage )
d Attr29 1 Inz( NormalImage )
d Attr30 1 Inz( NormalImage )
d Attr31 1 Inz( NormalImage )
d Attr32 1 Inz( NormalImage )
d Attr33 1 Inz( NormalImage )
d Attr34 1 Inz( NormalImage )
d Attr35 1 Inz( NormalImage )
d Attr36 1 Inz( NormalImage )
d Attr37 1 Inz( NormalImage )
d Attr38 1 Inz( NormalImage )
d Attr39 1 Inz( NormalImage )
d Attr40 1 Inz( NormalImage )
d Attr41 1 Inz( NormalImage )
d Attr42 1 Inz( NormalImage )
d AttributeArray 1 Dim( 42 ) OverLay( Attributes )
* Calendar Block Day Numbers Array
d CalBlock ds
d CalBlock01 2
d CalBlock02 2
d CalBlock03 2
d CalBlock04 2
d CalBlock05 2
d CalBlock06 2
d CalBlock07 2
d CalBlock08 2
d CalBlock09 2
d CalBlock10 2
d CalBlock11 2
d CalBlock12 2
d CalBlock13 2
d CalBlock14 2
d CalBlock15 2
d CalBlock16 2
d CalBlock17 2
d CalBlock18 2
d CalBlock19 2
d CalBlock20 2
d CalBlock21 2
d CalBlock22 2
d CalBlock23 2
d CalBlock24 2
d CalBlock25 2
d CalBlock26 2
d CalBlock27 2
d CalBlock28 2
d CalBlock29 2
d CalBlock30 2
d CalBlock31 2
d CalBlock32 2
d CalBlock33 2
d CalBlock34 2
d CalBlock35 2
d CalBlock36 2
d CalBlock37 2
d CalBlock38 2
d CalBlock39 2
d CalBlock40 2
d CalBlock41 2
d CalBlock42 2
d CalendarBlock 2 Dim( 42 ) OverLay( CalBlock )
* Display File Indicators
d Display ds Qualified
d ExitKeyPressed...
d 3 3n
d PageUpPressed 90 90n
d PageDownPressed...
d 91 91n
d LargeScreen 20 20n
d PC01 31 31n
d PC02 32 32n
d PC03 33 33n
d PC04 34 34n
d PC05 35 35n
d PC06 36 36n
d PC07 37 37n
d PC08 38 38n
d PC09 39 39n
d PC10 40 40n
d PC11 41 41n
d PC12 42 42n
d PC13 43 43n
d PC14 44 44n
d PC15 45 45n
d PC16 46 46n
d PC17 47 47n
d PC18 48 48n
d PC19 49 49n
d PC20 50 50n
d PC21 51 51n
d PC22 52 52n
d PC23 53 53n
d PC24 54 54n
d PC25 55 55n
d PC26 56 56n
d PC27 57 57n
d PC28 58 58n
d PC29 59 59n
d PC30 60 60n
d PC31 61 61n
d PC32 62 62n
d PC33 63 63n
d PC34 64 64n
d PC35 65 65n
d PC36 66 66n
d PC37 67 67n
d PC38 68 68n
d PC39 69 69n
d PC40 70 70n
d PC41 71 71n
d PC42 72 72n
* Position Cursor Array
d PC ds Qualified
d PC01 1n
d PC02 1n
d PC03 1n
d PC04 1n
d PC05 1n
d PC06 1n
d PC07 1n
d PC08 1n
d PC09 1n
d PC10 1n
d PC11 1n
d PC12 1n
d PC13 1n
d PC14 1n
d PC15 1n
d PC16 1n
d PC17 1n
d PC18 1n
d PC19 1n
d PC20 1n
d PC21 1n
d PC22 1n
d PC23 1n
d PC24 1n
d PC25 1n
d PC26 1n
d PC27 1n
d PC28 1n
d PC29 1n
d PC30 1n
d PC31 1n
d PC32 1n
d PC33 1n
d PC34 1n
d PC35 1n
d PC36 1n
d PC37 1n
d PC38 1n
d PC39 1n
d PC40 1n
d PC41 1n
d PC42 1n
d PositionCursor 1n Dim( 42 ) OverLay( PC )
* Display Attribute Constants
d NormalImage c Const( x'20' )
d ReverseImage c Const( x'21' )
d ProtectField c Const( x'A0' )
d SetScreenSize pr
d SelectedDateVerification...
d pr
d FirstofTheMonth...
d pr d
d PassedDate d Const
d EndOfTheMonth...
d pr d
d PassedDate d Const
d Main pr ExtPgm( 'CALENDAR' )
d PassedDate d
d WindowLineNumber...
d 2p 0 Options( *NoPass ) Const
d WindowPositionNumber...
d 3p 0 Options( *NoPass ) Const
d Main pi
d PassedDate d
d WindowLineNumber...
d 2p 0 Options( *NoPass ) Const
d WindowPositionNumber...
d 3p 0 Options( *NoPass ) Const
d RetrieveDisplaySize...
d pr extProc( 'QsnRtvMod' )
d ScreenSize 1A
d llHandle 10I 0 Options( *Omit ) Const
d error 16A Options( *VarSize )
d RetrieveCursorPosition...
d Pr 10i 0 ExtProc( 'QsnGetCsrAdr' )
d Row 10i 0
d Col 10i 0
d LlvEnvHdl 10i 0 Const Options( *Omit )
d ApiError 1024a Options( *Omit: *VarSize )
/free
if %parms >= 2;
WindowLine = WindowLineNumber;
else;
WindowLine = 0;
endif;
if %parms >= 3;
WindowPos = WindowPositionNumber;
else;
WindowPos = 0;
endif;
SetScreenSize();
// Main Calendar Display Loop
dou Display.ExitKeyPressed;
clear Attributes;
clear CellBlock;
clear CalendarBlock;
if WorkingDate < EarliestDate;
WorkingDate = EarliestDate;
endif;
// Get The Calendar Block # For The 1st Day Of The Month
BlockPointer =%abs( %rem( %diff( %date( '1899-12-31' )
: FirstOfTheMonth( WorkingDate )
: *days )
:7 )) +1 ;
// Fill In The Calendar Block Array With The Day Numbers
for DayOfMonth = 1 to %subdt( EndOfTheMonth( WorkingDate ): *days );
CellBlock( BlockPointer ) = DayOfMonth ;
BlockPointer += 1;
endfor;
// Set The Calendar Month And Year Headings
MonthHdg = MonthName( %subdt( WorkingDate : *months ));
YearHdg = %subdt( WorkingDate : *years );
// Fill In The Calendar Blocks With The Day Numbers
For Looper = 1 to 42;
CalendarBlock( Looper ) = %editc( CellBlock( Looper ) : 'Z' );
endfor;
// Reverse Image Todays Date If It Is Displayed On This Calendar
if %subdt( WorkingDate : *years ) = %subdt( %date : *years ) AND
%subdt( WorkingDate : *months ) = %subdt( %date : *months );
TodayPointer = %lookup( %subdt( %date : *days ) : CellBlock );
AttributeArray( TodayPointer ) = ReverseImage;
endif;
// Position The Cursor To The Passed Date If It Is On This Calendar
if %subdt( WorkingDate : *years ) = %subdt( PassedDate : *years ) AND
%subdt( WorkingDate : *months ) = %subdt( PassedDate : *months );
TodayPointer = %lookup( %subdt( PassedDate : *days ) : CellBlock );
PC.PositionCursor( TodayPointer ) = *on;
endif;
// Field Protect Any Calendar Block Which Does Not Contain A Day
for Looper = 1 to 42;
if CalendarBlock( Looper ) = *blanks;
AttributeArray( Looper ) = ProtectField;
endif;
endfor;
eval-corr Display = PC;
exfmt popup;
reset PC;
Select;
when CsrFld = 'PMONTH' OR Display.PageUpPressed;
WorkingDate -= %months( 1 );
when CsrFld = 'NMONTH' OR Display.PageDownPressed;
WorkingDate += %months( 1 );
when CsrFld = 'PYEAR';
WorkingDate -= %years( 1 );
when CsrFld = 'NYEAR';
WorkingDate += %years( 1 );
other;
SelectedDateVerification();
if SelectedDate > InitialDate;
PassedDate = SelectedDate;
leave;
endif;
endsl;
enddo;
close CalendarD;
return;
/end-free
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* S e l e c t e d D a t e V e r i f i c a t i o n
*
* Returns the day of the selected Calendar Block
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
p SelectedDateVerification...
p b
d SelectedDateverification...
d pi
/free
Select;
when csrfld = 'CALBLOCK01' AND
Attr01 <> ProtectField AND
CalBlock01 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock01 ));
when csrfld = 'CALBLOCK02' AND
Attr02 <> ProtectField AND
CalBlock02 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock02 ));
when csrfld = 'CALBLOCK03' AND
Attr03 <> ProtectField AND
CalBlock03 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock03 ));
when csrfld = 'CALBLOCK04' AND
Attr04 <> ProtectField AND
CalBlock04 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock04 ));
when csrfld = 'CALBLOCK05' AND
Attr05 <> ProtectField AND
CalBlock05 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock05 ));
when csrfld = 'CALBLOCK06' AND
Attr06 <> ProtectField AND
CalBlock06 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock06 ));
when csrfld = 'CALBLOCK07' AND
Attr07 <> ProtectField AND
CalBlock07 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock07 ));
when csrfld = 'CALBLOCK08' AND
Attr08 <> ProtectField AND
CalBlock08 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock08 ));
when csrfld = 'CALBLOCK09' AND
Attr09 <> ProtectField AND
CalBlock09 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock09 ));
when csrfld = 'CALBLOCK10' AND
Attr10 <> ProtectField AND
CalBlock10 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock10 ));
when csrfld = 'CALBLOCK11' AND
Attr11 <> ProtectField AND
CalBlock11 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock11 ));
when csrfld = 'CALBLOCK12' AND
Attr12 <> ProtectField AND
CalBlock12 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock12 ));
when csrfld = 'CALBLOCK13' AND
Attr13 <> ProtectField AND
CalBlock13 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock13 ));
when csrfld = 'CALBLOCK14' AND
Attr14 <> ProtectField AND
CalBlock14 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock14 ));
when csrfld = 'CALBLOCK15' AND
Attr15 <> ProtectField AND
CalBlock15 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock15 ));
when csrfld = 'CALBLOCK16' AND
Attr16 <> ProtectField AND
CalBlock16 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock16 ));
when csrfld = 'CALBLOCK17' AND
Attr17 <> ProtectField AND
CalBlock17 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock17 ));
when csrfld = 'CALBLOCK18' AND
Attr18 <> ProtectField AND
CalBlock18 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock18 ));
when csrfld = 'CALBLOCK19' AND
Attr19 <> ProtectField AND
CalBlock19 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock19 ));
when csrfld = 'CALBLOCK20' AND
Attr20 <> ProtectField AND
CalBlock20 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock20 ));
when csrfld = 'CALBLOCK21' AND
Attr21 <> ProtectField AND
CalBlock21 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock21 ));
when csrfld = 'CALBLOCK22' AND
Attr22 <> ProtectField AND
CalBlock22 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock22 ));
when csrfld = 'CALBLOCK23' AND
Attr23 <> ProtectField AND
CalBlock23 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock23 ));
when csrfld = 'CALBLOCK24' AND
Attr24 <> ProtectField AND
CalBlock24 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock24 ));
when csrfld = 'CALBLOCK25' AND
Attr25 <> ProtectField AND
CalBlock25 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock25 ));
when csrfld = 'CALBLOCK26' AND
Attr26 <> ProtectField AND
CalBlock26 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock26 ));
when csrfld = 'CALBLOCK27' AND
Attr27 <> ProtectField AND
CalBlock27 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock27 ));
when csrfld = 'CALBLOCK28' AND
Attr28 <> ProtectField AND
CalBlock28 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock28 ));
when csrfld = 'CALBLOCK29' AND
Attr29 <> ProtectField AND
CalBlock29 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock29 ));
when csrfld = 'CALBLOCK30' AND
Attr30 <> ProtectField AND
CalBlock30 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock30 ));
when csrfld = 'CALBLOCK31' AND
Attr31 <> ProtectField AND
CalBlock31 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock31 ));
when csrfld = 'CALBLOCK32' AND
Attr32 <> ProtectField AND
CalBlock32 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock32 ));
when csrfld = 'CALBLOCK33' AND
Attr33 <> ProtectField AND
CalBlock33 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock33 ));
when csrfld = 'CALBLOCK34' AND
Attr34 <> ProtectField AND
CalBlock34 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock34 ));
when csrfld = 'CALBLOCK35' AND
Attr35 <> ProtectField AND
CalBlock35 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock35 ));
when csrfld = 'CALBLOCK36' AND
Attr36 <> ProtectField AND
CalBlock36 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock36 ));
when csrfld = 'CALBLOCK37' AND
Attr37 <> ProtectField AND
CalBlock37 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock37 ));
when csrfld = 'CALBLOCK38' AND
Attr38 <> ProtectField AND
CalBlock38 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock38 ));
when csrfld = 'CALBLOCK39' AND
Attr39 <> ProtectField AND
CalBlock39 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock39 ));
when csrfld = 'CALBLOCK40' AND
Attr40 <> ProtectField AND
CalBlock40 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock40 ));
when csrfld = 'CALBLOCK41' AND
Attr41 <> ProtectField AND
CalBlock41 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock41 ));
when csrfld = 'CALBLOCK42' AND
Attr42 <> ProtectField AND
CalBlock42 <> *blanks;
SelectedDate = WorkingDate -
%days( %subdt( WorkingDate : *days )) +
%days( %int( CalBlock42 ));
endsl;
/end-free
p e
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* S e t S c r e e n S i z e
*
* Sets the Screen sie of the Calendar popup window to the current
* Screen Size Mode
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
p SetScreenSize...
p b
d SetScreenSize...
d pi
/free
if WindowLine = 0 AND WindowPos = 0;
RetrieveCursorPosition( CursorLine : CursorPos : *omit : *omit );
WindowLine = CursorLine;
WindowPos = CursorPos;
endif;
if WindowLine = 0;
WindowLine = 1;
endif;
if WindowPos = 0;
WindowPos = 1;
endif;
if WindowLine = 1 AND WindowPos = 1;
WindowPos = 2;
endif;
if WindowLine > 14;
WindowLine = 14;
endif;
RetrieveDisplaySize( mode : *omit : errds );
if Mode = '4';
Display.LargeScreen = *on;
if WindowPos > 90;
WindowPos = 90;
endif;
else;
Display.LargeScreen = *off;
if WindowPos > 54;
WindowPos = 54;
endif;
endif;
open CalendarD;
SelectedDate = PassedDate;
pMonth = '«';
nMonth = '»';
pYear = '«';
nYear = '»';
WorkingDate = PassedDate;
/end-free
p e
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* F i r s t O f T h e M o n t h
*
* Returns the 1st day of the month in date format for a given date
* ie PassedDate = 2008-06-10
* Returns 2008-06-01
*
*
* Input Field - Input Date ( Date Field )
* Returns - 1st Date For The Month of the passed Date
* ( Date Field )
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
p FirstOfTheMonth...
p b export
d FirstOfTheMonth...
d pi d
d PassedDate d Const
d FirstOfMonthDate...
d s d
/free
FirstOfMonthDate = PassedDate -
%days( %subdt( PassedDate : *d )) +
%days( 1 );
return ( FirstOfMonthDate );
/end-free
p e
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* E n d O f T h e M o n t h
*
* Returns the last day of the month in date format for a given date
* ie PassedDate = 2008-06-10
* Returns 2008-06-01
*
*
* Input Field - Input Date ( Date Field )
* Returns - 1st Date For The Month of the passed Date
* ( Date Field )
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
p EndOfTheMonth...
p b
d EndOfTheMonth...
d pi d
d PassedDate d Const
d EndOfMonthDate...
d s d
/free
EndOfMonthDate = FirstOfTheMonth( PassedDate ) +
%months(1) -
%days(1);
return ( EndOfMonthDate );
/end-free
p e
Popup Calendar Function Service Program
The code for the popup calendar function will be added shortly. Please note that this function will use the Date_s service program, so you should go ahead and download the code and create this service program from here in preparation for this code.