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



As far as I know you can't define a file within a procedure.  Files must
be global. 


Kurt Anderson
Application Developer
Highsmith Inc

-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of Stiju Easo
Sent: Monday, April 10, 2006 3:58 AM
To: RPG programming on the AS400 / iSeries
Subject: Help in coding Procedure

I am keeping my code below
  I am getting error when creating a procedure
  I think i have missed some thing durring declaration or calling.
  my code is working fine with out procedure

  Please correct me to solve this.

        *************** Beginning of data
*************************************
0001.00
*
0002.00  * Program to parse EUFINM  from DMSCR/SKUEUD  and generate
department 0003.00  *  code  and store it in EUDEPT 0004.00
*
0005.00
*
0006.00
*
0007.00 DParseDept
PR
0008.00 C                   CALLP
ParseDept
0009.00 C                   EVAL
*INLR=*ON
0010.00
*
0011.00 PParseDept
B
0012.00 DParseDept
PI
0013.00
*
0014.00  *  File
Declaration
0015.00 FSKUEUD    UF   E             DISK
RENAME(SKUEUD:SKUEUDREC)
0016.00  *  Declaration of local
varibles
0017.00 D@STRING          S
100A
0018.00 DIXARRY           S              3S 0
DIM(20)
0019.00 DPOSSIX           S              3S
0
0020.00 DPOS2             S              3S
0
0021.00 DPOS3             S              3S
0
0022.00 DRESULT           S
2A
0023.00 DRESULT1          S
1A
0024.00 DDEPT             S              2S
0
0025.00
*
0026.00
*
0027.00 C                   EVAL
@STRING='MY_FIRST_2_TEST_STRING'
0028.00  *     Read Record from
SKUEUD
0029.00 C                   READ
SKUEUDREC
0030.00 C                   DOW
%EOF(SKUEUD)
0031.00 C                   EVAL
@STRING=EUFINM
0032.00
*
0033.00  *    Scanning arrray to genetate Index of
'_'
0034.00
*
0035.00 C     '_'           SCAN      @STRING
IXARRY
0036.00
*
0037.00  *    Checking generated index to find last possition of
'_'
0038.00 C                   EVAL
POSSIX=1
0039.00 C     *ZERO         LOOKUP    IXARRY(POSSIX)
91
0040.00
*
0041.00
*
0042.00  *    Retriving possitions of last 3 occurences of
'_'
0043.00
*
0044.00 C                   IF
POSSIX>3
0045.00
*
0046.00  *   Initilizing the starting and ending points of the
string
0047.00
*
0048.00 C                   EVAL
POS2=IXARRY(POSSIX-2)
0049.00 C                   EVAL
POS3=IXARRY(POSSIX-3)
0050.00
*
0051.00  *   Extracting the Substring with Index
obtained
0052.00
*
0053.00 C                   EVAL
RESULT=%SUBST(@STRING:POS3+1:POS2-POS3-1)
0054.00
*
0055.00  *   Convert Retrived department string to
numeric
0056.00 C                   IF
%LEN(%TRIM(RESULT))=1
0057.00  *   If String extracted is of length
1
0058.00 C                   EVAL
RESULT1=%TRIM(RESULT)
0059.00 C                   MOVE      RESULT1
DEPT
0060.00C
0060.00 C
0061.00 C                   ELSE
0062.00  *   If String extracted is of length 2
0063.00 C                   MOVEL     RESULT        DEPT
0064.00 C                   ENDIF
0065.00  *
0066.00 C     DEPT          DSPLY
0067.00 C*                  ELSE
0068.00 C*
0069.00 C                   ENDIF
0070.00 C                   READ      SKUEUDREC
0071.00 C                   ENDDO
0072.00 PParseDept        E
--
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 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.