RPGLE

COMPILE TIME ARRAY

DDAYS S 10A DIM(7)CTDATA PERRCD(1)

DSTRING S 10A
DX S 1P 0 INZ(1)
C DO 7
C MOVEA DAYS(X) STRING
C STRING DSPLY
C EVAL X = X+1
C ENDDO
C EVAL *INLR =*ON
**
MONDAY
TUESDAY
WEDNESDAY
THURSDAY
FRIDAY
SATURDAY
SUNDAY

PRE-RUNTIME ARRAY

FEMP1 IF E DISK
DEID S 5P 0 DIM(50)
DENAM S 10A DIM(50)
DESAL S 10P 0 DIM(50)
DEDES S 5A DIM(50)
DX S 3P 0 INZ(1)
DELE S 3P 0 INZ
DSIZ S 3P 0 INZ
DRES S 10P 2 INZ
DSTRING S 10 INZ
C DOU *IN33
C READ EMPREC 33
C EVAL EID(X) = EMPID
C EVAL ENAM(X) = EMPNAM
C EVAL ESAL(X) = EMPSAL
C EVAL EDES(X) = EMPDES
C EVAL X = X+1
C ENDDO
C X DSPLY
C XFOOT (H) ESAL RES
C 'SUM OF SAL' DSPLY RES
C EVAL ELE = %ELEM(EID)
C* EVAL LEN = %SIZE(ENAM)
C 'NO OF ELEM' DSPLY ELE
C* 'SIZE OF ARY' DSPLY LEN
C 'ENTER STRING'DSPLY STRING
C STRING LOOKUP ENAM 25
C 25'FOUND' DSPLY
C N25'NOT FOUND' DSPLY
C EVAL *INLR =*ON
Frequently Asked Questions in AS/400 Page
1
 DATE VALIDATION

DDATE1 S D INZ(D'2001-11-20')
DDATE2 S D INZ(D'2001-10-15')
DTIME S T INZ(T'12.30.54')
DRES S 15P 0
C* EVAL RES = %DIFF(DATE1:DATE2:*D)
C* EVAL RES = DATE1+%DAYS(15)

DATAAREA DATASTRUCTURE

DIDS S 5P 0 INZ
C *DTAARA DEFINE ID IDS
C *LOCK IN IDS
C EVAL IDS = IDS + 1
C OUT IDS
C IDS DSPLY
C EVAL *INLR = *ON

FILE

FEMP1 IF E DISK
DCOUNT S 5P 0
DSTRING S 20
C DO 15
C READ EMPREC
C CLEAR STRING
C MOVE EMPNAM STRING
C 'STRING IS: 'DSPLY STRING
C ADD 1 COUNT
C ENDDO
C DSPLY COUNT
C EVAL *INLR = *ON

FILE1

FEMP1 IF E DISK
DCOUNT S 5P 0
DID S 5
DSTRING S 20
DCATSTR S 20
C DOU *IN45 = *ON
C READ EMPREC 45
C CLEAR STRING
C MOVE EMPID ID
C MOVEL EMPNAM STRING
C 'EMP ID IS: 'DSPLY ID
C 'STRING IS: 'DSPLY STRING
C EVAL CATSTR = ID +' ' + STRING + '???'
C 'CAT STRING 'DSPLY CATSTR
C ADD 1 COUNT

Frequently Asked Questions in AS/400 Page

2
 C ENDDO
C DSPLY COUNT
C EVAL *INLR = *ON

RENAME

FSTKM1P IF E DISK RENAME(STKREC:STKR)

FSTKT1P IF E DISK

ADD
C Z-ADD 0 B 20
C Z-ADD 0 C 20
C Z-ADD 0 A 62
C EVAL B = (20)
C EVAL C = (20)
C EVAL A = (B + C) / 4
C 'RESULT' DSPLY A
C SETON LR

SUBTRACT

DNUM S 3P 0 INZ
C NUM DSPLY
C Z-SUB 1 NUM
C NUM DSPLY
C EVAL *INLR = *ON

SIZE

DVAR1 S 30A
DNUM S 2P 0
C 'ENTER' DSPLY VAR1
C EVAL NUM = %SIZE(VAR1)
C NUM DSPLY
C EVAL *INLR =*ON

DISPLAY
DSTKNO UDS
DFIRST 1 3A
DSECOND 4 10 0
DTHIRD 1 10A
C FIRST DSPLY
C SECOND DSPLY
C ADD 1 SECOND
C SECOND DSPLY
C THIRD DSPLY
C EVAL *INLR = *ON
C

