Le-pgm

  • November 2019
  • PDF

This document was uploaded by user and they confirmed that they have the permission to share it. If you are author or own the copyright of this book, please report to us by using this DMCA report form. Report DMCA


Overview

Download & View Le-pgm as PDF for free.

More details

  • Words: 1,541
  • Pages: 8
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