PARAMETER PASSING TECHNIQUE:-
C5 [
calling program && called program ]
(Calling
program)
0001.00 PGM
0002.00
/* CALLING PROGRAM */
0003.00 DCL VAR(&A) TYPE(*DEC) LEN(5)
VALUE(1000)
0004.00 DCL VAR(&B) TYPE(*DEC) LEN(5)
VALUE(3000)
0005.00 CALL PGM(PRA1/CLP2) PARM(&A &B)
0006.00 ENDPGM
(Called
Program)
0001.00 PGM PARM(&X &Z)
0002.00 /* CALLED PROGRAM */
0003.00
DCL VAR(&X) TYPE(*DEC)
LEN(5) /* try with this if any error occurs give len(15 5)
0004.00
DCL VAR(&Z) TYPE(*DEC) LEN(5)
0005.00
DCL VAR(&L) TYPE(*DEC)
LEN(6)
0006.00
DCL VAR(&D) TYPE(*CHAR)
LEN(10)
0007.00
CHGVAR VAR(&L) VALUE(&X + &Z)
0008.00
CHGVAR VAR(&D) VALUE(&L)
0009.00
SNDPGMMSG MSG(&D) TOPGMQ(*PRV CLP1)
0010.00 ENDPGM
1ST + 2ND
=PARAMETER PASSING
CLP0023
(Called
program)
0001.00 PGM PARM (&X)
0002.00 DCL VAR(&X) TYPE(*DEC) LEN(15 5)
0003.00 DCL VAR(&F) TYPE(*CHAR) LEN(10)
0004.00 CHGVAR VAR(&F)
VALUE(&X)
0005.00 SNDPGMMSG MSG(&F)
0006.00 ENDPGM
(Calling
Program)
1.00 PGM
2.00 CALL PGM (CLP/CLP4) PARM (123.456)
3.00 ENDPGM
CLP123
0001.00 PGM
0002.00 CALL PF100
0003.00 ENDPGM
DISPLAY FILES
addition
a : 3333-
b : 3333-
sum : 6666
program
enter number a : 99-
enter number b : 99-
main screen :
1 . factorial
2 . swapping
3 . sum
choice ch : 3-
enter any number : 99-
enter 2nd num for swapping b :
99-
result : 9999-
Note:- for display files
1) Strsda (start source design aid).
2) For decimals .
+3(x)
for input type.
+6(x)
for output type.
+9(x)
for both input &&
output type.
3) For
characters.
+I(x)
for input type.
+o(x)
for output type.
+b(x)
for both input && output type.
DATA
AREAS
1) Permanent Data area
2) Temporary Data area
Temporary data areas are
created by o/s & destroyed by o/s as soon as that job is completed.
Permanent data areas are of
3 types:-
1) Character data area
2) Decimal data area
3) Logical data area
Commands related to data
area
1) CRTDTAARA
2) DSPDTAARA
3) CHDDTAARA
4) RTVDTAARA RTNVAR(&VAR)
Examples
CRTDTAARA
<f4>
Data
area name: - pra
Library:
- Praveen
Type:
- *DEC
Length:
- 4
Decimal
positions: 0
Initial
value: 1234
CRTDTAARA
<f4>
Data
area name: - ramu
Library:
- Praveen
Type:
- *CHAR
Length:
- 10
Initial
value: - srsoft
CRTDTAARA
<f4>
Data
area name: - somu
Library:
- Praveen
Type:
- *LGL
Length:
- 1
Initial
value 0
DECIMAL DATA AREA
PGM
DCL
VAR (&A) TYPE (*DEC) LEN (4 0)
DCL
VAR (&B) TYPE (*CHAR) LEN (10)
RTVDTAARA DTAARA (PRAVEEN/PRA) RTNVAR (&A)
CHGVAR
VAR (&A) VALUE (&A+1)
CHGVAR
VAR (&B) VALUE (&A)
SNDPGMMSG
MSG (&B)
ENDPGM
CHARACTER DATA AREA
PGM
DCL
VAR (&A) TYPE (*CHAR) LEN (10)
CHGDTAARA
DTAARA (PRAVEEN/RAMU) VALUE (DOCTOR)
RTVDTAARA
DTAARA (PRAVEEN/RAMU) RTNVAR (&A)
SNDPGMMSG
MSG (&A)
ENDPGM
LOGICAL DATA AREA
PGM
DCL
VAR (&A) TYPE (*LGL) LEN (1)
DCL
VAR (&B) TYPE (*DEC) LEN (4 0)
DCL
VAR (&C) TYPE (*CHAR) LEN (10)
RTVDTAARA
DTAARA (PRAVEEN/SOMU) RTNVAR (&A)
IF
COND (&A = ‘1’) THEN (DO)
CHGVAR
VAR (&B) VALUE (1000)
ENDDO
ELSE
(DO)
CHGVAR
VAR (&B) VALUE (2000)
ENDDO
CHGVAR
VAR (&C) VALUE (&B)
SNDPGMMSG
MSG (&C)
ENDPGM
DATA QUEUE
Data queues
are permanent. It can store up to 1 to 64,512 bytes.
While creating
Data Queue, we cannot give initial value. I mean initialization of a variable
at the time of declaration is not available in Data Queue, where as it is
available in Data Areas.
Commands
related to Data Queues:-
CRTDTAQ
DLTDTAQ
CRTDTAQ <F4>
Data
Queue Name: - Sun
Library:
Praveen
Length:
- 300
Note:
- To send value to Data Queue, we invoke QSNDDTAQ program, & to receive
value from data Queue we invoke inbuilt program QRCVDTAQ.
SENDING PROGRAM
PGM
DCL
VAR (&A) TYPE (*DEC) LEN (4 0) VALUE (100)
/*
&a variable contains No. of bytes of data to be sent to data queue */
DCL
VAR (&B) TYPE (*CHAR) LEN (300)
/*
&b variable contains actual data that is to be sent to data queue */
CHGVAR
VAR (&B) VALUE (‘WELCOME TO AS/400’)
CALL
PGM (QSNDDTAQ) PARM (SUN PRAVEEN &A
&B)
|
|
ENDPGM
Note:
- Now Data Queue SUN in Library Praveen will
contain value ‘WELCOME
TO AS/400’)
RECEIVING PROGRAM
PGM
DCL
VAR (&S) TYPE (*DEC) LEN (4 0)
DCL
VAR (&D) TYPE (*CHAR) LEN (300)
DCL
VAR (&WAIT) TYPE (*DEC) LEN (5 0) VALUE (1)
CALL
PGM (QRCVDTAQ) PARM (SUN PRAVEEN &S
&D &WAIT)
|
|
SNDPGMMSG
MSG (&D)
ENDPGM
PROGRAM TO DISPLAY USERNAME LOGINTIME SYSTEMNAME
PGM
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
DCL VAR(&SYS) TYPE(*CHAR) LEN(8)
RTVJOBA JOB(&JOB)
USER(&USER)
RTVNETA SYSNAME(&SYS)
SNDPGMMSG ('HAI' *BCAT &USER
*BCAT 'SIGNED ON AT ' *BCAT +
&JOB *BCAT
'ON' *BCAT &SYS)
END: RETURN
ENDPGM
RETRIEVING RECORDS FROM A DATA BASE FILE (EMP)
PGM
DCLF FILE ( PRAVEEN/EMP) RCDFMT ( EMPREC)
DCL
VAR (&TENO) TYPE (*CHAR ) LEN (4)
DCL
VAR (&TNAME) TYPE (*CHAR) LEN (10)
PRA1: RCVF DEV (*FILE) RCDFMT
(EMPREC)
MONMSG MSGID(
CPF0000) EXEC (GOTO CMDLBL (ERROR) )
CHGVAR
VAR ( &TENO ) VALUE (&ENO)
CHGVAR
VAR(&TNAME) VALUE (&ENAME)
SNDPGMMSG MSG
(‘EMPLOYEE NO: ‘ *CAT &TENO *CAT ‘EMPLOYEE NAME:’ *CAT
&TENAME)
GOTO
CMDLBL(PRA1)
ERROR:
SNDPGMMSG MSG( ‘END OF FILE ENCOUNTERED’)
ENDPGM
COMMANDS TO DISPLAY SYSTEM NAME, USER NAME & SYSTEM VALUES ARE
AS FOLLOWS
|
Command
|
Usage
|
|
RTVJOBA
|
TO
DISPLAY USER NAME, SYSTEM DATE,user
|
|
RTVNETA
|
TO
DISPLAY SYSTEM NAME
|
|
RTVSYSVAL
|
TO
DISPLAY SYSTEM VALUES
|
PROGRAM TO GREET AN EXECUTED USER
PGM
DCL
VAR (&USER) TYPE (*CHAR) LEN (10)
DCL
VAR (&DATE) TYPE (*CHAR) LEN (6)
RTVJOBA USER (&USER) DATE (&DATE)
SNDPGMMSG
MSG (‘AS/400 welcomes’ *cat &user *cat ‘on’ *cat %sst ( &date 3 2 )
*cat
‘ – ‘ *cat
%sst (&date 1 2) *cat ‘ – ‘ *cat %sst ( &date 5 2) )
ENDPGM
CL PROGRAM TO RETRIEVE SYSTEM VALUES
PGM
DCL
VAR ( &QTIME ) TYPE ( *CHAR ) LEN (8)
RTVSYSVAL SYSVAL (QTIME) RTNVAR (&QTIME)
SNDPGMMSG
MSG (&QTIME)
ENDPGM
FACTORIAL OF A NUMBER
PGM
DCL VAR(&N) TYPE(*DEC) LEN(7)
VALUE(9)
DCL VAR(&I) TYPE(*DEC) LEN(7)
VALUE(1)
DCL VAR(&I1) TYPE(*CHAR) LEN(7)
A:
IF COND(&N *GT 0)
THEN(DO)
CHGVAR VAR(&I) VALUE(&I * &N)
CHGVAR VAR(&N) VALUE(&N - 1)
GOTO CMDLBL(A)
ENDDO
CHGVAR VAR(&I1)
VALUE(&I)
SNDPGMMSG MSG(&I1)
ENDPGM
PROGRAMS ON DMPCLPGM COMMAND;
SEE OUTPUT IN QPPGMDMP SPOOL FILE
PGM
DCL VAR(&CHAR10) TYPE(*CHAR) LEN(10)
VALUE(HISTORY)
DCL VAR(&CHAR24) TYPE(*CHAR) LEN(24)
VALUE(MISSIPI)
DCL VAR(&DEC50) TYPE(*DEC) LEN(5 0)
VALUE(198)
DCL VAR(&DEC72) TYPE(*DEC) LEN(7 2)
VALUE(3.14)
DCL VAR(&LGL1) TYPE(*LGL)
VALUE('0')
DMPCLPGM
CHGVAR VAR(&CHAR10) VALUE('MY LIBRARY')
CHGVAR VAR(&CHAR24) VALUE(THISIS24CHARS)
DMPCLPGM
RETURN
ENDPGM
PGM
DCL VAR(&CHAR05) TYPE(*CHAR)
LEN(5)
DCL VAR(&CHAR10) TYPE(*CHAR)
LEN(10)
DCL VAR(&DEC50) TYPE(*DEC) LEN(5
0)
DCL VAR(&DEC72) TYPE(*DEC) LEN(7
2)
CHGVAR VAR(&CHAR05) VALUE('12345')
CHGVAR VAR(&CHAR10) VALUE('12345.67')
CHGVAR VAR(&DEC50) VALUE(&CHAR05)
CHGVAR VAR(&DEC72) VALUE(&CHAR10)
DMPCLPGM
CHGVAR VAR(&DEC50) VALUE(54321)
CHGVAR VAR(&DEC72) VALUE(76543.21)
CHGVAR
VAR(&CHAR05) VALUE(&DEC50)
CHGVAR VAR(&CHAR10) VALUE(&DEC72)
DMPCLPGM
RETURN
ENDPGM
GOTO
COMMAND PROGRAMS
PGM
DCL VAR(&COMPANY) TYPE(*CHAR) LEN(4)
VALUE(ABCO)
IF COND(&COMPANY *EQ ACME) THEN(GOTO
CMDLBL(ACME))
IF COND(&COMPANY *EQ ABCO) THEN(GOTO
CMDLBL(ABCO))
IF COND(&COMPANY *NE ABCO *AND
&COMPANY *NE +
ACME) THEN(SNDUSRMSG
MSG('UNKOWN COMPANY'))
GOTO (ENDOFPGM)
ACME: SNDUSRMSG ('COMPANY NAME IS
ACME')
GOTO ENDOFPGM
ABCO: SNDUSRMSG ('COMPANY NAME IS
ABCO')
GOTO ENDOFPGM
ENDOFPGM:RETURN
ENDPGM
PGM
DCL VAR(&COMPANY) TYPE(*CHAR) LEN(4)
VALUE(ACME)
IF COND(&COMPANY *EQ ACME)
THEN(DO)
SNDPGMMSG ('COMPANY
NAME IS ACME')
GOTO (ENDOFPGM)
ENDDO
IF COND(&COMPANY *EQ ABCO)
THEN(DO)
SNDPGMMSG ('COMPANY
NAME IS ABCO')
GOTO CMDLBL(ENDOFPGM)
ENDDO
IF COND(&COMPANY *NE ACBO *AND
&COMPANY *NE +
ACME) THEN(DO)
SNDPGMMSG ('COMPANY
NAME UNKNOWN')
GOTO CMDLBL(ENDOFPGM)
ENDDO
ENDOFPGM:RETURN
PGM
DCL VAR(&COMPANY) TYPE(*CHAR) LEN(4)
VALUE(ABCO)
DCL VAR(&GOODONE) TYPE(*CHAR)
LEN(1)
IF COND(&COMPANY *EQ ACME)
THEN(DO)
CHGVAR VAR(&GOODONE) VALUE(Y)
SNDPGMMSG ('COMPANY
NAME IS ACME')
GOTO (ENDOFPGM)
ENDDO
ELSE
IF COND(&COMPANY *EQ ABCO)
THEN(DO)
CHGVAR VAR(&GOODONE) VALUE(Y)
SNDPGMMSG ('COMPANY
NAME IS ABCO')
GOTO CMDLBL(ENDOFPGM)
ENDDO
ELSE DO
CHGVAR VAR(&GOODONE) VALUE(N)
SNDPGMMSG ('COMPANY
NAME UNKNOWN')
GOTO CMDLBL(ENDOFPGM)
ENDDO
ENDOFPGM: IF COND(&GOODONE *EQ 'Y')
THEN(SNDPGMMSG +
MSG('THIS IS GOOD
ONE'))
ELSE CMD(SNDPGMMSG MSG('THIS IS
BADONE'))
RETURN
ENDPGM
DMPCLPGM COMMAND PROGRAM CALL
THE CL PROGRAM WATCH QPPGMDMP
PGM
DCL VAR(&NUM1) TYPE(*DEC) LEN(3 0)
VALUE(1)
DCL VAR(&NUM2) TYPE(*DEC) LEN(3 0)
VALUE(2)
DCL VAR(&NUM3) TYPE(*DEC) LEN(3 0)
VALUE(3)
DCL VAR(&NUM4) TYPE(*DEC) LEN(3 0)
VALUE(4)
DCL VAR(&RST1) TYPE(*DEC) LEN(15 5)
VALUE(0
DCL VAR(&RST2) TYPE(*DEC) LEN(15 5)
VALUE(0
DCL VAR(&RST3) TYPE(*DEC) LEN(15 5)
VALUE(0
DCL
VAR(&RST4) TYPE(*DEC) LEN(15 5) VALUE(0
CHGVAR VAR(&RST1) VALUE(2 + 1)
CHGVAR VAR(&RST2) VALUE(1 - 2)
CHGVAR VAR(&RST3) VALUE(1 * 2)
CHGVAR VAR(&RST4) VALUE(1 / 2)
DMPCLPGM
CHGVAR VAR(&RST1) VALUE(&NUM1 +
&NUM2)
CHGVAR VAR(&RST2) VALUE(&NUM1 -
&NUM2)
CHGVAR VAR(&RST2) VALUE(&NUM1 -
&NUM2)
CHGVAR
VAR(&RST3) VALUE(&NUM1 * &NUM2)
CHGVAR
VAR(&RST4) VALUE(&NUM1 / &NUM2)
DMPCLPGM
CHGVAR
VAR(&RST1) VALUE(&NUM1 * -&NUM2)
CHGVAR
VAR(&RST2) VALUE(&NUM1 / -&NUM2)
CHGVAR
VAR(&RST3) VALUE(-&NUM1 * &NUM2)
CHGVAR
VAR(&RST4) VALUE(-&NUM1 / &NUM2)
DMPCLPGM
CHGVAR VAR(&RST1)
VALUE(&NUM2 / &NUM3 + &NUM1)
CHGVAR VAR(&RST2)
VALUE((&NUM2 * 2 ) / &NUM4)
CHGVAR VAR(&RST3)
VALUE((&NUM1 + &NUM2) * &NUM4)
CHGVAR VAR(&RST4)
VALUE((&NUM2 / 2) - &NUM4)
DMPCLPGM
ENDPGM
USING DO LOOP PROGRAM MESSAGES
WILL APPEAR IN JOB LOG
PGM
DCL VAR(&COUNTER) TYPE(*DEC) LEN(1)
VALUE(0)
DCL VAR(&TCOUNT) TYPE(*CHAR) LEN(1)
VALUE('0')
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
RTVJOBA USER(&USER)
LOOP: IF (&COUNTER = 3) THEN(GOTO END)
ELSE
CHGVAR (&COUNTER)
(&COUNTER + 1)
CHGVAR (&TCOUNT)
(&COUNTER)
SNDMSG MSG('THIS IS LOOP ' *CAT &TCOUNT)
+
TOUSR(&USER)
GOTO (LOOP)
END: ENDPGM
PROGRAM ON STRING FUNCTIONS AND
ALSO VARIOUS RETRIEVE COMMANDS
PGM
DCL VAR(&TIME) TYPE(*CHAR) LEN(8)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
RTVJOBA USER(&USER)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
CHGVAR VAR(&TIME)
VALUE((%SST(&TIME 1 2)) *CAT ':' *CAT +
(%SST(&TIME 3 2)) *CAT ':' *CAT +
(%SST(&TIME 5 2)))
SNDPGMMSG MSG('HI ' *CAT &USER *CAT 'THE TIME IS '
+
*CAT &TIME)
END:
ENDPGM
PGM
DCL VAR(&TIME) TYPE(*CHAR) LEN(8)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&HOURS) TYPE(*DEC) LEN(2)
RTVJOBA USER(&USER)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
CHGVAR (&HOURS)
(%SST(&TIME 1 2))
CHGVAR VAR(&TIME)
VALUE((%SST(&TIME 1 2)) *CAT ':' *CAT +
(%SST(&TIME 3 2)) *CAT ':' *CAT
+
(%SST(&TIME 5 2)))
IF (&HOURS *GE 0 *AND
&HOURS *LT 12) +
(SNDPGMMSG MSG('HI GOOD MORNING'
*CAT &USER *CAT 'THE TIME IS ' +
*CAT
&TIME))
ELSE IF (&HOURS *GE 12 *AND
&HOURS *LT 17) +
(SNDPGMMSG MSG('HI GOOD
AFTERNOON' *CAT &USER *CAT 'THE TIME IS ' +
*CAT &TIME))
ELSE IF (&HOURS *GE 17 *AND &HOURS *LT
20) +
(SNDPGMMSG MSG('HI GOOD EVENING'
*CAT &USER *CAT 'THE TIME IS ' +
*CAT &TIME))
END:
ENDPGM
PROGRAM PARAMETRES
EXAMPLES
COMMANDLINE
PARMS
PGM PARM(&CHAR3)
DCL VAR(&CHAR3) TYPE(*CHAR) LEN(3)
DCL VAR(&TEXT) TYPE(*CHAR) LEN(11)
VALUE('THE +
PARMIS')
SNDPGMMSG (&TEXT *CAT
&CHAR3)
ENDPGM
PGM PARM(&LIB)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DSPLIB LIB(&LIB)
ENDPGM
PGM PARM(&LIB)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&JTP) TYPE(*CHAR) LEN(1)
RTVJOBA TYPE(&JTP)
IF (&JTP = '1') DO
SBMJOB CMD(CALL PGM(SA1105HSH)
PARM(&LIB))
SNDPGMMSG ('JOBSUBMITTED TO
BATCH')
RETURN
ENDDO
DSPLIB LIB(&LIB)
ENDPGM
PGM PARM(&FILE)
DCL (&FILE) TYPE(*CHAR)
LEN(10)
CHKOBJ OBJ(HASHEEM/&FILE) OBJTYPE(*PGM)
SNDPGMMSG ('PROGRAM ENDED
NORMALLY')
RETURN
ENDPGM
PGM PARM(&FILE)
DCL (&FILE) TYPE(*CHAR)
LEN(10)
CHKOBJ OBJ(HASHEEM/&FILE) OBJTYPE(*PGM)
MONMSG MSGID(CPF9801) EXEC(DO)
SNDPGMMSG MSG('CANT FIND +
FILE' *BCAT
&FILE)
RETURN
ENDDO
SNDPGMMSG ('PROGRAM ENDED
NORMALLY')
RETURN
ENDPGM
PGM PARM(&LIB &FILE)
DCL (&FILE) TYPE(*CHAR)
LEN(10)
DCL (&LIB) TYPE(*CHAR)
LEN(10)
DCL (&MSG) TYPE(*CHAR)
LEN(50)
MONMSG MSGID(CPF0000) EXEC(GOTO
CMDLBL(ERROR))
DSPFD FILE(&LIB/&FILE)
DSPLIB LIB(&LIB)
GOTO (ENDIT)
ERROR: RCVMSG MSGTYPE(*LAST) MSG(&MSG)
SNDPGMMSG (&MSG)
ENDIT:
RETURN
ENDPGM
CALLING PROGRAM’S
PGM
DCL &NAME *CHAR 20
+
VALUE('JOHN J.SMITH')
DCL &ADRESS *CHAR VALUE('123 MAINSTREET APARTMENT 45')
DCL &COMENT *CHAR 55 VALUE('LONG TIME CUSTOMER')
DCL &CREDLIMIT *DEC (11 2) VALUE(5000)
DCL &ACTIVE *LGL VALUE('1')
DMPCLPGM
CALL PGMB PARM(&NAME &ADRESS &COMENT 'PHILADEPHIA'
&CREDLIMIT +
55400.10 &ACTIVE)
DMPCLPGM
SNDPGMMSG ('PROCESING COMPLETE') MSGTYPE(*COMP)
RETURN
ENDPGM
PGM
DCL &NAME *CHAR 20
+
VALUE('JOHN J.SMITH')
DCL &ADRESS *CHAR VALUE('123 MAINSTREET APARTMENT 45')
DCL &COMENT *CHAR 55 VALUE('LONG TIME CUSTOMER')
DCL &CREDLIMIT *DEC (11 2) VALUE(5000)
DCL &ACTIVE *LGL VALUE('1')
DMPCLPGM
CALL PGMB PARM(&NAME &ADRESS &COMENT 'PHILADEPHIA'
&CREDLIMIT +
55400.10
&ACTIVE)
DMPCLPGM
SNDPGMMSG ('PROCESING COMPLETE') MSGTYPE(*COMP)
RETURN
ENDPGM
PGMB
PGM PARM(&NAME &ADRESS
&COMENT &CITY &CREDLIMIT +
&HIGHBAL
&ACTIVE)
DCL &NAME *CHAR 20
DCL &ADRESS *CHAR 35
DCL &CITY *CHAR 21
DCL &COMENT *CHAR 55
DCL &CREDLIMIT *DEC (11
2)
DCL &HIGHBAL *DEC (15 5)
DCL &ACTIVE *LGL
CHGVAR (&NAME) VALUE('JERRY
JAMES')
CHGVAR (&ADRESS) VALUE('124
ALDERSON')
CHGVAR (&CITY) VALUE('NEWYORK')
CHGVAR (&COMENT)
VALUE(BLANK)
CHGVAR (&CREDLIMIT)
VALUE(1000.50)
CHGVAR (&HIGHBAL)
VALUE(67100)
CHGVAR (&ACTIVE) VALUE('0')
DMPCLPGM
RETURN
ENDPGM
CALLING
PROGRAM
PGM (&TEXT1)
DCL &TEXT1 *CHAR LEN(6)
DCL &MESSAGE *CHAR LEN(100)
CALL
SA1303HSH (&TEXT1 &MESSAGE)
SNDPGMMSG (&MESSAGE)
RETURN
ENDPGM
CALLED
ROGRAM
PGM (&DATE &MSG)
DCL
&DATE *CHAR LEN(6)
DCL
&MSG *CHAR LEN(100)
DCL
&TEMP1 *CHAR 2
DCL
&TEMP2 *CHAR 9
CHGVAR (&TEMP1) (%SST(&DATE 1 2))
IF
(&TEMP1 *GE '01' *AND &TEMP1 *LE '12') (DO)
IF (&TEMP1 = '01') (CHGVAR (&TEMP2) ('JANAUARY'))
IF (&TEMP1 = '02') (CHGVAR (&TEMP2) ('FEBRAURY'))
IF (&TEMP1 = '03') (CHGVAR (&TEMP2) ('MARCH'))
IF (&TEMP1 = '04') (CHGVAR (&TEMP2) ('APRIL'))
IF (&TEMP1 = '05') (CHGVAR (&TEMP2) ('MAY'))
IF (&TEMP1 = '06') (CHGVAR (&TEMP2) ('JUNE'))
IF (&TEMP1 = '07') (CHGVAR (&TEMP2) ('JULY'))
IF
(&TEMP1 = '08') (CHGVAR (&TEMP2) ('AUGUST'))
IF (&TEMP1 = '09') (CHGVAR (&TEMP2) ('SEPTEMBER'))
IF (&TEMP1 = '10') (CHGVAR (&TEMP2) ('OCTOBER'))
IF
(&TEMP1 = '11') (CHGVAR (&TEMP2) ('NOVEMBER'))
IF
(&TEMP1 = '12') (CHGVAR (&TEMP2) ('DECEMBER'))
ENDDO
ELSE (DO)
CHGVAR (&MSG) ('INVALID DATE')
GOTO (END)
ENDDO
CHGVAR (&MSG) (&TEMP2 *BCAT (%SST(&DATE 3 2)) *BCAT '19'
*CAT +
(%SST(&DATE
5 2)))
END:RETURN
ENDPGM
DIFFERENCE BETWEEN TWO DATES INTHE SAMEYEAR PROGRAM
PGM (&DATE1 &DATE2)
DCL VAR(&DATE1) TYPE(*CHAR) LEN(6)
DCL VAR(&DATE2) TYPE(*CHAR) LEN(6)
DCL VAR(&TEMP1) TYPE(*DEC) LEN(3 0)
DCL VAR(&TEMP2) TYPE(*DEC) LEN(3 0)
DCL VAR(&TEMP3) TYPE(*DEC) LEN(3 0)
DCL VAR(&TEMP4) TYPE(*CHAR) LEN(3)
/*
MONMSG (CPF0000) EXEC(GOTO (ERROR)) */
CVTDAT DATE(&DATE1) TOVAR(&DATE1)
FROMFMT(*MDY) +
TOFMT(*JUL)
CVTDAT DATE(&DATE2) TOVAR(&DATE2)
FROMFMT(*MDY) +
TOFMT(*JUL)
CHGVAR VAR(&TEMP1) VALUE((%SST(&DATE1 4
3)))
CHGVAR VAR(&TEMP2) VALUE((%SST(&DATE2 4
3)))
CHGVAR VAR(&TEMP3) VALUE(&TEMP1 -
&TEMP2)
CHGVAR VAR(&TEMP4) VALUE(&TEMP3)
SNDPGMMSG ('DIFFERENCE BETWEEN TWO DATES IS ' *BCAT &TEMP4)
GOTO (END)
ERROR:
SNDPGMMSG ('INVALID DATES ')
END:
RETURN
ENDPGM
PROGRAM TO DISPLAY USERNAME LOGINTIME SYSTEMNAME
PGM
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
DCL VAR(&SYS) TYPE(*CHAR) LEN(8)
RTVJOBA JOB(&JOB) USER(&USER)
RTVNETA SYSNAME(&SYS)
SNDPGMMSG ('HAI' *BCAT &USER
*BCAT 'SIGNED ON AT ' *BCAT +
&JOB *BCAT
'ON' *BCAT &SYS)
END: RETURN
ENDPGM
SIMPLE MENU
PROGRAM
PGM
DCLF FILE(HASHEEM/SA1503HSH)
SNDRCVF
READ:
IF COND(&IN03 = '1')
THEN(GOTO CMDLBL(END))
IF (&OPT = 1) THEN(DSPJOB)
ELSE IF (&OPT = 2) THEN(WRKSPLF)
ELSE IF (&OPT = 3) THEN(WRKSBMJOB)
ELSE (DO)
CHGVAR (&OPT) (0)
SNDRCVF
GOTO (READ)
ENDDO
END:
ENDPGM
A*%%TS SD 20050217
054046 HASHIM REL-V3R7M0 5716-PW1
A*%%EC
A
DSPSIZ(24 80 *DS3)
A R RCDFMT1
A*%%TS SD 20050217
054046 HASHIM REL-V3R7M0 5716-PW1
A
CA03(03)
A
CA09(09)
A
5 17'PROGRAMER MENU'
A
DSPATR(HI)
A COLOR(RED)
A
7 14'1.DISPLAY JOB'
A
9 14'2.WORKWITHSPOOLEDFILE'
A
11 14'3.WORKWITHSUBMITTEDJOBS'
A 14 14'OPTION:'
A OPT 1S 0B 14 23
PROGRAM TO FIND TOTAL SIZE OF LIBRARY
PGM
DCL
(&LIB) (*CHAR) LEN(10)
DCL
(&TOTSIZ) (*DEC) LEN(15 0)
DCL
(&TOTSIZ1) (*CHAR) LEN(25)
DCL
(&USR) (*CHAR) LEN(10)
DCLF QSYS/QADSPOBJ
RTVDTAARA DTAARA(*LDA (1 10)) RTNVAR(&LIB)
DSPOBJD OBJ(&LIB/*ALL) +
OBJTYPE(*ALL) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ)
OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/QADSPOBJ)
READ: RCVF
MONMSG (CPF0864) EXEC(GOTO (END))
CHGVAR (&TOTSIZ)
(&TOTSIZ+&ODOBSZ)
GOTO (READ)
END: CHGVAR (&TOTSIZ1) (&TOTSIZ)
DLTF FILE(QTEMP/QADSPOBJ)
SNDPGMMSG ('TOTALSIZE OF THE LIB
' *BCAT &LIB *BCAT +
'IS' *BCAT &TOTSIZ1 *BCAT
'BYTES')
RETURN
ENDPGM
PROGRAMS ON MESSAGE QUEUES
PGM
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(END))
SNDPGMMSG MSG('THIS IS MESAGE 1') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('THIS IS MESAGE 2') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('THIS IS MESAGE 3') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('THIS IS MESAGE 4') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('job
ended') TOPGMQ(*SAME) +
MSGTYPE(*ESCAPE)
END:
ENDPGM
PGM
SNDPGMMSG MSG('THIS IS MESAGE 1') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('THIS IS MESAGE 2') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('THIS IS MESAGE 3') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('THIS IS MESAGE 4') TOPGMQ(*EXT) +
MSGTYPE(*INFO)
SNDPGMMSG MSG('job ended NORMALLY') TOPGMQ(*SAME)
+
MSGTYPE(*COMP)
WRKMSGQ MSGQ(SA1602HSH)
ENDPGM
INORDER TO RETRIEVE PARTICULAR TYPE OF OBJECTS FROM
LIBRARY
PGM (&LIB)
DCL
(&LIB) (*CHAR) LEN(10)
DCL
(&TYPE) (*CHAR) LEN(5)
DCLF QSYS/QADSPOBJ
DSPOBJD OBJ(&LIB/*ALL) OBJTYPE(*ALL) +
OUTPUT(*OUTFILE)
OUTFILE(QTEMP/QADSPOBJ)
MONMSG
(CPF0000)
OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/QADSPOBJ)
+
SHARE(*YES)
CHGVAR VAR(&TYPE) VALUE(*FILE)
OPNQRYF FILE((QADSPOBJ)) QRYSLT('&odobtp =
&TYPE') +
OPNID(SAM)
CPYFRMQRYF FROMOPNID(SAM)
TOFILE(QTEMP/SELOBJ) +
MBROPT(*REPLACE)
CRTFILE(*YES) FMTOPT(*NOCHK)
DSPPFM FILE(QTEMP/SELOBJ)
DLTOVR (QADSPOBJ)
CLOF (SAM)
DLTF (QTEMP/QADSPOBJ)
DLTF (QTEMP/SELOBJ)
RETURN
ENDPGM
CHANGE THE LENGTH OF THE &DATE TO 4 AND WATCH THE
OUTPUT
/*BEGINING OF THE PROGRAM*/
PGM /*PROGRAM LINKAGE SECTION*/
/*DECLARATION SECTION*/
DCL VAR(&DATE) TYPE(*CHAR) LEN(6)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR)
LEN(100)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR)
LEN(10)
DCL VAR(&ERRORSW) TYPE(*LGL)
/*PROCEDURESECTION */
MONMSG MSGID(CPF0000) EXEC(GOTO
CMDLBL(ERROR))
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&DATE)
SNDPGMMSG MSG('THECURRENT DATE IS :' *CAT
&DATE)
RETURN
/*ERROR PROCEDUR*/
ERROR:
IF COND(&ERRORSW)
THEN(SNDPGMMSG +
MSGID(CPF9999) MSGF(CPFMSG) MSGTYPE(*ESCAPE))
CHGVAR VAR(&ERRORSW) VALUE('1')
ERROR2:
RCVMSG MSGTYPE(*DIAG)
MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF)
SNDMSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ')
GOTO ERROR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
MSGTYPE(*DIAG)
GOTO
ERROR2
ERROR3:
RCVMSG MSGTYPE(*EXCP)
MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGTYPE(*ESCAPE) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGFLIB/&MSGF)
ENDPGM
..
BIGGESTNO OF 3 VALUES
PGM
DCLF FILE(HASHEEM/DSP2) RCDFMT(RCDBIG)
A: SNDRCVF RCDFMT(RCDBIG)
IF COND(&IN03 *EQ '0') THEN(DO)
IF COND(&V1 *GT &V2)
THEN(DO)
CHGVAR VAR(&R) VALUE(&V1)
SNDRCVF RCDFMT(RCDBIG)
GOTO CMDLBL(BIG)
ENDDO
CHGVAR VAR(&R) VALUE(&V2)
SNDRCVF RCDFMT(RCDBIG)
ENDDO
BIG: IF COND(&R *GT &V3) THEN(DO)
GOTO CMDLBL(CLOSE)
ENDDO
CHGVAR VAR(&R) VALUE(&V3)
SNDRCVF RCDFMT(RCDBIG)
CLOSE: IF COND(&IN05 *EQ '1') THEN(DO)
CHGVAR VAR(&V1) VALUE(0)
CHGVAR VAR(&V2) VALUE(0)
CHGVAR VAR(&V3) VALUE(0)
CHGVAR VAR(&R) VALUE(0)
SNDRCVF RCDFMT(RCDBIG)
GOTO CMDLBL(A)
ENDDO
A*%%TS
SD 20041227 103334
HASHIM REL-V3R7M0 5716-PW1
A*%%EC
A DSPSIZ(24
80 *DS3)
A
R RCDBIG
A*%%TS
SD 20041227 103334
HASHIM REL-V3R7M0 5716-PW1
A
CA03(03)
A
CA05(05)
A 3 24'BIGGEST
OF THREE NUMBERS'
A 6 10'ENTER VALUE
1:'
A 8 10'ENTER
VALUE 2:'
A 10 10'ENTER
VALUE 3:'
A 13 40'RESUL :
'
A
V1 6Y 2B 6 26EDTWRD(' .
')
A
V2 6Y 2B 8 26EDTWRD(' .
')
A
V3 6Y 2B 10
26EDTWRD(' . ')
A
R 6Y 2B 13
49EDTWRD(' . ')
BIGGEST NO OF 4 VALUES
PGM
DCLF FILE(HASHEEM/DISP3) RCDFMT(RCDDSP4)
DCL VAR(&T) TYPE(*DEC) LEN(8)
DCL VAR(&T1) TYPE(*DEC) LEN(8)
A:
SNDRCVF RCDFMT(RCDDSP4)
IF COND(&IN03 *EQ '0') THEN(DO)
IF COND(&V1 *GT &V2)
THEN(DO)
CHGVAR VAR(&T) VALUE(&V1)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(BIG1)
ENDDO
CHGVAR VAR(&T) VALUE(&V2)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(BIG1)
BIG1:
IF COND(&V3 *GT
&V4) THEN(DO)
CHGVAR VAR(&T1) VALUE(&V3)
CHGVAR VAR(&T1) VALUE(&V3)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(BIG)
ENDDO
CHGVAR VAR(&T1) VALUE(&V4)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(BIG)
BIG: IF COND(&T1 *GT &T) THEN(DO)
CHGVAR VAR(&R) VALUE(&T1)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(CLOSE)
ENDDO
ELSE
CHGVAR VAR(&R) VALUE(&T)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(CLOSE)
CLOSE:
IF COND(&IN05 *EQ '1') THEN(DO)
CHGVAR VAR(&V1) VALUE(0)
CHGVAR VAR(&V2) VALUE(0)
CHGVAR VAR(&V3)
VALUE(0)
CHGVAR VAR(&V4)
VALUE(0)
CHGVAR VAR(&R)
VALUE(0)
SNDRCVF RCDFMT(RCDDSP4)
GOTO CMDLBL(A)
ENDDO
ENDDO
ENDPGM
A*%%TS SD 20041228
044920 HASHIM REL-V3R7M0 5716-PW1
A*%%EC
A
DSPSIZ(24 80 *DS3)
A R RCDDSP4
A*%%TS SD 20041228
044920 HASHIM REL-V3R7M0 5716-PW1
A
CA03(03)
A CA05(05)
A
2 28'BIGEST OF FOUR VALUE '
A
5 10'ENTE VALUE 1 : '
A
7 10'ENTER VALUE 2 :'
A
9 10'ENTER VALUE 3 :'
A
11 9'ENTER VALUE 4 :'
A
16 41'RESULT :'
A V1 6
0B 5 27
A V2 6
0B 7 28
A V3 6
0B 9 29
A V4 6
0B 11 29
A R 6
0B 16 51
LDA 1024
GDA 512
PIP 2000
32bytes
*char
15 5 *dec default 0
1A
LGL default 1
CHGDTAARA <data area>
No comments:
Post a Comment