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 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 C 25'FOUND' DSPLY C N25'NOT FOUND' DSPLY C EVAL *INLR =*ON Frequently Asked Questions in AS/400
33
25
Page 1
DATE VALIDATION DDATE1 DDATE2 DTIME DRES C* C*
S S S S EVAL EVAL
D INZ(D'2001-11-20') D INZ(D'2001-10-15') T INZ(T'12.30.54') 15P 0 RES = %DIFF(DATE1:DATE2:*D) RES = DATE1+%DAYS(15)
DATAAREA DATASTRUCTURE DIDS S 5P 0 INZ C *DTAARA DEFINE ID C *LOCK IN IDS C EVAL IDS = IDS + 1 C OUT IDS C IDS DSPLY C EVAL *INLR = *ON
IDS
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 C C
ENDDO DSPLY COUNT EVAL *INLR = *ON
RENAME FSTKM1P FSTKT1P
IF E IF E
DISK DISK
ADD C Z-ADD 0 C Z-ADD 0 C Z-ADD 0 C EVAL B = (20) C EVAL C = (20) C EVAL A = (B + C 'RESULT' DSPLY C SETON
RENAME(STKREC:STKR)
B C A
20 20 62
C) / 4 A LR
SUBTRACT DNUM C NUM C C NUM C
S 3P 0 INZ DSPLY Z-SUB 1 NUM DSPLY 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 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
515255
Page 4
C C
55'
ON'
DSPLY 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 FQPRINT DPTIME C C C C C C C C C C C OQPRINT O O O O E O O O O O* O O E O O O O O O O
IF E K DISK O F 80 PRINTER OFLIND(*IN50) S 6 0 TIME PTIME EXCEPT HEADER READ STKM1P 34 DOW NOT %EOF IF *IN50 EXCEPT HEADER ENDIF EXCEPT DETAILS READ STKM1P ENDDO EVAL *INLR = *ON E HEADER 1 3 55 'INVENTORY MANAGEMENT' UDATE Y 70 PTIME 75 ' : : ' HEADER 2 13 'STOCK NUMBER' 32 'STOCK DESCRIPTION' 49 'DATE OF CREATION' 58 'QUANTITY' 36 'TOTAL VALUE' 65 'STATUS' DETAILS 1 STKNO 12 STKDES 33 SCRTDT 43 QUANT J 57 STKSTS 62
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 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
60
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