× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



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...
   






As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.