Frequently Asked Questions in AS/400 Page

3
 DATAAREA
DIDS UDS 10 DTAARA(STKNO)
DFIRST 1 3A
DSECOND 4 10A
DNUM S 7P 0
C *LOCK IN IDS
C FIRST DSPLY
C SECOND DSPLY
C MOVE SECOND NUM
C NUM DSPLY
C ADD 1 NUM
C MOVE NUM SECOND
C EVAL IDS = FIRST + SECOND
C OUT IDS
C NUM DSPLY
C EVAL *INLR = *ON
C

SUBSTRING
C MOVE *BLANKS VAR1 10
C MOVE *BLANKS VAR2 10
C MOVE *BLANKS VAR3 20
C MOVE *BLANKS VAR4 20
C MOVE *BLANKS VAR5 10
C 'ENTERSTRING1'DSPLY VAR1
C 'ENTERSTRING2'DSPLY VAR2
C EVAL VAR3 = %SUBST(VAR1:1:3)
C EVAL VAR5 = %SUBST(VAR2:1:4)
C VAR1 CAT VAR2 VAR4
C Z-ADD 0 B 20
C Z-ADD 0 C 20
C Z-ADD(H) 0 A 10 4
C EVAL B = (20)
C EVAL C = (20)
C EVAL A = (B + C) / 4
C 'RESULT' DSPLY A
C 'RES STRING:' DSPLY VAR1
C 'RES STRING:' DSPLY VAR2
C 'SUBSTRING:' DSPLY VAR3
C 'CONCAT STR:' DSPLY VAR4
C EVAL *INLR = *ON

SETLL

FEMP2 IF E K DISK
FEMPLOYEE CF E WORKSTN
DID S 5P 0 INZ
C 'GET ID' DSPLY ID
C ID SETLL EMP2 515255
C N51'NOT ON' DSPLY
C N52'NOT ON' DSPLY
C N55'NOT ON' DSPLY
C 51' ON' DSPLY
C 52' ON' DSPLY

Frequently Asked Questions in AS/400 Page

4
 C 55' ON' DSPLY
C EVAL *INLR = *ON

REPORT

FSTKT1P IF E K DISK
FREP2 O E PRINTER OFLIND(*IN58)
C WRITE HEADER
C *LOVAL SETLL STKT1P
C DOW NOT %EOF
C READ STKT1P
C WRITE DETAILS
C IF *IN58 = *OFF
C WRITE HEADER
C EVAL *IN58 = *OFF
C ENDIF
C ENDDO
C EVAL *INLR = *ON

OSPEC
FSTKM1P IF E K DISK
FQPRINT O F 80 PRINTER OFLIND(*IN50)
DPTIME S 6 0
C TIME PTIME
C EXCEPT HEADER
C READ STKM1P 34
C DOW NOT %EOF
C IF *IN50
C EXCEPT HEADER
C ENDIF
C EXCEPT DETAILS
C READ STKM1P
C ENDDO
C EVAL *INLR = *ON
OQPRINT E HEADER 1 3
O 55 'INVENTORY MANAGEMENT'
O UDATE Y 70
O PTIME 75 ' : : '
O E HEADER 2
O 13 'STOCK NUMBER'
O 32 'STOCK DESCRIPTION'
O 49 'DATE OF CREATION'
O 58 'QUANTITY'
O* 36 'TOTAL VALUE'
O 65 'STATUS'
O E DETAILS 1
O STKNO 12
O STKDES 33
O SCRTDT 43
O QUANT J 57
O STKSTS 62
O
O

PASSWORD

Frequently Asked Questions in AS/400 Page

5
 H
FPPF IF E K DISK
FSTKM1D CF E WORKSTN
DUSRID S 10A INZ(*BLANKS)
DUSRPW1 S 10A DIM(1)
DUSRPW S 10A
DNUM S 2A INZ(*BLANKS)
C EXFMT PASS
C USRID CHAIN PPF 60
C EVAL USRPW1(1)= USRPW
C EVAL NUM = %LEN(USRPW1)
C N60'FOUND' DSPLY
C 60'N FOUND' DSPLY
C 'NUMVALUE' DSPLY NUM NUM
C EVAL *INLR = *ON

SIZE=PAGE

