Good News Everybody!
The new search engine is LIVE!
Please report any problems to david (at) midrange.com.
|
thanks jonathan.. this is really wonderful.the black virus has hit almost whole of our country,,i will surely get rid of it. thanks for your notification . i wasnt sure about this virus before.really sorry/ :)) thanks On Tue, 18 Apr 2006 Jonathan Mason wrote : >Hi Sunny > >I've moved this thread to the RPG400-L list as per David's request. > >First of all, and giving you the benefit of the doubt, you need to run a >virus check on your machine - I received six emails from your address all >infected with the W32.Blackmal.E virus which I wasn't too happy about. > >I missed the part in your original post about the RPG400 side of it and took >for granted it was RPG IV. The following subroutines will do what I think >you want in RPG400. > >Regards > >Jonathan > > E MTH 12 12 3 Month Text > E TXT 8 1 Input Text > ** > ** Constants for case translation... > ** > I 'abcdefghijklmnopqrst-C LO > I 'uvwxyz' > I 'ABCDEFGHIJKLMNOPQRST-C UP > I 'UVWXYZ' > ** > ** Work fields... > ** > I DS > I 1 40DDMM > I 1 20DD > I 3 40MM > ** > ** --------------------------------------------------------------- > ** This example uses two subroutines to convert the "screen" date > ** format to the file format and vice-versa. The screen date > ** format is a 6/- character field in the format "dd-mmm" or > ** "d-mmm" - a leading zero may or may not be specified. The file > ** date format is 4.0 packed in the form "ddmm"... > ** --------------------------------------------------------------- > ** > ** The case for the month doesn't matter... > ** > C MOVE '27-Oct' WK006A 6 > C EXSR SCRFIL > C Z-ADDWK004N EMPDAT 40 > ** > C WK006A DSPLY > C WK004N DSPLY > ** > ** Leading zeros can be excluded if necessary... > ** > C MOVE '2-feb ' WK006A > C EXSR SCRFIL > C Z-ADDWK004N EMPDAT > ** > C WK006A DSPLY > C WK004N DSPLY > ** > ** Now go the other way... > ** > C Z-ADD3112 WK004N > C EXSR FILSCR > ** > C WK004N DSPLY > C WK006A DSPLY > ** > ** Leading zeros can be excluded if necessary... > ** > C Z-ADD0202 WK004N > C EXSR FILSCR > ** > C WK004N DSPLY > C WK006A DSPLY > ** > ** End the program > ** > C MOVE *ON *INLR > C RETRN > ** =============================================================== > ** SCRFIL - Determine file date format > ** =============================================================== > C SCRFIL BEGSR > C* > C* Preserve the contents of any indicators used by this routine... > C* > C MOVE *IN99 @IN99 1 > C* > C* Ensure there's a '-' in the date and that there is at least one > C* character to the left of it. If there isn't then return with > C* WK004N set to -1 to indicate an error... > C* > C '-' SCAN WK006A IX 20 > C IX IFLT 2 > C Z-ADD-1 WK004N > C ELSE > C* > C* The three characters to the right of the '-' are the month... > C* > C MOVEAWK006A TXT,1 > C ADD 1 IX > C MOVEATXT,IX WK003A 3 > C* > C* Convert the month to upper case and then check it against the > C* MTH array to make sure it's valid... > C* > C LO:UP XLATEWK003A WK003B 3 > C Z-ADD1 IX > C WK003B LOKUPMTH,IX 99 > C *IN99 IFEQ *ON > C Z-ADDIX MM > C ELSE > C Z-ADD*ZEROS MM > C ENDIF > C* > C* Now pick up the day portion of the date... > C* > C* a) First ensure neither of the first two positions are blank... > C* > C TXT,1 IFEQ *BLANK > C MOVEA'0' TXT,1 > C ENDIF > C* > C TXT,2 IFEQ *BLANK > C MOVEA'0' TXT,1 > C ENDIF > C* > C* b) The '-' should be in position 2 or 3 of the field... > C* > C SELEC > C TXT,2 WHEQ '-' > C MOVE TXT,1 WK001N 10 > C Z-ADDWK001N DD > C TXT,3 WHEQ '-' > C MOVEATXT,1 WK002A 2 > C MOVE WK002A WK002N 20 > C Z-ADDWK002N DD > C OTHER > C Z-ADD*ZEROS DD > C ENDSL > C* > C Z-ADDDDMM WK004N 40 > C ENDIF > C* > C* Reset the contents of indicators used by this subroutine... > C* > C MOVE @IN99 *IN99 > C* > C ENDSR > ** =============================================================== > ** FILSCR - Determine screen date format > ** =============================================================== > C FILSCR BEGSR > C* > C* Reset the work fields... > C* > C MOVE *BLANKS WK006A 6 > C MOVEA*BLANKS TXT > C* > C* Split the input date into its DD and MM parts... > C* > C Z-ADDWK004N DDMM > C* > C* And then start piecing together the screen date... > C* > C MOVE DD WK002A > C MOVEAWK002A TXT,1 > C TXT,1 IFEQ '0' > C MOVE *BLANK TXT,1 > C ENDIF > C* > C MOVE '-' TXT,3 > C* > C MOVEAMTH,MM TXT,4 > C* > C* Next three lines convert the month into mixed case, eg. "Oct" > C* instead of "OCT"... > C* > C MOVE MTH,MM WK002A 2 > C UP:LO XLATEWK002A WK002B 2 > C MOVEAWK002B TXT,5 > C* > C MOVEATXT,1 WK006A > C* > C ENDSR >** >JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC > >-----Original Message----- > From: midrange-l-bounces@xxxxxxxxxxxx >[mailto:midrange-l-bounces@xxxxxxxxxxxx] On Behalf Of sunny singh >Sent: 16 April 2006 17:54 >To: Midrange Systems Technical Discussion >Subject: RE: prob - storing date in rpg /400 > >jonathan i am really sorry but i am learning rpg3 i couldnot understand >rpgle > upto the point,,,,,, > i havent started rpgle yet... > i need to do this in rpg -3 > and in case of updating a physical file user will enter the date in DD-MMM >format(e.g 2-jan ) > and it should be stored in database in case of updating in dd - mm format >which is packed decimal.....in rpg3 not in le.....please give me solution.. > thanks for ur help so far..(solution for displaying and updating a >physical file) in rpg -3 > thasnks a lot... > > > > > > >-- >This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list >To post a message email: RPG400-L@xxxxxxxxxxxx >To subscribe, unsubscribe, or change list options, >visit: http://lists.midrange.com/mailman/listinfo/rpg400-l >or email: RPG400-L-request@xxxxxxxxxxxx >Before posting, please take a moment to review the archives >at http://archive.midrange.com/rpg400-l. >
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2026 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
