AS/400 Forum

Saturday, January 4, 2014

CHGPF.

CHGPF there's a quirk that can bite your...

The Change Physical File (CHGPF) is a useful command that allows you to change many attributes of a physical file. Many IBM i (AS400) programmers use it to add fields or change the existing fields without having to recompile file. I do too, as I don't have to do the following:

Delete all the dependent logical files.
Make a copy of the phyiscal file with all the data in it.
Delete the phyiscal file.
Compile the physical file.
Copy the data from the copied file into the pysical file.
Delete the copied file.
Compile all the dependent logical files.

Generally the rule is in this IT department is that all dependent logical files have the same record format name as the physical. But there are a few odd-ball logical files with a different record format name.
When the physical file was changed using the CHGPF command it caused strange errors in programs that used some of the dependent logical files.
After scratching my head for awhile I worked out what had happened.
In this example I have a physical file, TESTPF, with two dependent logical files, TESTLF and TESTLF2.
The DDS source code for the physical file TESTPF was:

A                                      UNIQUE 
A          R TESTPFR 
A            FLD01          1A         TEXT('First field') 
                                       COLHDG('1st' 'fld')
A            FLD02          1A         TEXT('Second field')
                                       COLHDG('2nd' 'fld')
A          K FLD01

The first logical file, TESTLF, has the same record format name as the phyiscal file:

A          R TESTPFR                   PFILE(TESTPF)
A          K FLD02

The second, TESTLF2. has a different record format name.

A          R TESTLFR                   PFILE(TESTPF)
A            FLD01 
A            FLD02 
A          K FLD01

By using the Display File Field Description (DSPFFD) command to I confirm that the three files are identical, which they are.

           Data        Field  Buffer    Buffer        Field    Column 
Field      Type       Length  Length  Position        Usage    Heading
FLD01      CHAR            1       1         1        Both     1st
                                                               fld
  Field text  . . . . . . . . . . . . . . . :  First field
  Coded Character Set Identifier  . . . . . :     37 
FLD02      CHAR            1       1         2        Both     2nd
                                                               fld
  Field text  . . . . . . . . . . . . . . . :  Second field
  Coded Character Set Identifier  . . . . . :     37

I edit the DDS for TESTPF. I change FLD01 to be 2 alphanumeric, and add a new field called NEW.

A                                      UNIQUE
A          R TESTPFR
A            FLD01          2A         TEXT('First field') 
                                       COLHDG('1st' 'fld') 
A            FLD02          1A         TEXT('Second field')
                                       COLHDG('2nd' 'fld') 
A            NEW            1A         TEXT('New field')
                                       COLHDG('New' 'fld')
A          K FLD01

Now I use Change Physical file (CHGPF) command to make the changes. Fill in the fields on the first screen as shown below, and press Enter.

            Change Physical File (CHGPF) 

 Type choices, press Enter.

 Physical file  . . . . . . . . .   TESTPF    
   Library  . . . . . . . . . . .     MYLIB     
 System . . . . . . . . . . . . .   *LCL     
 Source file  . . . . . . . . . .   QDDSSRC   
   Library  . . . . . . . . . . .     MYLIB

And I press Enter a second time when the Additional Parameters are displayed.
After running the CHGPF command I go and check the that files changes were successful using DSPFFD. TESTPF and TESTLF have changed:

           Data        Field  Buffer    Buffer        Field    Column
Field      Type       Length  Length  Position        Usage    Heading
FLD01      CHAR            2       2         1        Both     1st
                                                               fld
  Field text  . . . . . . . . . . . . . . . :  First field
  Coded Character Set Identifier  . . . . . :     37
FLD02      CHAR            1       1         3        Both     2nd
                                                               fld
  Field text  . . . . . . . . . . . . . . . :  Second field
  Coded Character Set Identifier  . . . . . :     37
NEW        CHAR            1       1         4        Both     New
                                                               fld
  Field text  . . . . . . . . . . . . . . . :  New field
  Coded Character Set Identifier  . . . . . :     37

Now for the quirk: TESTLF2 is unchanged!
When I move a two character value into FLD01 in either TESTPF or TESTLF, for example ‘12’, only the first character, ‘1’ is displayed in FLD01 in TESTLF2. This could cause big problems for any programs using TESTLF2.
What is causing this? And how can we stop this from happening again?
The cause appears to be that TESTLF2's record format is not the same name as TESTPF's.
One way to fix the problem is to change the record format name in TESTLF2. But TESTLF2 may be designed to only have certain fields in it, and keep the rest unavailable. Once upon a time I built a logical file over the Payroll Employee Master file, it contained only the employee number, name, and department fields. This logical was then used by another application that needed the employees' name and which department they belonged to
I need to identify all of the dependent logical files that do not have the same record format name as the physical file. How do I do this?
First, I would run the Display Data Base Relations (DSPDBR) command. I would just type on a command line: DSPFD MYLIB/TESTPF and press Enter. On the screen displayed I type "B" in the Control field and press Enter, to go the bottom of the report. We only care about the ‘Files Dependent on Specified file’ section. In this scenario this is what is displayed:

Files Dependent On Specified File 
  Dependent File         Library       Dependency   JREF    Constraint 
      TESTLF             MYLIB         Data 
      TESTLF2            MYLIB         Data

Then I would use the Display File Description (DSPFD) command to get the record format names. I would type on a command line: DSPFD FILE(MYLIB/TESTLF*) TYPE(*RCDFMT) and press Enter. By using the wildcardTESTLF* the data for all logical files are included in the same “report”. When the output is displayed use the Find field to scan for the word “Format”:

File  . . . . . :   QPDSPFD 
Control . . . . .   ________ 
Find  . . . . . .   Format                       
 *...+....1....+....2....+....3....+....4....+....5....+....6....+
    Auxiliary storage pool ID . . . . . . . . . :            00001 
  Record Format List
                         Record  Format Level
   Format       Fields   Length  Identifier
   TESTPFR           3        4  324444D952CAD
     Text . . . . . . . . . . . . . . . . . . . :
   Total number of formats  . . . . . . . . . . :           1
   Total number of fields . . . . . . . . . . . :           3
   Total record length  . . . . . . . . . . . . :           4
  File Description Header
    File  . . . . . . . . . . . . . . . . . . . : FILE       TESTLF2 
    Library . . . . . . . . . . . . . . . . . . :            MYLIB
    Type of file  . . . . . . . . . . . . . . . :            Logical
    File type . . . . . . . . . . . . . . . . . : FILETYPE   *DATA
    Auxiliary storage pool ID . . . . . . . . . :            00001
  Record Format List
                         Record  Format Level
   Format       Fields   Length  Identifier
   TESTLFR           2        2  336F4C73C9A21

The output shows that TESTLF2's record format name is different from the physical files’s.
I would delete all the logical files with the record format name that are not the same as the physical file’s and then compiled.
To make it easier and quicker for me I have created a program that does the same as the two steps mentioned above that produces a report listing all of a physical file's dependent logicals with their record format names.
You can learn more about the CHGPF command from the IBM website here»

CL does DO.

CL does DO

Two of the Command Language, CL, commands added to IBM i (AS400) release 5.3 were theDOWHILE and DOUNTIL, and OS i (OS400) 6.1 brought us the DOFOR. I have always wanted DO commands as I have resented not being able to write "structure code" in CL as I had to use theGOTO command to create a loop.
I quickly adopted the DOWHILE into my programming, but I have been surprised that, despite bringing it to their attention, that only one of my colleagues uses it. Which is one of the reasons I wanted to create this post to make sure others are aware of them.
Prior to using these command if I wanted to read a file in a CL I had to do something like:

01         PGM
02
03         DCLF   FILE(QTEMP/WRKFILE) OPNID(A)
04
05  LOOP:  RCVF   OPNID(A)
06         MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ENDLOOP))
07
08         IF     COND(&A_STATUS *NE 'A') +
09                   THEN(GOTO CMDLBL(LOOP))
10
11  ENDLOOP:
12
13         ENDPGM

Why do I do that? I always use the OPNID parameter on the Declare File,DCLF, command (line 3) to make it easier to understand which of the fields come from the file (see line 8).
Now my code can look like this:

010         PGM
02
03         DCL     VAR(&LOOP) TYPE(*LGL) VALUE('1')
04         DCLF    FILE(QTEMP/WRKFILE) OPNID(A)
05
06         DOWHILE COND(&LOOP)
07            RCVF OPNID(A)
08            MONMSG MSGID(CPF0000) EXEC(LEAVE)
09
10            IF COND(&A_STATUS *NE 'A') THEN(ITERATE)
11
12
13         ENDDO
14
15         ENDPGM

Notice that the DOWHILE is conditioned by the field &LOOP, which a Logic type field, and providing it is "on" it will loop.
This code shows two other new CL commands, ITERATE and LEAVE. I am sure you are fully familiar with them in RPGLE, but there is one extra feature they have in CL that I will mention at the bottom of this post.
Why do I do that? I indent my code, which, in my opinion, makes it easier for someone else to read and understand.
If I need to perform a section of code a number of times I would have done something like this:

01              PGM
02
03         DCL    VAR(&COUNT) TYPE(*DEC) LEN(2 0) VALUE(1)
04
05 LOOP:
06
07
08         CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
09         IF     COND(&COUNT <= 10) +
10                   THEN(GOTO CMDLBL(LOOP))
11         ENDPGM

If I used the DOUNTIL command I can do this:

01         PGM
02
03         DCL    VAR(&COUNT) TYPE(*DEC) LEN(2 0) VALUE(1)
04                                                       
05         DOUNTIL COND(&COUNT > 10)              
06
07
08            CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
09         ENDDO
10
11         ENDPGM

With the introduction of the DOFOR I use it instead:

01         PGM
02
03         DCL     VAR(&COUNT) TYPE(*INT) LEN(2)
04
05         DOFOR   VAR(&COUNT) FROM(1) TO(10)
06
07
08         ENDDO
09
10         ENDPGM

Notice that te &COUNT field has to be defined as a integer, *INT.
The DOFOR works in the same way as the FOR operation code in RPGLE. It initializes the &COUNT field with the value of 1, FROM parameter. Each time it is executed it increments the &COUNT field by 1. When it reaches 10, parameterTO, it executes the DO one more time then leaves. If you want to increment&COUNT by more than one you can use the BY parameter to give the value by which it will be incremented.
Now what is that extra featrure I mentioned that the ITERATE and LEAVE has?

01            PGM
02
03            DCL      VAR(&LOOP) TYPE(*LGL) VALUE('1')
04            DCL      VAR(&COUNT) TYPE(*INT) LEN(2)
05            DCL      VAR(&FLG) TYPE(*CHAR) LEN(1)
06
07 LOOP1:     DOWHILE  COND(&LOOP)
08 LOOP2:        DOFOR    VAR(&COUNT) FROM(1) TO(10)
09
10                  IF   COND(&FLG = '2') +
11                          THEN(ITERATE CMDLBL(LOOP2))
12
13                  LEAVE   CMDLBL(LOOP1)
14               ENDDO
15            ENDDO
16
17            ENDPGM

Both ITERATE and LEAVE have the parameter CMDLBL. In the example below when the ITERATE is executed, on line 11, it iterates to the DO with that command label, in this case the first one, DOWHLE exiting the DOFOR. The LEAVE, on line 13, will leave both the DOFOR and DOWHILE.

I have tested this with program created from both CLP and CLLE source members, and it works in both.
You can learn more about the following commands from the IBM website:

DOFOR here»
DOUNTIL here»
DOWHILE here»
ITERATE here»
LEAVE here»

Basic AS/400 Commands.

DSPMSG	Displays messages in queue
DSPMSGD	Displays description of messages, ie CPF messages
WRKMSGF QCPFMSG	Displays contents of MONMSG file
WRKUSRPRF -	Can work with specified user's profile
WRKSBMJOB *JOB	Displays my jobs for the current session
WRKACTJOB	Displays all active jobs
WRKUSRJOB	Displays list of my jobs to work with
WRKOBJ	Work with an object. Use *ALLUSR in qualified name to skip Q libraries
WRKSPLF	Displays spool files
WRKOUTQ	Displays members in specified OUTQ
DISPLIB	Displays contents of specified library
EDTLIBL	Allows addition and deletion of libraries to and from list
ADDLIBLE Library Name	Add library to current list
STRPDM	Start PDM
STRDBG	Start Debug
ADDBKP	Add a break point and variables to monitor in debug
RMVBKP	Remove a break point in debug
ENDDBG	End Debug
STRDBU	Start DBU (Database Utility) Look at and make changes to the database
DBU Qualified Name	Runs DBU without the above command. ADDLIBLE DBU41 *LAST before using
STRDFU	Start DFU (Data File Utility) Many of the same functions of DBU
DSPFFD	Displays file field descriptions
DSPFD	Displays file description for specified file
DSPPFM	Displays member of a physical file
DSPDBF	Displays contents of database file. Must add TAATOOL to library list before using this command
DSPPGMREF	Display the files used in a program and which libraries the program was compiled over
PRTRNG	Will allow printing a range of pages from a member in the specified OUTQ. Must add PRTRNG to library list before using this command
OUTQ(PRINTER)	Mark object in spool file with 2 for change. Type this on the command line.
WRKJOBSCDE	Look at scheduled jobs
RUNQRY QRYFILE(LIB/FILE)	Run query on a file with no parameters
DSPDBR LIB/FILE	Shows logicals related to a physical file

CL Program with Parameter Passing Technique.

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(&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)

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

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>