FEMP2 UF A E K DISK
FEMPLOYEE CF E WORKSTN
F SFILE(SFL1:RRN1)
DRRN1 S 4P 0 INZ(0)
DBOTID S 5P 0 INZ(0)
DTOPID S 5P 0 INZ(0)
DCOUNT S 4P 0 INZ(0)
DIDS S 5P 0 INZ
DOPT S 1 INZ
C *DTAARA DEFINE ID IDS
C EXSR CLRSR
C *LOVAL SETLL EMP2 50
C READ EMP2 31
C EVAL TOPID = EMPID
C EXSR LOADSR
C DOW *IN03 = *OFF
C WRITE FOOTER
C EXFMT SFL2
C EXSR RESPOND
C ENDDO
C EVAL *INLR = *ON
C*----------------- CLEAR -----------------------------------------
C CLRSR BEGSR
C EVAL RRN1 = 0
C EVAL *IN30 = *OFF
C WRITE SFL2
C ENDSR
C*---------------- LOAD --------------------------------------------
C LOADSR BEGSR
C DOW *IN31 = *OFF AND RRN1 < 8
C EVAL DID = EMPID
C EVAL DNAM = EMPNAM
C EVAL DADD = EMPADD
C EVAL DSAL = EMPSAL
C EVAL DDES = EMPDES
C EVAL DACT = 'OK'

Frequently Asked Questions in AS/400 Page

6
 C EVAL RRN1 = RRN1 +1
C WRITE SFL1
C EVAL BOTID =EMPID
C READ EMP2 31
C ENDDO
C IF RRN1 > 0
C EVAL *IN30 = *ON
C ELSE
C IF *IN50
C EVAL DID = *ZEROS
C EVAL DNAM = 'NO REC'
C EVAL DADD = 'NO REC'
C EVAL DSAL = *ZEROS
C EVAL DDES = *BLANKS
C EVAL RRN1 = RRN1 +1
C EVAL *IN30 = *ON
C ENDIF
C ENDIF
C ENDSR
C*----------------- RESPOND ----------------------------------------
C RESPOND BEGSR
C IF *IN26 = *ON
C BOTID SETGT EMP2
C READ EMP2 31
C IF *IN31 = *OFF
C EVAL TOPID = EMPID
C EXSR CLRSR
C EXSR LOADSR
C ENDIF
C ENDIF
C IF *IN25 = *ON
C EXSR MOVEPTR
C EXSR CLRSR
C EXSR LOADSR
C ENDIF
C*----------------- INSERT -----------------------------------------
C IF *IN06 = *ON
C *LOCK IN IDS
C EVAL IDS = IDS + 1
C EVAL DID = IDS
C EVAL DNAM = *BLANKS
C EVAL DADD = *BLANKS
C EVAL DSAL = *ZEROS
C EVAL DDES = *BLANKS
C EXFMT INSERT
C*
C IF *IN12= *OFF AND *IN03 = *OFF
C EVAL EMPID = DID
C EVAL EMPNAM = DNAM
C EVAL EMPADD = DADD
C EVAL EMPSAL = DSAL
C EVAL EMPDES = DDES
C WRITE EMPR
C OUT IDS
C ENDIF

Frequently Asked Questions in AS/400 Page

7
 C ENDIF
C*---------------- POSITION --------------------------------------
C POS SETLL EMP2 51
C IF *IN51 = *ON
C EXSR CLRSR
C READ EMP2 31
C EVAL TOPID = EMPID
C EXSR LOADSR
C ENDIF
C EVAL *IN51 = *OFF
C*----------------- DELETE ---------------------------------------
C READC SFL1 60
C IF *IN60 = *OFF
C IF OPT ='2'
C EMPID CHAIN EMP2
C EXSR CLRSR
C EXFMT DLT
C DELETE EMPR
C ENDIF
C EVAL *IN60 = *ON
C IF *IN31 = *ON
C *LOVAL SETLL EMP2
C READ EMP2 31
C ENDIF
C EVAL TOPID = EMPID
C EXSR LOADSR
C ENDIF
C ENDSR
C*----------------- POINTER ----------------------------------------
C MOVEPTR BEGSR
C EVAL COUNT = 8
C TOPID SETLL EMP2
C READP EMP2 31
C DOW *IN31= *OFF AND COUNT > 0
C EVAL COUNT = COUNT - 1
C READP EMP2 31
C ENDDO
C IF *IN31 = *ON
C *LOVAL SETLL EMP2
C READ EMP2 31
C ENDIF
C EVAL TOPID = EMPID
C ENDSR

Frequently Asked Questions in AS/400 Page

8