|
 |
|
CLLE - Example of code to return previous program name
Posted By: JimmyOctane Contact |
PGM PARM(&CALLER &PGM)
DCL VAR(&CALLER) TYPE(*CHAR) LEN(10)
DCL VAR(&PGM) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
CHGVAR VAR(&CALLER) VALUE(' ')
SNDPGMMSG MSG('WHO CALLED ME?') TOPGMQ(*PRV (&PGM)) +
KEYVAR(&MSGKEY)
RCVMSG PGMQ(*PRV (&PGM)) MSGTYPE(*INFO) +
MSGKEY(&MSGKEY) RMV(*YES) SENDER(&SENDER)
CHGVAR VAR(&CALLER) VALUE(%SST(&SENDER 56 10))
GOTO CMDLBL(ENDPGM)
ERROR: CHGVAR VAR(&CALLER) VALUE(' ')
ENDPGM: ENDPGM
| |
CLLE - Progam using OPNQRYF and %SST (substring)
Posted By: Reynoo Moore Contact |
PGM PARM(&CALL)
DCL VAR(&CALL) TYPE(*CHAR) LEN(7)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&SLT1) TYPE(*CHAR) LEN(250) +
VALUE('NOSALE *EQ %RANGE(" " " ")')
CHGVAR VAR(&TYPE) VALUE(%SST(&CALL 1 1))
CHGVAR VAR(%SST(&SLT1 20 3)) VALUE(%SST(&CALL 2 3))
CHGVAR VAR(%SST(&SLT1 26 3)) VALUE(%SST(&CALL 5 3))
OVRDBF FILE(RU1NOI) SHARE(*YES)
OPNQRYF FILE((RU1NOI)) QRYSLT(&SLT1) KEYFLD((NOSALE) +
(NONUM))
IF COND(&TYPE *EQ 'Y') THEN(CALL PGM(APWSLSITM) +
PARM(&CALL))
IF COND(&TYPE *NE 'Y') THEN(CALL PGM(APWSLSINV) +
PARM(&CALL))
CLOF OPNID(RU1NOI)
DLTOVR FILE(RU1NOI)
ENDPGM
| |
CLLE - Adding to variable within CLP
Posted By: Jamie Flanary Contact |
PGM
DCL &C *LGL
DCL &A *DEC VALUE(22)
DCL &B *CHAR VALUE(ABCDE)
•
•
•
CHGVAR &A (&A + 30)
•
•
•
IF (&A < 50) THEN(CHGVAR &C ’1’)
•
DSPLIB (’Q’ || &B)
•
IF (%SST(&B 5 1)=E) THEN(CHGVAR &A 12)
•
•
•
ENDPGM
| |
CLLE - CL procedure to monitor error messages for a job
Posted By: Jamie Flanary Contact |
PGM
MONMSG MSGID(CPF0001) EXEC(GOTO ERROR)
CALL PROGA
CALL PROGB
RETURN
ERROR: SNDPGMMSG MSG(’A CALL command failed’) MSGTYPE(*ESCAPE)
ENDPGM
| |
CLLE - Declaring variables
Posted By: Jamie Flanary Contact |
DCL VAR(&LIB1) TYPE(*CHAR) LEN(10) VALUE(QTEMP)
DCL VAR(&LIB2) TYPE(*CHAR) LEN(10) VALUE(QGPL)
DCL VAR(&LIB3) TYPE(*CHAR) LEN(10) VALUE(DISTLIB)
CHGLIBL LIBL(&LIB1 &LIB2 &LIB3)
| |
CLLE - Using the ELSE in CLP
Posted By: Jamie Flanary Contact |
IF (&A=&B) THEN(CALLPRC PROCA)
ELSE CMD(CALLPRC PROCB)
CHGVAR &C 8
IF ... THEN ...
IF ...THEN(DO)
IF ...THEN(DO)
.
.
.
ENDDO
ELSE DO
IF ...THEN(DO)
.
.
.
ENDDO
ELSE DO
.
.
.
ENDDO
ENDDO
ELSE IF ... THEN ...
IF ... THEN ...
IF ... THEN ...
| |
CLLE - Logical expressions in CLP examples
Posted By: Jamie Flanary Contact |
((&C *LT 1) *AND (&TIME *GT 1430))
(&C *LT 1 *AND &TIME *GT 1430)
((&C < 1) & (&TIME>1430))
((&C< 1) & (&TIME>1430))
IF ((&RESP=1) *AND (&A=5) *AND (&B=NO)) THEN(DO)
IF (((&A=&B) *OR (&A=&C)) *AND ((&C=1) *OR (&D=’0’))) THEN(DO)
DCL &A *LGL VALUE(’0’)
DCL &B *LGL VALUE(’1’)
DCL &C *LGL VALUE(’1’)
IF (&A *OR &B *OR &C) THEN(CALL PGMA)
The value of the decimal variable &N is converted to a 4-byte signed binary
number and is placed in character variable &B4 Variable &B4 will have the
value of X'0000006B'.
DCL VAR(&P) TYPE(*CHAR) LEN(100)
DCL VAR(&L) TYPE(*DEC) LEN(5 0)
CHGVAR &L VALUE(%BIN(&P 1 2) * 5)
| |
CLLE - using %SUBSTR or %SST in CLP
Posted By: Jamie Flanary Contact |
The substring built-in function (%SUBSTRING or%SST) produces a character string
that is a subset of an existing character string and can only be used within a CL
procedure. In a CHGVAR command, the %SST function can be specified in place of
the variable (VAR parameter) to be changed or the value (VALUE parameter) to
which the variable is to be changed. In an IF command, the %SST function can be
specified in the expression.
The format of the substring built-in function is:
%SUBSTRING(character-variable-name starting-position length)
or
%SST(character-variable-name starting-position length)
The following are examples of the substring built-in function:
If the first two positions in the character variable &NAME are IN, the program
INV210 is called. The entire value of &NAME is passed to INV210 and the value
of &ERRCODE is unchanged. Otherwise, the value of &ERRCODE is set to 99.
DCL &NAME *CHAR VALUE(INVOICE)
DCL &ERRCODE *DEC (2 0)
IF (%SST(&NAME 1 2) *EQ ’IN’) +
THEN(CALL INV210 &NAME)
ELSE CHGVAR &ERRCODE 99
If the first two positions of &A match the first two positions of &B, the program
CUS210 is called.
DCL &A *CHAR VALUE(ABC)
DCL &B *CHAR VALUE(DEF)
IF (%SST(&A 1 2) *EQ %SUBSTRING(&B 1 2)) +
CALL CUS210
Position and length can also be variables: This example changes the value of &X
beginning at position &Y for the length &Z to 123.
CHGVAR %SST(&X &Y &Z) ’123’
If &A is ABCDEFG before this CHGVAR command is run, &A is
CHGVAR %SST(&A 2 3) ’123’
| |
CLLE - Retrieving a system value with CLP (QTIME)
Posted By: Jamie Flanary Contact |
System Value QTIME
In the following example, QTIME is received and moved to a variable, which is
then compared with another variable.
PGM
DCL VAR(&PWRDNTME) TYPE(*CHAR) LEN(6) VALUE(’162500’)
DCL VAR(&TIME) TYPE(*CHAR) LEN(6)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&TIME)
IF (&TIME *GT &PWRDNTME) THEN(DO)
SNDBRKMSG(’Powering down in 5 minutes. Please sign off.’)
PWRDWNSYS OPTION(*CNTRLD) DELAY(300) RESTART(*NO) +
IPLSRC(*PANEL)
ENDDO
ENDPGM
| |
CLLE - Convert a date to julian in CLP
Posted By: Jamie Flanary Contact |
PGM
DCL &DATE6 *CHAR LEN(6)
DCL &DATE5 *CHAR LEN(5)
RTVSYSVAL QDATE RTNVAR(&DATE6)
CVTDAT DATE(&DATE6) TOVAR(&DATE5) TOFMT(*JUL) TOSEP(*NONE)
ADDPFM LIB1/FILEX MBR(’MBR’ *CAT &DATE5)
.
.
.
ENDPGM
or use a c function
The following is an alternative program that uses the ILE bindable API, Get
Current Local Time (CEELOCT), to convert a date to Julian format. To create this
program, you must use the CRTBNDCL command alone or the CRTCLMOD
command and the CRTPGM command together.
PGM
DCL &LILDATE *CHAR LEN(4)
DCL &PICTSTR *CHAR LEN(5) VALUE(YYDDD)
DCL &JULDATE *CHAR LEN(5)
DCL &SECONDS *CHAR 8 /* Seconds from CEELOCT */
DCL &GREG *CHAR 23 /* Gregorian date from CEELOCT */
/* */
CALLPRC PRC(CEELOCT) /* Get current date and time */ +
PARMS (&LILDATE) /* Date in Lilian format */ +
&SECONDS /* Seconds field will not be used */
&GREG /* Gregorian field will not be used */
*OMIT /* Omit feedback parameter so exceptions +
are signalled */
CALLPRC PRC(CEEDATE) +
PARMS (&LILDATE) /* Today’s date */ +
&PICTSTR /* How to format */ +
&JULDATE /* Julian date */ +
*OMIT
ADDPGM LIB1/FILEX MBR(’MBR’ *CAT &JULDATE’)
ENDPGM
| |
CLLE - Data queues in CLP
Posted By: Jamie Flanary Contact |
Data queues are a type of system object that you can create, to which one HLL
procedure or program can send data, and from which another HLL procedure or
program can receive data. The receiving program can be already waiting for the
data, or can receive the data later.
The advantages of using data queues are:
* Using data queues frees a job from performing some work. If the job is an
interactive job, this can provide better response time and decrease the size of the
interactive program and its process access group (PAG). This, in turn, can help
overall system performance. For example, if several work station users enter a
transaction that involves updating and adding to several files, the system can
perform better if the interactive jobs submit the request for the transaction to a
single batch processing job.
* Data queues are the fastest means of asynchronous communication between two
jobs. Using a data queue to send and receive data requires less overhead than
using database files, message queues, or data areas to send and receive data.
* You can send to, receive from, and retrieve a description of a data queue in any
HLL procedure or program by calling the QSNDDTAQ, QRCVDTAQ,
QMHRDQM, QCLRDTAQ, and QMHQRDQD programs without exiting the
HLL procedure or program or calling a CL procedure or program to send,
receive, clear, or retrieve the description.
* When receiving data from a data queue, you can set a time out such that the job
waits until an entry arrives on the data queue. This differs from using the
EOFDLY parameter on the OVRDBF command, which causes the job to be
activated whenever the delay time ends.
* More than one job can receive data from the same data queue. This has an
advantage in certain applications where the number of entries to be processed is
greater than one job can handle within the desired performance restraints. For
example, if several printers are available to print orders, several interactive jobs
could send requests to a single data queue. A separate job for each printer could
receive from the data queue, either in first-in-first-out (FIFO), last-in-first-out
(LIFO), or in keyed-queue order.
* Data queues have the ability to attach a sender ID to each message being placed
on the queue. The sender ID, an attribute of the data queue which is established
when the queue is created, contains the qualified job name and current user
profile.
Create command - Local & DDM data queue
CRTDTAQ DTAQ(MYLIB/INPUT) MAXLEN(128)
TEXT(’Sample data queue’)
CRTDTAQ DTAQ(LOCALLIB/DDMDTAQ) TYPE(*DDM)
RMTDTAQ(REMOTELIB/REMOTEDTAQ) RMTLOCNAME(SYSTEMB)
TEXT(’DDM data queue to access data queue on SYSTEMB’)
| |
CLLE - Data Area definitions and example
Posted By: Jamie Flanary Contact |
Displaying a Data Area
You can display the attributes (name, library, type, length, data area text
description), and the value of a data area. See the CL section of the Programming
category in the iSeries Information Center for a detailed description of the
Display Data Area (DSPDTAARA) command.
The display uses the 24-digit format with leading zeros suppressed.
Changing a Data Area
The Change Data Area (CHGDTAARA) command changes all or part of the value
of a specified data area. It does not change any other attributes of the data area.
The new value can be a constant or a CL variable. If the command is in a CL
procedure, the data area does not need to exist when the program is created.
Retrieving a Data Area
The Retrieve Data Area (RTVDTAARA) command retrieves all or part of a
specified data area and copies it into a CL variable. The data area does not need to
exist at compilation time, and the CL variable need not have the same name as the
data area. Note that this command retrieves, but does not alter, the contents of the
specified data area.
Retrieve Data Area Examples
Example 1
Assume that you are using a data area named ORDINFO to track the status of an
order file. This data area is designed so that:
* Position 1 contains an O (open), a P (processing), or a C (complete).
* Position 2 contains an I (in-stock) or an O (out-of-stock).
* Positions 3 through 5 contain the initials of the order clerk.
You would declare these fields in your procedure as follows:
DCL VAR(&ORDSTAT) TYPE(*CHAR) LEN(1)
DCL VAR(&STOCKC) TYPE(*CHAR) LEN(1)
DCL VAR(&CLERK) TYPE(*CHAR) LEN(3)
To retrieve the order status into &ORDSTAT, you would enter the following:
RTVDTAARA DTAARA(ORDINFO (1 1)) RTNVAR(&ORDSTAT)
To retrieve the stock condition into &STOCK, you would enter the following:
RTVDTAARA DTAARA(ORDINFO (2 1)) RTNVAR(&STOCKC)
To retrieve the clerk’s initials into &CLERK, you would enter the following:
RTVDTAARA DTAARA(ORDINFO (3 3)) RTNVAR(&CLERK)
| |
CLLE - Selective prompting of CL commands
Posted By: Jamie Flanary Contact |
Selective Prompting for CL Commands
You can request to prompt for selected parameters within a command. This is
especially helpful when you are using some of the longer commands and do not
want to be prompted for certain parameters.
Selective
Prompting
Character Description
?? The parameter is displayed and input-capable.
?* The parameter is displayed but is not input-capable.
Any user-specified value is passed to the command
processing program.
?< The parameter is displayed and is input-capable, but
the command default is sent to the CPP unless the
value displayed on the parameter is changed.
?/ Reserved for IBM use.
?– The parameter is not displayed. The specified value
(or default) is passed to the CPP. Not allowed in
prompt override programs.
?& The parameter is not displayed until F9=All
parameters is pressed. Once displayed, it is
input-capable. The command default is sent to the
CPP unless the value displayed on the parameter is
changed.
?% The parameter is not displayed until F9=All
parameters is pressed. Once displayed, it is not
input-capable. The command default is sent to the
CPP.
Example
OVRDBF ?*FILE(FILEA) ??TOFILE(&FILENAME) ??MBR(MBR1)
Above. You can see the from file name but not change it but both to file and
member may be changed.
| |
CLLE - Converting Iseries tables to CSV with one command.
Posted By: Jamie Flanary Contact |
/* Copy the temporary view to the incoming IFS file name. This com- */
/* mand assumes that the target IFS file is a CSV (comma separted */
/* variable" file and that it is to be converted to ASCII format. */
CPYTOIMPF FROMFILE(&FROMLIB/&FROMFILE) TOSTMF(&TOFILE) +
MBROPT(*ADD) STMFCODPAG(*PCASCII) +
RCDDLM(*CRLF)
| |
CLLE - CHGSPLFA command example
Posted By: jimmy octane Contact |
For example, to move all spool files with a form type of
INVOICE from printer output queue TXPR01 to output queue
NYPR05, you'd issue the following CHGSPLFA (Change Spool
File Attributes) command:
CHGSPLFA FILE(*SELECT) +
SELECT(*CURRENT TXPR01 INVOICE) +
OUTQ(NYPR05)
The following spool file commands provide a FILE(*SELECT)
option:
CHGSPLFA
DLTSPLF (Delete Spooled File)
HLDSPLF (Hold Spooled File)
RLSSPLF (Release Spooled File)
| |
CLLE - Reading a file with CLP
Posted By: JimmyOctane Contact |
/*------------------------------------------------------------*/
/* */
/* List all members in a source file and Read through */
/* the list using CLP. Then count them-why ask why???? */
/* */
/*------------------------------------------------------------*/
PGM
/*----------------------------------------*/
/* Declare vaiable count and the file */
/* we use IBM supplied file QAFDMBRL */
/* because our file */
/* will only exist in QTEMP and when you */
/* go to recompile this later you will */
/* need it. */
/*----------------------------------------*/
DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0)
DCL VAR(&CHRCOUNT) TYPE(*CHAR) LEN(5)
DCLF FILE(QAFDMBRL)
/*----------------------------------------*/
/* List all members in the IBM source */
/* file QSYSINC/QRPGLESRC. */
/*----------------------------------------*/
DSPFD FILE(QSYSINC/QRPGLESRC) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/WORKFILE)
/*----------------------------------------*/
/* Override to our file in QTEMP */
/*----------------------------------------*/
OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/WORKFILE)
/*----------------------------------------*/
/* RCVF = Read */
/* Monitor for end of file message. */
/*----------------------------------------*/
LOOP: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EXIT))
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
CHGVAR VAR(&CHRCOUNT) VALUE(&COUNT)
/*----------------------------------------*/
/* Go back and read another record */
/*----------------------------------------*/
GOTO CMDLBL(LOOP)
/*----------------------------------------*/
/* Display the final count and leave */
/*----------------------------------------*/
EXIT: SNDPGMMSG MSG('The total members in source file +
QSYSINC/QRPGLESR is :' || &CHRCOUNT)
DLTOVR FILE(*ALL)
ENDPGM
| |
CLLE - Calling CGI program with STRPCCMD
Posted By: Mike Haston Contact |
PGM PARM(&FILE &JOB &USER &NBR &SPLNBR &TITLE)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&NBR) TYPE(*CHAR) LEN(6)
DCL VAR(&SPLNBR) TYPE(*CHAR) LEN(10)
DCL VAR(&TITLE) TYPE(*CHAR) LEN(25)
DCL VAR(&SYSNAME) TYPE(*CHAR) LEN(8)
DCL VAR(&MBR) TYPE(*CHAR) LEN(10) VALUE('M')
DCL VAR(&PCCMD) TYPE(*CHAR) LEN(256)
DCL VAR(&START) TYPE(*CHAR) LEN(256) +
VALUE('Start http://')
DCL VAR(&IP) TYPE(*CHAR) LEN(25)
DCL VAR(&BINPGM) TYPE(*CHAR) LEN(256) +
VALUE('/cgi-bin/igz106r2?member=')
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(07)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
/********************************************************************/
RTVNETA SYSNAME(&SYSNAME)
PING RMTSYS(&SYSNAME)
RCV1:
RCVMSG MSGTYPE(*LAST) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF COND(&MSGID *EQ ' ') THEN(GOTO CMDLBL(RCV10))
IF COND(&MSGID *EQ 'TCP3203') THEN(DO)
CHGVAR VAR(&IP) VALUE(%SST(&MSGDTA 25 15))
GOTO CMDLBL(RCV10)
ENDDO
GOTO CMDLBL(RCV1)
RCV10:
/********************************************************************/
CLRPFM FILE(IGZ106W2)
MONMSG MSGID(CPF9999)
ADDLIBLE LIB(AS400CGI)
MONMSG MSGID(CPF9999)
IF (&TITLE *EQ *BLANKS) DO
CHGVAR VAR(&TITLE) VALUE(&FILE)
ENDDO
CHGVAR VAR(&MBR) VALUE(&MBR *TCAT &NBR)
RMVM FILE(IGZ106W2) MBR(&MBR)
MONMSG MSGID(CPF0000)
ADDPFM FILE(IGZ106W2) MBR(&MBR)
OVRDBF FILE(IGZ106W2) TOFILE(IGZ106W2) MBR(&MBR)
CVTSPLFHTM FILE(&FILE) JOBNAM(&JOB) USER(&USER) +
JOBNBR(&NBR) SPLNBR(&SPLNBR) TITLE(&TITLE)
CPYF FROMFILE(IGZ106W2) TOFILE(AS400CGI/IGZ106W2) +
FROMMBR(&MBR) TOMBR(&MBR) +
MBROPT(*REPLACE) CRTFILE(*NO) FMTOPT(*NOCHK)
MONMSG MSGID(CPF9999)
OVRDBF FILE(IGZ106W2) TOFILE(AS400CGI/IGZ106W2) +
MBR(&MBR)
CHGVAR VAR(&PCCMD) VALUE(&START *TCAT &IP *TCAT +
&BINPGM *TCAT &MBR)
STRPCO
MONMSG MSGID(IWS4010)
STRPCCMD PCCMD(&PCCMD) PAUSE(*NO)
DLTOVR FILE(*ALL)
RMVM FILE(IGZ106W2) MBR(&MBR)
MONMSG MSGID(CPF0000)
RMVM FILE(AS400CGI/IGZ106W2) MBR(&MBR)
MONMSG MSGID(CPF0000)
RMVLIBLE LIB(AS400CGI)
MONMSG MSGID(CPF9999)
ENDPGM
| |
CLLE - Using SQL Command from a CL program
Posted By: Mohd Frahim Contact |
I don't know if this is a very small thing which I am posting but i found it
very usefull...so thought of sharing this 3 line code which can be used
advancely depending on the requirements.
Create a text file in some SRCPF and write the SQL commands which need to be
executed.Then use the CL command RUNSQLSTM as displayed in the below example.
PGM
/* THERE IS A TEXT FILE IN LIBRARY/QDDSSRC WHERE I */
/* HAD WRITTEN THE SQL CODE TO BE EXECUTED */
/* The name of the text file is TXT1 and i had written */
/* update LIBRARY/TESTFILE set fld1 = 10 */
/* TESTFILE is the file which will be updated
*/
RUNSQLSTM SRCFILE(WRKLIBMXF/QDDSSRC) SRCMBR(TXT1) +
COMMIT(*NONE)
ENDPGM
| |
CLLE - Check status of subsytem CLLE
Posted By: Herman Van der Staey Contact |
/* Program : RTVSBSSTS */
/* System : iSeries */
/* Author : Herman Van der Staey */
/* */
/* Description : Retrieve subsystem status */
/* */
/* &SBSNAME : Input parameter : Subsystem name */
/* &STATUS : Output parameter : *ACTIVE or *INACTIVE */
RTVSBSSTS: PGM PARM(&SBSNAME &STATUS)
/* subsystem name */
DCL VAR(&SBSNAME) TYPE(*CHAR) LEN(10)
/* subsystem status : *ACTIVE or *INACTIVE */
DCL VAR(&STATUS) TYPE(*CHAR) LEN(10)
/* subsystem library */
DCL VAR(&SBSLIB) TYPE(*CHAR) LEN(10) VALUE(*LIBL)
/* qualified substem name */
DCL VAR(&SBSQUAL) TYPE(*CHAR) LEN(20)
DCL VAR(&RECEIVER) TYPE(*CHAR) LEN(100)
DCL VAR(&RCV_LEN) TYPE(*CHAR) LEN(4)
CHGVAR VAR(%BIN(&RCV_LEN)) VALUE(100)
CHGVAR VAR(&SBSQUAL) VALUE(&SBSNAME *CAT &SBSLIB)
CALL PGM(QWDRSBSD) PARM(&RECEIVER &RCV_LEN +
'SBSI0100' &SBSQUAL X'00000000')
CHGVAR VAR(&STATUS) VALUE(%SST(&RECEIVER 29 10))
SNDPGMMSG MSG(&STATUS)
END: ENDPGM
| |
CLLE - Use API -QSZRTVPR - get system version
Posted By: George Altoon Contact |
PGM
DCL &RELEASE *CHAR 6
DCL &RCVR *CHAR 128
DCL &RCVRLEN *CHAR 4 VALUE(X'00000080')
DCL &FORMAT *CHAR 8 VALUE('PRDR0100')
DCL &PRDINFO *CHAR 27 VALUE('*OPSYS *CUR 0000*CODE ')
DCL &ERRCODE *CHAR 4 VALUE(X'00000000')
CALL QSYS/QSZRTVPR PARM(&RCVR &RCVRLEN &FORMAT &PRDINFO &ERRCODE)
CHGVAR &RELEASE (%SST(&RCVR 20 6))
SNDPGMMSG MSG('This system is at release' |> &RELEASE)
ENDPGM
| |
CLLE - retrieve streamfile size QHFGETSZ
Posted By: JimmyOctane Contact |
RETRIEVE AN IFS STREAM FILE'S SIZE
The RTVOBJD (Retrieve Object Description) command lets you retrieve the size of an
object in the QSYS.LIB file system. However, no similar command exists for retrieving
the size of a stream file.
You can use the CL code shown below in a program to retrieve the size of a stream file
in the AS/400 integrated file system (IFS). The variable &PATH contains the path to the
stream file, such as '/MYDIR/MYSUBDIR/FILE.EXT' or
'/QDLS/MYFOLDER/MYDOC.EXT', and the size is returned in the variable &SIZEDEC.
DCL VAR(&PATH) TYPE(*CHAR) LEN(128)
DCL VAR(&SIZEDEC) TYPE(*DEC) LEN(15 0)
DCL VAR(&HANDLE) TYPE(*CHAR) LEN(16)
DCL VAR(&SIZEBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&PATHLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&ATTRTAB) TYPE(*CHAR) LEN(10)
DCL VAR(&ATTRLEN) TYPE(*CHAR) LEN(4)
CHGVAR VAR(%BIN(&PATHLEN)) VALUE(128)
CHGVAR VAR(%BIN(&ATTRLEN)) VALUE(10)
CALL PGM(QHFOPNSF) PARM(&HANDLE &PATH &PATHLEN +
'100 100 ' &ATTRTAB &ATTRLEN ' ' +
X'00000000') /* Open stream file */
CALL PGM(QHFGETSZ) PARM(&HANDLE &SIZEBIN +
X'00000000') /* Get stream file size */
CALL PGM(QHFCLOSF) PARM(&HANDLE X'00000000') /* +
Close stream file */
/* Retrieve the STMF size in decimal (15,0) */
CHGVAR VAR(&SIZEDEC) VALUE(%BIN(&SIZEBIN))
| |
CLLE - DSPDEVU (2/8) : DISPLAY ALL USER'S ACTIVE SCREEN
Posted By: bossé yvain Contact |
/* LISTE DES SOURCES : *+
** DSPDEVU CMD *+
** DSPDEVUC CLP *+
** DSPDEVUD CLP *+
** DSPDEVUE DSPF *+
** DSPDEVUM CLP *+
** DSPDEVUS RPGLE *+
** QPDSPAJBL1 LF *+
** QPDSPAJBP PF *+
**˜***************************************************************************+
**˜ **+
**˜ Fichier CL : DSPDEVUC **+
**˜ Description : AFFICHE LES ECRANS ACTIFS D'UN UTILISATEUR **+
**˜ OU SORTIE FICHIER SELON MODE CHOISI **+
**˜ **+
**˜ DISPLAY ALL USER'S SCREEN IN ACTIVITY OR MAKE **+
**˜ A OUTFILE **+
**˜ **+
**˜ **+
**˜ Crée par : Yvain BOSSE (ATLANTE INFORMATIQUE) **+
**˜ Date : XX/09/2004 **+
**˜ EMAIL : Professionnel : ybosse@wanadoo.fr **+
**˜ Personnel : ybosse@free.fr **+
**˜ **+
**˜------------------------------------------------------------------------ **+
**‚ Modification **+
**‚ **+
**‚ Date Description **+
**‚ ----- ----------- **+
**‚ **+
******************************************************************************/
PGM PARM(&USER &SBSJOB &OUTFILE &BIBOUT &MODE)
DCL &USER *CHAR LEN(10)
DCL &SBSJOB *CHAR LEN(10)
DCL &BIBOUT *CHAR LEN(10)
DCL &OUTFILE *CHAR LEN(10)
DCL &MODE *CHAR LEN(10)
DCL &LIB *CHAR LEN(10)
DCL &JOB___10 *CHAR LEN(10)
DCL &USER__10 *CHAR LEN(10)
DCL &NBRJOB_6 *CHAR LEN(6)
DCL &QRY *CHAR LEN(150)
DCL &F5 *CHAR LEN(1)
DCL &ERRORSW *LGL /* STD ERR */
DCL &MSGID *CHAR LEN(7) /* STD ERR */
DCL &MSGDTA *CHAR LEN(100) /* STD ERR */
DCL &MSGF *CHAR LEN(10) /* STD ERR */
DCL &MSGFLIB *CHAR LEN(10) /* STD ERR */
MONMSG MSGID(CPF0000) EXEC(GOTO +
CMDLBL(STDERR1)) /* STD ERR */
RTVJOBA JOB(&JOB___10) +
USER(&USER__10) +
NBR(&NBRJOB_6)
CLOF OPNID(WPDSPAJB)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/WPDSPAJBP)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/QPDSPAJB*)
MONMSG MSGID(CPF0000)
RTVOBJD OBJ(QPDSPAJBP) OBJTYPE(*FILE) RTNLIB(&LIB)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(QTEMP) NEWOBJ(WPDSPAJBP)
/*š*************************************************************************§€*/
/*š*** CONTROLE SI PARM FICHIER RENSEIGNE ***§€*/
/*š*************************************************************************§€*/
IF COND(&OUTFILE *NE '*DFT') THEN(DO)
IF COND(&BIBOUT *EQ '*DFT') THEN(DO)
RTVOBJD OBJ(*LIBL/&OUTFILE) OBJTYPE(*FILE) +
RTNLIB(&BIBOUT)
MONMSG MSGID(CPF9812) EXEC(DO)
SNDPGMMSG MSG('Le fichier n''a pas été trouvé')
GOTO FIN
ENDDO
ENDDO
IF COND(&MODE *EQ '*NEW') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
ENDDO
CLRPFM FILE(&BIBOUT/&OUTFILE)
ENDDO
IF COND(&MODE *EQ '*REP') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
ENDDO
CLRPFM FILE(&BIBOUT/&OUTFILE)
ENDDO
IF COND(&MODE *EQ '*ADD') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
ENDDO
ENDDO
CHGVAR VAR(&QRY) VALUE('QUSER *EQ "' *CAT &USER__10 +
*CAT '"')
IF COND(&USER *NE ' ') THEN(DO)
CHGVAR VAR(&QRY) VALUE('QUSER *EQ "' *CAT &USER *CAT '"')
ENDDO
WRKACTJOB OUTPUT(*PRINT) SBS(&SBSJOB)
CPYSPLF FILE(QPDSPAJB) TOFILE(QTEMP/WPDSPAJBP) +
JOB(&NBRJOB_6/&USER__10/&JOB___10) +
SPLNBR(*LAST)
DLTSPLF FILE(QPDSPAJB) JOB(&NBRJOB_6/&USER__10/&JOB___10)
IF COND(&USER *EQ '*ALL') THEN(DO)
CHGVAR VAR(&QRY) VALUE('QUSER *NE " " *AND QVIDE1 *EQ " "')
OPNQRYF FILE((QTEMP/WPDSPAJBP)) QRYSLT(&QRY) +
IGNDECERR(*YES) OPNID(WPDSPAJB)
GOTO CPY1
ENDDO
OPNQRYF FILE((QTEMP/WPDSPAJBP)) QRYSLT(&QRY) +
IGNDECERR(*YES) OPNID(WPDSPAJB)
CPY1:
CPYFRMQRYF FROMOPNID(WPDSPAJB) TOFILE(&BIBOUT/&OUTFILE) +
MBROPT(*ADD)
MONMSG MSGID(CPF3370)
CLOF OPNID(WPDSPAJB)
DLTF FILE(QTEMP/WPDSPAJBP)
GOTO FIN
ENDDO
/*š*************************************************************************§€*/
/*š*** CONTROLE PARM BIBLIOTHEQUE RENSEIGNEE ***§€*/
/*š*************************************************************************§€*/
IF COND(&BIBOUT *NE '*DFT') THEN(DO)
IF COND(&OUTFILE *EQ '*DFT') THEN(DO)
RTVOBJD OBJ(&BIBOUT/QPDSPAJBP) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CHGVAR VAR(&OUTFILE) VALUE('QPDSPAJBP')
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
SNDPGMMSG MSG('Le fichier QPDSPAJBP a été genere dans ' +
*CAT &BIBOUT)
ENDDO
ENDDO
IF COND(&MODE *EQ '*NEW') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
ENDDO
CLRPFM FILE(&BIBOUT/&OUTFILE)
ENDDO
IF COND(&MODE *EQ '*REP') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
ENDDO
CLRPFM FILE(&BIBOUT/&OUTFILE)
ENDDO
IF COND(&MODE *EQ '*ADD') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJBP) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT) NEWOBJ(&OUTFILE)
ENDDO
ENDDO
CHGVAR VAR(&QRY) VALUE('QUSER *EQ "' *CAT &USER__10 +
*CAT '"')
IF COND(&USER *NE ' ') THEN(DO)
CHGVAR VAR(&QRY) VALUE('QUSER *EQ "' *CAT &USER *CAT '"')
ENDDO
WRKACTJOB OUTPUT(*PRINT) SBS(&SBSJOB)
CPYSPLF FILE(QPDSPAJB) TOFILE(QTEMP/WPDSPAJBP) +
JOB(&NBRJOB_6/&USER__10/&JOB___10) +
SPLNBR(*LAST)
DLTSPLF FILE(QPDSPAJB) JOB(&NBRJOB_6/&USER__10/&JOB___10)
IF COND(&USER *EQ '*ALL') THEN(DO)
CHGVAR VAR(&QRY) VALUE('QUSER *NE " " *AND QVIDE1 *EQ " "')
OPNQRYF FILE((QTEMP/WPDSPAJBP)) QRYSLT(&QRY) +
IGNDECERR(*YES) OPNID(WPDSPAJB)
GOTO CPY2
ENDDO
OPNQRYF FILE((QTEMP/WPDSPAJBP)) QRYSLT(&QRY) +
IGNDECERR(*YES) OPNID(WPDSPAJB)
CPY2:
CPYFRMQRYF FROMOPNID(WPDSPAJB) TOFILE(&BIBOUT/&OUTFILE) +
MBROPT(*ADD)
MONMSG MSGID(CPF3370)
CLOF OPNID(WPDSPAJB)
DLTF FILE(QTEMP/WPDSPAJBP)
GOTO FIN
ENDDO
/*š*************************************************************************§€*/
/*š*** CONTROLE PARM MODE RENSEIGNE ***§€*/
/*š*************************************************************************§€*/
REFRESH:
RTVOBJD OBJ(*LIBL/QPDSPAJBP) OBJTYPE(*FILE) +
RTNLIB(&LIB)
CHGVAR VAR(&OUTFILE) VALUE('QPDSPAJBP')
CHGVAR VAR(&BIBOUT) VALUE('QTEMP')
RTVOBJD OBJ(QTEMP/QPDSPAJBL1) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
DLTF FILE(QTEMP/QPDSPAJB*)
MONMSG MSGID(CPF0000)
ENDDO
IF COND(&MODE *EQ '*NEW') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJB*) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT)
ENDDO
CLRPFM FILE(&BIBOUT/&OUTFILE)
ENDDO
IF COND(&MODE *EQ '*REP') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJB*) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT)
ENDDO
CLRPFM FILE(&BIBOUT/&OUTFILE)
ENDDO
IF COND(&MODE *EQ '*ADD') THEN(DO)
RTVOBJD OBJ(&BIBOUT/&OUTFILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9812) EXEC(DO)
CRTDUPOBJ OBJ(QPDSPAJB*) FROMLIB(&LIB) OBJTYPE(*FILE) +
TOLIB(&BIBOUT)
ENDDO
ENDDO
CHGVAR VAR(&QRY) VALUE('QUSER *EQ "' *CAT &USER__10 +
*CAT '"')
IF COND(&USER *NE ' ') THEN(DO)
CHGVAR VAR(&QRY) VALUE('QUSER *EQ "' *CAT &USER *CAT '"')
ENDDO
WRKACTJOB OUTPUT(*PRINT) SBS(&SBSJOB)
CPYSPLF FILE(QPDSPAJB) TOFILE(QTEMP/WPDSPAJBP) +
JOB(&NBRJOB_6/&USER__10/&JOB___10) +
SPLNBR(*LAST)
DLTSPLF FILE(QPDSPAJB) JOB(&NBRJOB_6/&USER__10/&JOB___10)
IF COND(&USER *EQ '*ALL') THEN(DO)
CHGVAR VAR(&QRY) VALUE('QUSER *NE " " *AND QVIDE1 *EQ " "')
OPNQRYF FILE((QTEMP/WPDSPAJBP)) QRYSLT(&QRY) +
IGNDECERR(*YES) OPNID(WPDSPAJB)
GOTO CPY3
ENDDO
OPNQRYF FILE((QTEMP/WPDSPAJBP)) QRYSLT(&QRY) +
IGNDECERR(*YES) OPNID(WPDSPAJB)
CPY3:
CPYFRMQRYF FROMOPNID(WPDSPAJB) TOFILE(QTEMP/QPDSPAJBP) +
MBROPT(*ADD)
MONMSG MSGID(CPF3370)
CLOF OPNID(WPDSPAJB)
OVRDBF FILE(QPDSPAJBP) TOFILE(QTEMP/QPDSPAJBP)
OVRDBF FILE(QPDSPAJBL1) TOFILE(QTEMP/QPDSPAJBL1)
CHGVAR VAR(&F5) VALUE('0')
CALL PGM(DSPDEVUS) PARM(&F5)
DLTOVR FILE(*ALL)
IF COND(&F5 *EQ '1') THEN(GOTO REFRESH)
DLTF FILE(QTEMP/WPDSPAJBP)
GOTO FIN
/*ˆ##########################################################################*/
/*ˆ##########################################################################*/
STDERR1: /* STANDARD ERROR HANDLING ROUTINE */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* FUNC CHK */
CHGVAR &ERRORSW '1' /* SET TO FAIL IR ERROR OCCURS */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* LOOP BACK FOR ADDL DIAGNOSTICS */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
FIN:
ENDPGM
| |
CLLE - DSPDEVU (3/8) : DISPLAY ALL USER'S ACTIVE SCREEN
Posted By: bossé yvain Contact |
/* LISTE DES SOURCES : *+
** DSPDEVU CMD *+
** DSPDEVUC CLP *+
** DSPDEVUD CLP *+
** DSPDEVUE DSPF *+
** DSPDEVUM CLP *+
** DSPDEVUS RPGLE *+
** QPDSPAJBL1 LF *+
** QPDSPAJBP PF *+
**˜***************************************************************************+
**˜ **+
**˜ Fichier CL : DSPDEVUD **+
**˜ Description : AFFICHE LES ECRANS ACTIFS D'UN UTILISATEUR **+
**˜ OU SORTIE FICHIER SELON MODE CHOISI **+
**˜ **+
**˜ DISPLAY ALL USER'S SCREEN IN ACTIVITY OR MAKE **+
**˜ A OUTFILE **+
**˜ **+
**˜ **+
**˜ Crée par : Yvain BOSSE (ATLANTE INFORMATIQUE) **+
**˜ Date : XX/09/2004 **+
**˜ EMAIL : Professionnel : ybosse@wanadoo.fr **+
**˜ Personnel : ybosse@free.fr **+
**˜ **+
**˜------------------------------------------------------------------------ **+
**‚ Modification **+
**‚ **+
**‚ Date Description **+
**‚ ----- ----------- **+
**‚ **+
******************************************************************************/
PGM PARM(&USER &JOB &NUMJOB)
DCL &USER *CHAR LEN(10)
DCL &JOB *CHAR LEN(10)
DCL &NUMJOB *CHAR LEN(6)
DCL &ERRORSW *LGL /* STD ERR */
DCL &MSGID *CHAR LEN(7) /* STD ERR */
DCL &MSGDTA *CHAR LEN(100) /* STD ERR */
DCL &MSGF *CHAR LEN(10) /* STD ERR */
DCL &MSGFLIB *CHAR LEN(10) /* STD ERR */
MONMSG MSGID(CPF0000) EXEC(GOTO +
CMDLBL(STDERR1)) /* STD ERR */
WRKJOB JOB(&NUMJOB/&USER/&JOB)
GOTO FIN
/*ˆ##########################################################################*/
/*ˆ##########################################################################*/
STDERR1: /* STANDARD ERROR HANDLING ROUTINE */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* FUNC CHK */
CHGVAR &ERRORSW '1' /* SET TO FAIL IR ERROR OCCURS */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* LOOP BACK FOR ADDL DIAGNOSTICS */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
FIN:
ENDPGM
| |
CLLE - DSPDEVU (5/8) : DISPLAY ALL USER'S ACTIVE SCREEN
Posted By: bossé yvain Contact |
/* LISTE DES SOURCES : *+
** DSPDEVU CMD *+
** DSPDEVUC CLP *+
** DSPDEVUD CLP *+
** DSPDEVUE DSPF *+
** DSPDEVUM CLP *+
** DSPDEVUS RPGLE *+
** QPDSPAJBL1 LF *+
** QPDSPAJBP PF *+
**˜***************************************************************************+
**˜ **+
**˜ Fichier CL : DSPDEVUM **+
**˜ Description : ENVOI UN MESSAGE A L'UTILISATEUR **+
**˜ **+
**˜ SEND BREACK MESSAGE TO THE USER **+
**˜ **+
**˜ Crée par : Yvain BOSSE (ATLANTE INFORMATIQUE) **+
**˜ Date : XX/09/2004 **+
**˜ EMAIL : Professionnel : ybosse@wanadoo.fr **+
**˜ Personnel : ybosse@free.fr **+
**˜ **+
**˜------------------------------------------------------------------------ **+
**‚ Modification **+
**‚ **+
**‚ Date Description **+
**‚ ----- ----------- **+
**‚ **+
******************************************************************************/
PGM PARM(&JOB)
DCL &JOB *CHAR LEN(10)
DCL &ERRORSW *LGL /* STD ERR */
DCL &MSGID *CHAR LEN(7) /* STD ERR */
DCL &MSGDTA *CHAR LEN(100) /* STD ERR */
DCL &MSGF *CHAR LEN(10) /* STD ERR */
DCL &MSGFLIB *CHAR LEN(10) /* STD ERR */
MONMSG MSGID(CPF0000) EXEC(GOTO +
CMDLBL(STDERR1)) /* STD ERR */
? SNDBRKMSG ??MSG('mettez votre message ici') +
TOMSGQ(&JOB)
MONMSG MSGID(CPF6801)
GOTO FIN
/*ˆ##########################################################################*/
/*ˆ##########################################################################*/
STDERR1: /* STANDARD ERROR HANDLING ROUTINE */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* FUNC CHK */
CHGVAR &ERRORSW '1' /* SET TO FAIL IR ERROR OCCURS */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* LOOP BACK FOR ADDL DIAGNOSTICS */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
FIN:
ENDPGM
| |
CLLE - retrieve the size of an IFS table
Posted By: jimmy octane Contact |
Figure 5 - CL code that retrieves an IFS stream file’s size
DCL VAR(&PATH) TYPE(*CHAR) LEN(128)
DCL VAR(&SIZEDEC) TYPE(*DEC) LEN(15 0)
DCL VAR(&HANDLE) TYPE(*CHAR) LEN(16)
DCL VAR(&SIZEBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&PATHLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&ATTRTAB) TYPE(*CHAR) LEN(10)
DCL VAR(&ATTRLEN) TYPE(*CHAR) LEN(4)
CHGVAR VAR(%BIN(&PATHLEN)) VALUE(128)
CHGVAR VAR(%BIN(&ATTRLEN)) VALUE(10)
CALL PGM(QHFOPNSF) PARM(&HANDLE &PATH &PATHLEN +
'100 100 ' &ATTRTAB &ATTRLEN ' ' +
X'00000000') /* Open stream file */
CALL PGM(QHFGETSZ) PARM(&HANDLE &SIZEBIN +
X'00000000') /* Get stream file size */
CALL PGM(QHFCLOSF) PARM(&HANDLE X'00000000') /* +
Close stream file */
/* Retrieve the STMF size in decimal (15,0) */
CHGVAR VAR(&SIZEDEC) VALUE(%BIN(&SIZEBIN))
| |
CLLE - To get record count for all the PF's in library
Posted By: Nanda Kishore Perisetla Contact |
START: PGM PARM(&LIB)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&PGM) TYPE(*CHAR) LEN(10)
DCL VAR(&CNT) TYPE(*DEC) LEN(10)
DCLF FILE(CNTFILE)
DLTF FILE(QTEMP/COUNTF)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/RECCNT)
MONMSG MSGID(CPF0000)
CRTPF FILE(QTEMP/COUNTF) LVLCHK(*NO)
MONMSG MSGID(CPF7302)
DSPOBJD OBJ(&LIB/*ALL) OBJTYPE(*FILE) DETAIL(*FULL) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/CNTFILE)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(EOF))
LOOP: RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))
OVRDBF FILE(RECCNT) SHARE(*YES)
IF COND((&ODOBAT *EQ 'PF') *OR (&ODOBAT *EQ +
'PF38')) THEN(DO)
DSPFD FILE(&LIB/&ODOBNM) TYPE(*MBR) +
OUTPUT(*OUTFILE) FILEATR(*ALL) +
OUTFILE(QTEMP/RECCNT) OUTMBR(*FIRST *ADD)
MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(EOF))
ENDDO
GOTO LOOP
EOF: DLTOVR FILE(RECCNT)
CALL PGM(*LIBL/RCDCNTRPG)
END: ENDPGM
| |
CLLE - thank for you help
Posted By: WENGZHANGLIN Contact |
I'm a beginner
| |
CLLE - Automatically Adjust System Time for Daylight Savings Time
Posted By: Les Contact |
CL
0001.00 PGM
0002.00 DCL &MONTH *CHAR 2
0003.00 DCL &DAY *CHAR 2
0004.00 DCL &HOUR *CHAR 2
0005.00 DCL &HOUR# *DEC (2 0)
0006.00
0007.00 RTVSYSVAL QMONTH &MONTH
0008.00 RTVSYSVAL QDAY &DAY
0009.00 RTVSYSVAL QHOUR &HOUR
0010.00
0011.00 CHGVAR &HOUR# &HOUR
0012.00
0013.00 APRIL: IF COND(&MONTH = '04' *AND &DAY < '08') +
0014.00 THEN(DO)
0015.00 CHGVAR VAR(&HOUR#) VALUE(&HOUR# +1)
0016.00 RTVSYSVAL QHOUR &HOUR
0017.00 SNDMSG MSG('Time set ahead 1 hour to ' || &HOUR +
0018.00 *TCAT '.') TOUSR(KUAL)
0019.00 SNDMSG MSG('Hour set ahead 1 hour +
0020.00 to ' || &HOUR *TCAT '.') TOUSR(ODAY)
0021.00 ENDDO
0022.00 ELSE
0023.00 SNDMSG MSG('Hour still set to ' +
0024.00 || &HOUR *TCAT '.') TOUSR(KUAL)
0025.00 OCTOBER: IF COND(&MONTH = '10' *AND &DAY > '30') THEN(DO)
0026.00 CHGVAR VAR(&HOUR#) VALUE(&HOUR# -1)
0027.00 RTVSYSVAL QHOUR &HOUR
0028.00 SNDMSG MSG('Hour set back 1 hour +
0029.00 to ' || &HOUR *TCAT '.') TOUSR(KUAL)
0030.00 ENDDO
0031.00 ELSE
0032.00 SNDMSG MSG('Hour still set to ' +
0033.00 || &HOUR *TCAT '.') TOUSR(KUAL)
0034.00 CHGVAR &HOUR &HOUR#
0035.00 CHGSYSVAL QHOUR &HOUR
0036.00 ENDPGM
Job Scheduled Entry
Next
-----Schedule------ Recovery Submit
Opt Job Status Date Time Frequency Action Date
AUTO_DST SCD *SUN 02:00:00 *MONTHLY *SBMRLS 07/03/05
Details
Job name . . . . . . . . . . . . > AUTO_DST Name
Entry number . . . . . . . . . . > 000156 000001-999999, *ONLY
Command to run . . . . . . . . . CALL PGM(QGPL/DAYSAVTIM)
Frequency . . . . . . . . . . . *MONTHLY *SAME, *ONCE, *WEEKLY...
Schedule date, or . . . . . . . *NONE Date, *SAME, *CURRENT...
Schedule day . . . . . . . . . . *SUN *SAME, *NONE, *ALL, *MON...
+ for more values
Schedule time . . . . . . . . . '02:00:00' Time, *SAME, *CURRENT
| |
CLLE - Display License Information
Posted By: bob cozzi Contact |
DSPLICINF: PGM
/*************************************************************/
/** Display software license information **/
/** (c) Copyright 2005 - Robert Cozzi, Jr. **/
/** Unrestricted license to use this software granted to **/
/** the public. **/
/** No warranty is express or implied, and none is given. **/
/*************************************************************/
DCL VAR(&LICPGM) TYPE(*CHAR) LEN(16)
DCL VAR(&RTNDATA) TYPE(*CHAR) LEN(64)
DCL VAR(&RCVLEN) TYPE(*DEC) LEN(7) VALUE(64)
DCL VAR(&RTNLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&MODEL) TYPE(*CHAR) LEN(4)
DCL VAR(&SERIAL) TYPE(*CHAR) LEN(8)
DCL VAR(&RELLVL) TYPE(*CHAR) LEN(6)
DCL VAR(&CPFVER) TYPE(*CHAR) LEN(9)
DCL VAR(&PRODINFO) TYPE(*CHAR) LEN(17) +
VALUE('5769SS1*ONLY 5050')
DCL VAR(&LICINFO) TYPE(*CHAR) LEN(8) +
VALUE('LICP0100')
DCL VAR(&APIFMT) TYPE(*CHAR) LEN(8) +
VALUE('LICR0200')
DCL VAR(&APIERRORDS) TYPE(*CHAR) LEN(16) +
VALUE(X'0000000000000000')
DCL VAR(&PROCGRP) TYPE(*CHAR) LEN(4)
MONMSG MSGID(CPF0000)
/* Convert the return buffer length to INT4 */
NOTE1: CHGVAR VAR(%BIN(&RTNLEN)) VALUE(&RCVLEN)
RTVOBJD OBJ(QCMD) OBJTYPE(*PGM) SYSLVL(&CPFVER) +
LICPGM(&LICPGM)
CHGVAR VAR(%SST(&PRODINFO 1 7)) VALUE(%SST(&LICPGM +
1 7))
CHGVAR &RELLVL value(%SST(&CPFVER 1 1) *TCAT +
%sst(&CPFVER 3 1) *TCAT +
%SST(&CPFVER 4 1) *TCAT +
%SST(&CPFVER 6 1) *TCAT +
%SST(&CPFVER 7 1) *TCAT +
%SST(&CPFVER 9 1))
CHGVAR VAR(%SST(&PRODINFO 8 6)) VALUE(&RELLVL)
/* Retrieve the processor group and OS VxRxMx level */
NOTE2: CALL PGM(QLZARTV) PARM(&RTNDATA &RTNLEN &APIFMT +
&PRODINFO &LICINFO &APIERRORDS)
/* Extract the Processor Group */
NOTE3: CHGVAR VAR(&PROCGRP) VALUE(%SST(&RTNDATA 48 03))
/* Extract the OS/400 Version/Release/Modification Level */
NOTE4: CHGVAR VAR(&RELLVL) VALUE(%SST(&RTNDATA 27 06))
/* Get the Serial Number and Model Number */
NOTE5: RTVSYSVAL SYSVAL(QSRLNBR) RTNVAR(&SERIAL)
RTVSYSVAL SYSVAL(QMODEL ) RTNVAR(&MODEL)
/* Tell the end-user what was found. */
NOTE6: SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA(' Serial . . . . : ' *TCAT &SERIAL)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA(' Model . . . . : ' *TCAT &MODEL)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA(' Proc Group . . : ' *BCAT &PROCGRP)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA(' Ver Rel Mod . : ' *BCAT &RELLVL)
ENDPGM: ENDPGM
| |
CLLE - simple clle
Posted By: juby Contact |
*INT & *UINT */
/* Len of 2 & 4 supported */
/* OPM doesnt support 8-Byte intengers - use CLLE */
/* (use %INT instead of binary) */
/* */
/* Previous limit on max parameters */
/* PGM & TFRCTL = 40 */
/* CALL = 99 */
/* New limits */
/* PGM & TFRCTL = 255 */
/* CALL = 255 */
/*
| |
CLLE - i want the use and programs of DATAQ,OPENQRY,OVRDBF
Posted By: nivas jagtap Contact |
i want the use and programs of DATAQ,OPENQRY,OVRDBF
| |
CLLE - Change Owner Authority
Posted By: Venkat Contact |
Pgm Parm(&CurOwn &NewOwn)
DCLF FILE(file1)
DCL &CurOwn *Char 10
DCL &NewOwn *Char 10
DCL VAR(&OWNER) TYPE(*CHAR) LEN(10)
LOOP1: RCVF
MonMsg Cpf0864 Exec(GoTo Exit)
RTVOBJD OBJ(DPVENKATAR/&PRGNAM) OBJTYPE(*PGM) +
OWNER(&OWNER)
IF COND(&OWNER *EQ &CurOwn) THEN(DO)
ChgObjOwn Obj(DPVENKATAR/&PrgNam) ObjType(*Pgm) +
NewOwn(&NewOwn)
ENDDO
GoTo Loop1
EXIT: ENDPGM
| |
CLLE - Display a Digital Clock
Posted By: Kalpesh Patadia Contact |
5722WDS V5R2M0 020719 SEU SOURCE LISTING 10/30/06 20:57:13
SOURCE FILE . . . . . . . DEVNSK/QCLSRC
MEMBER . . . . . . . . . CLOCKC1
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
0200 /****************************************************************/
0300 /* Program Name . . . . : CLOCKC1 */
0400 /* Program Description. : This program displays a digital clock */
0600 /* : */
0700 /* Files Used . . . . . : *NONE */
0800 /* Files Overridden . . : *NONE */
0801 /* Files Declared . . . : CLOCKD1 - Screen for the Clock */
0900 /****************************************************************/
1000 /*Copyright (C) . . . . : XxxxxxX Xxxxxxxxxxxx, Xxxxxxxxx */
1100 /****************************************************************/
1200 /* Created by . . . . . : KALPESH PATADIA */
1300 /* Company. . . . . . . : XxxxxxX Xxxxxxxxxxxx, Xxxxxxxxx */
1400 /* Date . . . . . . . . : October 27, 2006 */
1500 /* Project ID . . . . . : XXXX9999 Marked . . : X9999 */
1600 /* Reason . . . . . . . : To display a digital clock with auto */
1700 /* : refresh. */
1800 /*--------------------------------------------------------------*/
1900 /****************************************************************/
2000 PGM
2100 /*--------------------------------------------------------------*/
2200 /* Declare Variables and Files */
2300 /*--------------------------------------------------------------*/
2301 DCLF FILE(CLOCKD1) RCDFMT(*ALL)
2302 /*--------------------------------------------------------------*/
2500 DCL VAR(&HOUR) TYPE(*CHAR) LEN(2) /* Hour +
2600 Component of the Time */
2700 DCL VAR(&MINUTE) TYPE(*CHAR) LEN(2) /* Minute +
2800 Component of the Time */
2900 DCL VAR(&SECOND) TYPE(*CHAR) LEN(2) /* Second +
3000 Component of the Time */
3100 DCL VAR(&CURDAT) TYPE(*CHAR) LEN(6) /* Current +
3200 Date */
3300 DCL VAR(&CURDAY) TYPE(*CHAR) LEN(4) /* Current +
3400 Day */
3403 /*--------------------------------------------------------------*/
3600 DCL VAR(&HRLFT) TYPE(*CHAR) LEN(1) /* Left Digit +
3700 of the Hour */
3800 DCL VAR(&HRRGT) TYPE(*CHAR) LEN(1) /* Right +
3900 Digit of the Hour */
4000 DCL VAR(&MINLFT) TYPE(*CHAR) LEN(1) /* Left +
4100 Digit of the Minute */
4200 DCL VAR(&MINRGT) TYPE(*CHAR) LEN(1) /* Right +
4300 Digit of the Minute */
4400 DCL VAR(&SECLFT) TYPE(*CHAR) LEN(1) /* Left +
4500 Digit of the Second */
4600 DCL VAR(&SECRGT) TYPE(*CHAR) LEN(1) /* Right +
4700 Digit of the Second */
4701 /*--------------------------------------------------------------*/
4900 /* MAIN LINE */
5000 /*--------------------------------------------------------------*/
"5100 RUN: /* Retrieve Current Date, Time and Day */"
5200 RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&HOUR)
5300 RTVSYSVAL SYSVAL(QMINUTE) RTNVAR(&MINUTE)
5400 RTVSYSVAL SYSVAL(QSECOND) RTNVAR(&SECOND)
5500 RTVSYSVAL SYSVAL(QDATE) RTNVAR(&CURDAT)
5600 RTVSYSVAL SYSVAL(QDAYOFWEEK) RTNVAR(&CURDAY)
5700 /*--------------------------------------------------------------*/
5800 /* Display Current Date And Day */
5900 /*--------------------------------------------------------------*/
6000 CVTDAT DATE(&CURDAT) TOVAR(&#CURDT) TOFMT(*DMYY) +
6100 TOSEP(/)
6200
6300 IF COND(&CURDAY = *SUN) THEN(CHGVAR +
6400 VAR(&#WKDAY) VALUE('Sunday'))
6500 IF COND(&CURDAY = *MON) THEN(CHGVAR +
6600 VAR(&#WKDAY) VALUE('Monday'))
6700 IF COND(&CURDAY = *TUE) THEN(CHGVAR +
6800 VAR(&#WKDAY) VALUE('Tuesday'))
6900 IF COND(&CURDAY = *WED) THEN(CHGVAR +
7000 VAR(&#WKDAY) VALUE('Wednesday'))
7100 IF COND(&CURDAY = *THU) THEN(CHGVAR +
7200 VAR(&#WKDAY) VALUE('Thursday'))
7300 IF COND(&CURDAY = *FRI) THEN(CHGVAR +
7400 VAR(&#WKDAY) VALUE('Friday'))
7500 IF COND(&CURDAY = *SAT) THEN(CHGVAR +
7600 VAR(&#WKDAY) VALUE('Saturday'))
7700 /*--------------------------------------------------------------*/
7800 /* Display Current Time */
7900 /*--------------------------------------------------------------*/
8000 CHGVAR VAR(&HRLFT) VALUE(%SST(&HOUR 1 1))
8100 CHGVAR VAR(&HRRGT) VALUE(%SST(&HOUR 2 1))
8200
8300 CHGVAR VAR(&MINLFT) VALUE(%SST(&MINUTE 1 1))
8400 CHGVAR VAR(&MINRGT) VALUE(%SST(&MINUTE 2 1))
8500
8600 CHGVAR VAR(&SECLFT) VALUE(%SST(&SECOND 1 1))
8700 CHGVAR VAR(&SECRGT) VALUE(%SST(&SECOND 2 1))
8800 /*--------------------------------------------------------------*/
8900 /* Display Left Digit of the Hour */
9000 /*--------------------------------------------------------------*/
9100 IF COND(&HRLFT *EQ '1') THEN(CHGVAR VAR(&IN11) +
9200 VALUE('1'))
9201
9300 IF COND(&HRLFT *EQ '2') THEN(CHGVAR VAR(&IN12) +
9400 VALUE('1'))
9500 /*--------------------------------------------------------------*/
9600 /* Display Right Digit of the Hour */
9700 /*--------------------------------------------------------------*/
9800 IF COND(&HRRGT *EQ '0') THEN(CHGVAR VAR(&IN20) +
9900 VALUE('1'))
10000
10100 IF COND(&HRRGT *EQ '1') THEN(CHGVAR VAR(&IN21) +
10200 VALUE('1'))
10300
10400 IF COND(&HRRGT *EQ '2') THEN(CHGVAR VAR(&IN22) +
10500 VALUE('1'))
10600
10700 IF COND(&HRRGT *EQ '3') THEN(CHGVAR VAR(&IN23) +
10800 VALUE('1'))
10900
11000 IF COND(&HRRGT *EQ '4') THEN(CHGVAR VAR(&IN24) +
11100 VALUE('1'))
11200
11300 IF COND(&HRRGT *EQ '5') THEN(CHGVAR VAR(&IN25) +
11400 VALUE('1'))
11500
11600 IF COND(&HRRGT *EQ '6') THEN(CHGVAR VAR(&IN26) +
11700 VALUE('1'))
11800
11900 IF COND(&HRRGT *EQ '7') THEN(CHGVAR VAR(&IN27) +
12000 VALUE('1'))
12100
12200 IF COND(&HRRGT *EQ '8') THEN(CHGVAR VAR(&IN28) +
12300 VALUE('1'))
12400
12500 IF COND(&HRRGT *EQ '9') THEN(CHGVAR VAR(&IN29) +
12600 VALUE('1'))
12701 /*--------------------------------------------------------------*/
12702 /* Display Left Digit of the Minute */
12703 /*--------------------------------------------------------------*/
12800 IF COND(&MINLFT *EQ '0') THEN(CHGVAR VAR(&IN30) +
12900 VALUE('1'))
13000
13100 IF COND(&MINLFT *EQ '1') THEN(CHGVAR VAR(&IN31) +
13200 VALUE('1'))
13300
13400 IF COND(&MINLFT *EQ '2') THEN(CHGVAR VAR(&IN32) +
13500 VALUE('1'))
13600
13700 IF COND(&MINLFT *EQ '3') THEN(CHGVAR VAR(&IN33) +
13800 VALUE('1'))
13900
14000 IF COND(&MINLFT *EQ '4') THEN(CHGVAR VAR(&IN34) +
14100 VALUE('1'))
14200
14300 IF COND(&MINLFT *EQ '5') THEN(CHGVAR VAR(&IN35) +
14400 VALUE('1'))
14500
14600 IF COND(&MINLFT *EQ '6') THEN(CHGVAR VAR(&IN36) +
14700 VALUE('1'))
14800
14900 IF COND(&MINLFT *EQ '7') THEN(CHGVAR VAR(&IN37) +
15000 VALUE('1'))
15100
15200 IF COND(&MINLFT *EQ '8') THEN(CHGVAR VAR(&IN38) +
15300 VALUE('1'))
15400
15500 IF COND(&MINLFT *EQ '9') THEN(CHGVAR VAR(&IN39) +
15600 VALUE('1'))
15701 /*--------------------------------------------------------------*/
15702 /* Display Right Digit of the Minute */
15703 /*--------------------------------------------------------------*/
15800 IF COND(&MINRGT *EQ '0') THEN(CHGVAR VAR(&IN40) +
15900 VALUE('1'))
16000
16100 IF COND(&MINRGT *EQ '1') THEN(CHGVAR VAR(&IN41) +
16200 VALUE('1'))
16300
16400 IF COND(&MINRGT *EQ '2') THEN(CHGVAR VAR(&IN42) +
16500 VALUE('1'))
16600
16700 IF COND(&MINRGT *EQ '3') THEN(CHGVAR VAR(&IN43) +
16800 VALUE('1'))
16900
17000 IF COND(&MINRGT *EQ '4') THEN(CHGVAR VAR(&IN44) +
17100 VALUE('1'))
17200
17300 IF COND(&MINRGT *EQ '5') THEN(CHGVAR VAR(&IN45) +
17400 VALUE('1'))
17500
17600 IF COND(&MINRGT *EQ '6') THEN(CHGVAR VAR(&IN46) +
17700 VALUE('1'))
17800
17900 IF COND(&MINRGT *EQ '7') THEN(CHGVAR VAR(&IN47) +
18000 VALUE('1'))
18100
18200 IF COND(&MINRGT *EQ '8') THEN(CHGVAR VAR(&IN48) +
18300 VALUE('1'))
18400
18500 IF COND(&MINRGT *EQ '9') THEN(CHGVAR VAR(&IN49) +
18600 VALUE('1'))
18700 /*--------------------------------------------------------------*/
18800 /* Display Left Digit of the Second */
18900 /*--------------------------------------------------------------*/
18901 IF COND(&SECLFT *EQ '0') THEN(CHGVAR VAR(&IN50) +
18902 VALUE('1'))
18903
18904 IF COND(&SECLFT *EQ '1') THEN(CHGVAR VAR(&IN51) +
18905 VALUE('1'))
18906
18907 IF COND(&SECLFT *EQ '2') THEN(CHGVAR VAR(&IN52) +
18908 VALUE('1'))
18909
18910 IF COND(&SECLFT *EQ '3') THEN(CHGVAR VAR(&IN53) +
18911 VALUE('1'))
18912
18913 IF COND(&SECLFT *EQ '4') THEN(CHGVAR VAR(&IN54) +
18914 VALUE('1'))
18915
18916 IF COND(&SECLFT *EQ '5') THEN(CHGVAR VAR(&IN55) +
18917 VALUE('1'))
18918
18919 IF COND(&SECLFT *EQ '6') THEN(CHGVAR VAR(&IN56) +
18920 VALUE('1'))
18921
18922 IF COND(&SECLFT *EQ '7') THEN(CHGVAR VAR(&IN57) +
18923 VALUE('1'))
18924
18925 IF COND(&SECLFT *EQ '8') THEN(CHGVAR VAR(&IN58) +
18926 VALUE('1'))
18927
18928 IF COND(&SECLFT *EQ '9') THEN(CHGVAR VAR(&IN59) +
18929 VALUE('1'))
19000 /*--------------------------------------------------------------*/
19100 /* Display Right Digit of the Second */
19200 /*--------------------------------------------------------------*/
19300 IF COND(&SECRGT *EQ '0') THEN(CHGVAR VAR(&IN60) +
19400 VALUE('1'))
19500
19600 IF COND(&SECRGT *EQ '1') THEN(CHGVAR VAR(&IN61) +
19700 VALUE('1'))
19800
19900 IF COND(&SECRGT *EQ '2') THEN(CHGVAR VAR(&IN62) +
20000 VALUE('1'))
20100
20200 IF COND(&SECRGT *EQ '3') THEN(CHGVAR VAR(&IN63) +
20300 VALUE('1'))
20400
20500 IF COND(&SECRGT *EQ '4') THEN(CHGVAR VAR(&IN64) +
20600 VALUE('1'))
20700
20800 IF COND(&SECRGT *EQ '5') THEN(CHGVAR VAR(&IN65) +
20900 VALUE('1'))
21000
21100 IF COND(&SECRGT *EQ '6') THEN(CHGVAR VAR(&IN66) +
21200 VALUE('1'))
21300
21400 IF COND(&SECRGT *EQ '7') THEN(CHGVAR VAR(&IN67) +
21500 VALUE('1'))
21600
21700 IF COND(&SECRGT *EQ '8') THEN(CHGVAR VAR(&IN68) +
21800 VALUE('1'))
21900
22000 IF COND(&SECRGT *EQ '9') THEN(CHGVAR VAR(&IN69) +
22100 VALUE('1'))
22200 /*--------------------------------------------------------------*/
22300 /* Display The Clock */
22400 /*--------------------------------------------------------------*/
22500 SNDRCVF RCDFMT(CLOCKD10) WAIT(*NO)
22600 MONMSG MSGID(CPF0887) EXEC(DO)
22700 RCVMSG MSGTYPE(*EXCP)
22800 RCVF
22900 IF COND(&IN03 *EQ '1') THEN(GOTO CMDLBL(END))
23000 ENDDO
23100 DLYJOB DLY(1)
23101 /*--------------------------------------------------------------*/
23102 /* Initialise the display indicators */
23103 /*--------------------------------------------------------------*/
23200 CHGVAR VAR(&IN11) VALUE('0')
23300 CHGVAR VAR(&IN12) VALUE('0')
23301
23400 CHGVAR VAR(&IN20) VALUE('0')
23500 CHGVAR VAR(&IN21) VALUE('0')
23600 CHGVAR VAR(&IN22) VALUE('0')
23700 CHGVAR VAR(&IN23) VALUE('0')
23800 CHGVAR VAR(&IN24) VALUE('0')
23900 CHGVAR VAR(&IN25) VALUE('0')
24000 CHGVAR VAR(&IN26) VALUE('0')
24100 CHGVAR VAR(&IN27) VALUE('0')
24200 CHGVAR VAR(&IN28) VALUE('0')
24300 CHGVAR VAR(&IN29) VALUE('0')
24301
24400 CHGVAR VAR(&IN30) VALUE('0')
24500 CHGVAR VAR(&IN31) VALUE('0')
24600 CHGVAR VAR(&IN32) VALUE('0')
24700 CHGVAR VAR(&IN33) VALUE('0')
24800 CHGVAR VAR(&IN34) VALUE('0')
24900 CHGVAR VAR(&IN35) VALUE('0')
25000 CHGVAR VAR(&IN36) VALUE('0')
25100 CHGVAR VAR(&IN37) VALUE('0')
25200 CHGVAR VAR(&IN38) VALUE('0')
25300 CHGVAR VAR(&IN39) VALUE('0')
25400
25500 CHGVAR VAR(&IN40) VALUE('0')
25600 CHGVAR VAR(&IN41) VALUE('0')
25700 CHGVAR VAR(&IN42) VALUE('0')
25800 CHGVAR VAR(&IN43) VALUE('0')
25900 CHGVAR VAR(&IN44) VALUE('0')
26000 CHGVAR VAR(&IN45) VALUE('0')
26100 CHGVAR VAR(&IN46) VALUE('0')
26200 CHGVAR VAR(&IN47) VALUE('0')
26300 CHGVAR VAR(&IN48) VALUE('0')
26400 CHGVAR VAR(&IN49) VALUE('0')
26500
26700 CHGVAR VAR(&IN50) VALUE('0')
26800 CHGVAR VAR(&IN51) VALUE('0')
26900 CHGVAR VAR(&IN52) VALUE('0')
27000 CHGVAR VAR(&IN53) VALUE('0')
27100 CHGVAR VAR(&IN54) VALUE('0')
27200 CHGVAR VAR(&IN55) VALUE('0')
27300 CHGVAR VAR(&IN56) VALUE('0')
27400 CHGVAR VAR(&IN57) VALUE('0')
27500 CHGVAR VAR(&IN58) VALUE('0')
27600 CHGVAR VAR(&IN59) VALUE('0')
27700
27800 CHGVAR VAR(&IN60) VALUE('0')
27900 CHGVAR VAR(&IN61) VALUE('0')
28000 CHGVAR VAR(&IN62) VALUE('0')
28100 CHGVAR VAR(&IN63) VALUE('0')
28200 CHGVAR VAR(&IN64) VALUE('0')
28300 CHGVAR VAR(&IN65) VALUE('0')
28400 CHGVAR VAR(&IN66) VALUE('0')
28500 CHGVAR VAR(&IN67) VALUE('0')
28600 CHGVAR VAR(&IN68) VALUE('0')
28700 CHGVAR VAR(&IN69) VALUE('0')
28800
28900 GOTO CMDLBL(RUN)
29000
29100 END: ENDPGM
* * * * E N D O F S O U R C E * * * *
| |
CLLE - Display a Digital Clock
Posted By: Kalpesh Patadia Contact |
5722WDS V5R2M0 020719 SEU SOURCE LISTING 10/30/06 20:57:13
SOURCE FILE . . . . . . . DEVNSK/QCLSRC
MEMBER . . . . . . . . . CLOCKC1
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
0200 /****************************************************************/
0300 /* Program Name . . . . : CLOCKC1 */
0400 /* Program Description. : This program displays a digital clock */
0600 /* : */
0700 /* Files Used . . . . . : *NONE */
0800 /* Files Overridden . . : *NONE */
0801 /* Files Declared . . . : CLOCKD1 - Screen for the Clock */
0900 /****************************************************************/
1000 /*Copyright (C) . . . . : XxxxxxX Xxxxxxxxxxxx, Xxxxxxxxx */
1100 /****************************************************************/
1200 /* Created by . . . . . : KALPESH PATADIA */
1300 /* Company. . . . . . . : XxxxxxX Xxxxxxxxxxxx, Xxxxxxxxx */
1400 /* Date . . . . . . . . : October 27, 2006 */
1500 /* Project ID . . . . . : XXXX9999 Marked . . : X9999 */
1600 /* Reason . . . . . . . : To display a digital clock with auto */
1700 /* : refresh. */
1800 /*--------------------------------------------------------------*/
1900 /****************************************************************/
2000 PGM
2100 /*--------------------------------------------------------------*/
2200 /* Declare Variables and Files */
2300 /*--------------------------------------------------------------*/
2301 DCLF FILE(CLOCKD1) RCDFMT(*ALL)
2302 /*--------------------------------------------------------------*/
2500 DCL VAR(&HOUR) TYPE(*CHAR) LEN(2) /* Hour +
2600 Component of the Time */
2700 DCL VAR(&MINUTE) TYPE(*CHAR) LEN(2) /* Minute +
2800 Component of the Time */
2900 DCL VAR(&SECOND) TYPE(*CHAR) LEN(2) /* Second +
3000 Component of the Time */
3100 DCL VAR(&CURDAT) TYPE(*CHAR) LEN(6) /* Current +
3200 Date */
3300 DCL VAR(&CURDAY) TYPE(*CHAR) LEN(4) /* Current +
3400 Day */
3403 /*--------------------------------------------------------------*/
3600 DCL VAR(&HRLFT) TYPE(*CHAR) LEN(1) /* Left Digit +
3700 of the Hour */
3800 DCL VAR(&HRRGT) TYPE(*CHAR) LEN(1) /* Right +
3900 Digit of the Hour */
4000 DCL VAR(&MINLFT) TYPE(*CHAR) LEN(1) /* Left +
4100 Digit of the Minute */
4200 DCL VAR(&MINRGT) TYPE(*CHAR) LEN(1) /* Right +
4300 Digit of the Minute */
4400 DCL VAR(&SECLFT) TYPE(*CHAR) LEN(1) /* Left +
4500 Digit of the Second */
4600 DCL VAR(&SECRGT) TYPE(*CHAR) LEN(1) /* Right +
4700 Digit of the Second */
4701 /*--------------------------------------------------------------*/
4900 /* MAIN LINE */
5000 /*--------------------------------------------------------------*/
"5100 RUN: /* Retrieve Current Date, Time and Day */"
5200 RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&HOUR)
5300 RTVSYSVAL SYSVAL(QMINUTE) RTNVAR(&MINUTE)
5400 RTVSYSVAL SYSVAL(QSECOND) RTNVAR(&SECOND)
5500 RTVSYSVAL SYSVAL(QDATE) RTNVAR(&CURDAT)
5600 RTVSYSVAL SYSVAL(QDAYOFWEEK) RTNVAR(&CURDAY)
5700 /*--------------------------------------------------------------*/
5800 /* Display Current Date And Day */
5900 /*--------------------------------------------------------------*/
6000 CVTDAT DATE(&CURDAT) TOVAR(&#CURDT) TOFMT(*DMYY) +
6100 TOSEP(/)
6200
6300 IF COND(&CURDAY = *SUN) THEN(CHGVAR +
6400 VAR(&#WKDAY) VALUE('Sunday'))
6500 IF COND(&CURDAY = *MON) THEN(CHGVAR +
6600 VAR(&#WKDAY) VALUE('Monday'))
6700 IF COND(&CURDAY = *TUE) THEN(CHGVAR +
6800 VAR(&#WKDAY) VALUE('Tuesday'))
6900 IF COND(&CURDAY = *WED) THEN(CHGVAR +
7000 VAR(&#WKDAY) VALUE('Wednesday'))
7100 IF COND(&CURDAY = *THU) THEN(CHGVAR +
7200 VAR(&#WKDAY) VALUE('Thursday'))
7300 IF COND(&CURDAY = *FRI) THEN(CHGVAR +
7400 VAR(&#WKDAY) VALUE('Friday'))
7500 IF COND(&CURDAY = *SAT) THEN(CHGVAR +
7600 VAR(&#WKDAY) VALUE('Saturday'))
7700 /*--------------------------------------------------------------*/
7800 /* Display Current Time */
7900 /*--------------------------------------------------------------*/
8000 CHGVAR VAR(&HRLFT) VALUE(%SST(&HOUR 1 1))
8100 CHGVAR VAR(&HRRGT) VALUE(%SST(&HOUR 2 1))
8200
8300 CHGVAR VAR(&MINLFT) VALUE(%SST(&MINUTE 1 1))
8400 CHGVAR VAR(&MINRGT) VALUE(%SST(&MINUTE 2 1))
8500
8600 CHGVAR VAR(&SECLFT) VALUE(%SST(&SECOND 1 1))
8700 CHGVAR VAR(&SECRGT) VALUE(%SST(&SECOND 2 1))
8800 /*--------------------------------------------------------------*/
8900 /* Display Left Digit of the Hour */
9000 /*--------------------------------------------------------------*/
9100 IF COND(&HRLFT *EQ '1') THEN(CHGVAR VAR(&IN11) +
9200 VALUE('1'))
9201
9300 IF COND(&HRLFT *EQ '2') THEN(CHGVAR VAR(&IN12) +
9400 VALUE('1'))
9500 /*--------------------------------------------------------------*/
9600 /* Display Right Digit of the Hour */
9700 /*--------------------------------------------------------------*/
9800 IF COND(&HRRGT *EQ '0') THEN(CHGVAR VAR(&IN20) +
9900 VALUE('1'))
10000
10100 IF COND(&HRRGT *EQ '1') THEN(CHGVAR VAR(&IN21) +
10200 VALUE('1'))
10300
10400 IF COND(&HRRGT *EQ '2') THEN(CHGVAR VAR(&IN22) +
10500 VALUE('1'))
10600
10700 IF COND(&HRRGT *EQ '3') THEN(CHGVAR VAR(&IN23) +
10800 VALUE('1'))
10900
11000 IF COND(&HRRGT *EQ '4') THEN(CHGVAR VAR(&IN24) +
11100 VALUE('1'))
11200
11300 IF COND(&HRRGT *EQ '5') THEN(CHGVAR VAR(&IN25) +
11400 VALUE('1'))
11500
11600 IF COND(&HRRGT *EQ '6') THEN(CHGVAR VAR(&IN26) +
11700 VALUE('1'))
11800
11900 IF COND(&HRRGT *EQ '7') THEN(CHGVAR VAR(&IN27) +
12000 VALUE('1'))
12100
12200 IF COND(&HRRGT *EQ '8') THEN(CHGVAR VAR(&IN28) +
12300 VALUE('1'))
12400
12500 IF COND(&HRRGT *EQ '9') THEN(CHGVAR VAR(&IN29) +
12600 VALUE('1'))
12701 /*--------------------------------------------------------------*/
12702 /* Display Left Digit of the Minute */
12703 /*--------------------------------------------------------------*/
12800 IF COND(&MINLFT *EQ '0') THEN(CHGVAR VAR(&IN30) +
12900 VALUE('1'))
13000
13100 IF COND(&MINLFT *EQ '1') THEN(CHGVAR VAR(&IN31) +
13200 VALUE('1'))
13300
13400 IF COND(&MINLFT *EQ '2') THEN(CHGVAR VAR(&IN32) +
13500 VALUE('1'))
13600
13700 IF COND(&MINLFT *EQ '3') THEN(CHGVAR VAR(&IN33) +
13800 VALUE('1'))
13900
14000 IF COND(&MINLFT *EQ '4') THEN(CHGVAR VAR(&IN34) +
14100 VALUE('1'))
14200
14300 IF COND(&MINLFT *EQ '5') THEN(CHGVAR VAR(&IN35) +
14400 VALUE('1'))
14500
14600 IF COND(&MINLFT *EQ '6') THEN(CHGVAR VAR(&IN36) +
14700 VALUE('1'))
14800
14900 IF COND(&MINLFT *EQ '7') THEN(CHGVAR VAR(&IN37) +
15000 VALUE('1'))
15100
15200 IF COND(&MINLFT *EQ '8') THEN(CHGVAR VAR(&IN38) +
15300 VALUE('1'))
15400
15500 IF COND(&MINLFT *EQ '9') THEN(CHGVAR VAR(&IN39) +
15600 VALUE('1'))
15701 /*--------------------------------------------------------------*/
15702 /* Display Right Digit of the Minute */
15703 /*--------------------------------------------------------------*/
15800 IF COND(&MINRGT *EQ '0') THEN(CHGVAR VAR(&IN40) +
15900 VALUE('1'))
16000
16100 IF COND(&MINRGT *EQ '1') THEN(CHGVAR VAR(&IN41) +
16200 VALUE('1'))
16300
16400 IF COND(&MINRGT *EQ '2') THEN(CHGVAR VAR(&IN42) +
16500 VALUE('1'))
16600
16700 IF COND(&MINRGT *EQ '3') THEN(CHGVAR VAR(&IN43) +
16800 VALUE('1'))
16900
17000 IF COND(&MINRGT *EQ '4') THEN(CHGVAR VAR(&IN44) +
17100 VALUE('1'))
17200
17300 IF COND(&MINRGT *EQ '5') THEN(CHGVAR VAR(&IN45) +
17400 VALUE('1'))
17500
17600 IF COND(&MINRGT *EQ '6') THEN(CHGVAR VAR(&IN46) +
17700 VALUE('1'))
17800
17900 IF COND(&MINRGT *EQ '7') THEN(CHGVAR VAR(&IN47) +
18000 VALUE('1'))
18100
18200 IF COND(&MINRGT *EQ '8') THEN(CHGVAR VAR(&IN48) +
18300 VALUE('1'))
18400
18500 IF COND(&MINRGT *EQ '9') THEN(CHGVAR VAR(&IN49) +
18600 VALUE('1'))
18700 /*--------------------------------------------------------------*/
18800 /* Display Left Digit of the Second */
18900 /*--------------------------------------------------------------*/
18901 IF COND(&SECLFT *EQ '0') THEN(CHGVAR VAR(&IN50) +
18902 VALUE('1'))
18903
18904 IF COND(&SECLFT *EQ '1') THEN(CHGVAR VAR(&IN51) +
18905 VALUE('1'))
18906
18907 IF COND(&SECLFT *EQ '2') THEN(CHGVAR VAR(&IN52) +
18908 VALUE('1'))
18909
18910 IF COND(&SECLFT *EQ '3') THEN(CHGVAR VAR(&IN53) +
18911 VALUE('1'))
18912
18913 IF COND(&SECLFT *EQ '4') THEN(CHGVAR VAR(&IN54) +
18914 VALUE('1'))
18915
18916 IF COND(&SECLFT *EQ '5') THEN(CHGVAR VAR(&IN55) +
18917 VALUE('1'))
18918
18919 IF COND(&SECLFT *EQ '6') THEN(CHGVAR VAR(&IN56) +
18920 VALUE('1'))
18921
18922 IF COND(&SECLFT *EQ '7') THEN(CHGVAR VAR(&IN57) +
18923 VALUE('1'))
18924
18925 IF COND(&SECLFT *EQ '8') THEN(CHGVAR VAR(&IN58) +
18926 VALUE('1'))
18927
18928 IF COND(&SECLFT *EQ '9') THEN(CHGVAR VAR(&IN59) +
18929 VALUE('1'))
19000 /*--------------------------------------------------------------*/
19100 /* Display Right Digit of the Second */
19200 /*--------------------------------------------------------------*/
19300 IF COND(&SECRGT *EQ '0') THEN(CHGVAR VAR(&IN60) +
19400 VALUE('1'))
19500
19600 IF COND(&SECRGT *EQ '1') THEN(CHGVAR VAR(&IN61) +
19700 VALUE('1'))
19800
19900 IF COND(&SECRGT *EQ '2') THEN(CHGVAR VAR(&IN62) +
20000 VALUE('1'))
20100
20200 IF COND(&SECRGT *EQ '3') THEN(CHGVAR VAR(&IN63) +
20300 VALUE('1'))
20400
20500 IF COND(&SECRGT *EQ '4') THEN(CHGVAR VAR(&IN64) +
20600 VALUE('1'))
20700
20800 IF COND(&SECRGT *EQ '5') THEN(CHGVAR VAR(&IN65) +
20900 VALUE('1'))
21000
21100 IF COND(&SECRGT *EQ '6') THEN(CHGVAR VAR(&IN66) +
21200 VALUE('1'))
21300
21400 IF COND(&SECRGT *EQ '7') THEN(CHGVAR VAR(&IN67) +
21500 VALUE('1'))
21600
21700 IF COND(&SECRGT *EQ '8') THEN(CHGVAR VAR(&IN68) +
21800 VALUE('1'))
21900
22000 IF COND(&SECRGT *EQ '9') THEN(CHGVAR VAR(&IN69) +
22100 VALUE('1'))
22200 /*--------------------------------------------------------------*/
22300 /* Display The Clock */
22400 /*--------------------------------------------------------------*/
22500 SNDRCVF RCDFMT(CLOCKD10) WAIT(*NO)
22600 MONMSG MSGID(CPF0887) EXEC(DO)
22700 RCVMSG MSGTYPE(*EXCP)
22800 RCVF
22900 IF COND(&IN03 *EQ '1') THEN(GOTO CMDLBL(END))
23000 ENDDO
23100 DLYJOB DLY(1)
23101 /*--------------------------------------------------------------*/
23102 /* Initialise the display indicators */
23103 /*--------------------------------------------------------------*/
23200 CHGVAR VAR(&IN11) VALUE('0')
23300 CHGVAR VAR(&IN12) VALUE('0')
23301
23400 CHGVAR VAR(&IN20) VALUE('0')
23500 CHGVAR VAR(&IN21) VALUE('0')
23600 CHGVAR VAR(&IN22) VALUE('0')
23700 CHGVAR VAR(&IN23) VALUE('0')
23800 CHGVAR VAR(&IN24) VALUE('0')
23900 CHGVAR VAR(&IN25) VALUE('0')
24000 CHGVAR VAR(&IN26) VALUE('0')
24100 CHGVAR VAR(&IN27) VALUE('0')
24200 CHGVAR VAR(&IN28) VALUE('0')
24300 CHGVAR VAR(&IN29) VALUE('0')
24301
24400 CHGVAR VAR(&IN30) VALUE('0')
24500 CHGVAR VAR(&IN31) VALUE('0')
24600 CHGVAR VAR(&IN32) VALUE('0')
24700 CHGVAR VAR(&IN33) VALUE('0')
24800 CHGVAR VAR(&IN34) VALUE('0')
24900 CHGVAR VAR(&IN35) VALUE('0')
25000 CHGVAR VAR(&IN36) VALUE('0')
25100 CHGVAR VAR(&IN37) VALUE('0')
25200 CHGVAR VAR(&IN38) VALUE('0')
25300 CHGVAR VAR(&IN39) VALUE('0')
25400
25500 CHGVAR VAR(&IN40) VALUE('0')
25600 CHGVAR VAR(&IN41) VALUE('0')
25700 CHGVAR VAR(&IN42) VALUE('0')
25800 CHGVAR VAR(&IN43) VALUE('0')
25900 CHGVAR VAR(&IN44) VALUE('0')
26000 CHGVAR VAR(&IN45) VALUE('0')
26100 CHGVAR VAR(&IN46) VALUE('0')
26200 CHGVAR VAR(&IN47) VALUE('0')
26300 CHGVAR VAR(&IN48) VALUE('0')
26400 CHGVAR VAR(&IN49) VALUE('0')
26500
26700 CHGVAR VAR(&IN50) VALUE('0')
26800 CHGVAR VAR(&IN51) VALUE('0')
26900 CHGVAR VAR(&IN52) VALUE('0')
27000 CHGVAR VAR(&IN53) VALUE('0')
27100 CHGVAR VAR(&IN54) VALUE('0')
27200 CHGVAR VAR(&IN55) VALUE('0')
27300 CHGVAR VAR(&IN56) VALUE('0')
27400 CHGVAR VAR(&IN57) VALUE('0')
27500 CHGVAR VAR(&IN58) VALUE('0')
27600 CHGVAR VAR(&IN59) VALUE('0')
27700
27800 CHGVAR VAR(&IN60) VALUE('0')
27900 CHGVAR VAR(&IN61) VALUE('0')
28000 CHGVAR VAR(&IN62) VALUE('0')
28100 CHGVAR VAR(&IN63) VALUE('0')
28200 CHGVAR VAR(&IN64) VALUE('0')
28300 CHGVAR VAR(&IN65) VALUE('0')
28400 CHGVAR VAR(&IN66) VALUE('0')
28500 CHGVAR VAR(&IN67) VALUE('0')
28600 CHGVAR VAR(&IN68) VALUE('0')
28700 CHGVAR VAR(&IN69) VALUE('0')
28800
28900 GOTO CMDLBL(RUN)
29000
29100 END: ENDPGM
* * * * E N D O F S O U R C E * * * *
| |
CLLE - Display a Digital Clock
Posted By: Kalpesh Patadia Contact |
5722WDS V5R2M0 020719 SEU SOURCE LISTING 10/30/06 20:57:13
SOURCE FILE . . . . . . . DEVNSK/QCLSRC
MEMBER . . . . . . . . . CLOCKC1
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
0200 /****************************************************************/
0300 /* Program Name . . . . : CLOCKC1 */
0400 /* Program Description. : This program displays a digital clock */
0600 /* : */
0700 /* Files Used . . . . . : *NONE */
0800 /* Files Overridden . . : *NONE */
0801 /* Files Declared . . . : CLOCKD1 - Screen for the Clock */
0900 /****************************************************************/
1000 /*Copyright (C) . . . . : XxxxxxX Xxxxxxxxxxxx, Xxxxxxxxx */
1100 /****************************************************************/
1200 /* Created by . . . . . : KALPESH PATADIA */
1300 /* Company. . . . . . . : XxxxxxX Xxxxxxxxxxxx, Xxxxxxxxx */
1400 /* Date . . . . . . . . : October 27, 2006 */
1500 /* Project ID . . . . . : XXXX9999 Marked . . : X9999 */
1600 /* Reason . . . . . . . : To display a digital clock with auto */
1700 /* : refresh. */
1800 /*--------------------------------------------------------------*/
1900 /****************************************************************/
2000 PGM
2100 /*--------------------------------------------------------------*/
2200 /* Declare Variables and Files */
2300 /*--------------------------------------------------------------*/
2301 DCLF FILE(CLOCKD1) RCDFMT(*ALL)
2302 /*--------------------------------------------------------------*/
2500 DCL VAR(&HOUR) TYPE(*CHAR) LEN(2) /* Hour +
2600 Component of the Time */
2700 DCL VAR(&MINUTE) TYPE(*CHAR) LEN(2) /* Minute +
2800 Component of the Time */
2900 DCL VAR(&SECOND) TYPE(*CHAR) LEN(2) /* Second +
3000 Component of the Time */
3100 DCL VAR(&CURDAT) TYPE(*CHAR) LEN(6) /* Current +
3200 Date */
3300 DCL VAR(&CURDAY) TYPE(*CHAR) LEN(4) /* Current +
3400 Day */
3403 /*--------------------------------------------------------------*/
3600 DCL VAR(&HRLFT) TYPE(*CHAR) LEN(1) /* Left Digit +
3700 of the Hour */
3800 DCL VAR(&HRRGT) TYPE(*CHAR) LEN(1) /* Right +
3900 Digit of the Hour */
4000 DCL VAR(&MINLFT) TYPE(*CHAR) LEN(1) /* Left +
4100 Digit of the Minute */
4200 DCL VAR(&MINRGT) TYPE(*CHAR) LEN(1) /* Right +
4300 Digit of the Minute */
4400 DCL VAR(&SECLFT) TYPE(*CHAR) LEN(1) /* Left +
4500 Digit of the Second */
4600 DCL VAR(&SECRGT) TYPE(*CHAR) LEN(1) /* Right +
4700 Digit of the Second */
4701 /*--------------------------------------------------------------*/
4900 /* MAIN LINE */
5000 /*--------------------------------------------------------------*/
"5100 RUN: /* Retrieve Current Date, Time and Day */"
5200 RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&HOUR)
5300 RTVSYSVAL SYSVAL(QMINUTE) RTNVAR(&MINUTE)
5400 RTVSYSVAL SYSVAL(QSECOND) RTNVAR(&SECOND)
5500 RTVSYSVAL SYSVAL(QDATE) RTNVAR(&CURDAT)
5600 RTVSYSVAL SYSVAL(QDAYOFWEEK) RTNVAR(&CURDAY)
5700 /*--------------------------------------------------------------*/
5800 /* Display Current Date And Day */
5900 /*--------------------------------------------------------------*/
6000 CVTDAT DATE(&CURDAT) TOVAR(&#CURDT) TOFMT(*DMYY) +
6100 TOSEP(/)
6200
6300 IF COND(&CURDAY = *SUN) THEN(CHGVAR +
6400 VAR(&#WKDAY) VALUE('Sunday'))
6500 IF COND(&CURDAY = *MON) THEN(CHGVAR +
6600 VAR(&#WKDAY) VALUE('Monday'))
6700 IF COND(&CURDAY = *TUE) THEN(CHGVAR +
6800 VAR(&#WKDAY) VALUE('Tuesday'))
6900 IF COND(&CURDAY = *WED) THEN(CHGVAR +
7000 VAR(&#WKDAY) VALUE('Wednesday'))
7100 IF COND(&CURDAY = *THU) THEN(CHGVAR +
7200 VAR(&#WKDAY) VALUE('Thursday'))
7300 IF COND(&CURDAY = *FRI) THEN(CHGVAR +
7400 VAR(&#WKDAY) VALUE('Friday'))
7500 IF COND(&CURDAY = *SAT) THEN(CHGVAR +
7600 VAR(&#WKDAY) VALUE('Saturday'))
7700 /*--------------------------------------------------------------*/
7800 /* Display Current Time */
7900 /*--------------------------------------------------------------*/
8000 CHGVAR VAR(&HRLFT) VALUE(%SST(&HOUR 1 1))
8100 CHGVAR VAR(&HRRGT) VALUE(%SST(&HOUR 2 1))
8200
8300 CHGVAR VAR(&MINLFT) VALUE(%SST(&MINUTE 1 1))
8400 CHGVAR VAR(&MINRGT) VALUE(%SST(&MINUTE 2 1))
8500
8600 CHGVAR VAR(&SECLFT) VALUE(%SST(&SECOND 1 1))
8700 CHGVAR VAR(&SECRGT) VALUE(%SST(&SECOND 2 1))
8800 /*--------------------------------------------------------------*/
8900 /* Display Left Digit of the Hour */
9000 /*--------------------------------------------------------------*/
9100 IF COND(&HRLFT *EQ '1') THEN(CHGVAR VAR(&IN11) +
9200 VALUE('1'))
9201
9300 IF COND(&HRLFT *EQ '2') THEN(CHGVAR VAR(&IN12) +
9400 VALUE('1'))
9500 /*--------------------------------------------------------------*/
9600 /* Display Right Digit of the Hour */
9700 /*--------------------------------------------------------------*/
9800 IF COND(&HRRGT *EQ '0') THEN(CHGVAR VAR(&IN20) +
9900 VALUE('1'))
10000
10100 IF COND(&HRRGT *EQ '1') THEN(CHGVAR VAR(&IN21) +
10200 VALUE('1'))
10300
10400 IF COND(&HRRGT *EQ '2') THEN(CHGVAR VAR(&IN22) +
10500 VALUE('1'))
10600
10700 IF COND(&HRRGT *EQ '3') THEN(CHGVAR VAR(&IN23) +
10800 VALUE('1'))
10900
11000 IF COND(&HRRGT *EQ '4') THEN(CHGVAR VAR(&IN24) +
11100 VALUE('1'))
11200
11300 IF COND(&HRRGT *EQ '5') THEN(CHGVAR VAR(&IN25) +
11400 VALUE('1'))
11500
11600 IF COND(&HRRGT *EQ '6') THEN(CHGVAR VAR(&IN26) +
11700 VALUE('1'))
11800
11900 IF COND(&HRRGT *EQ '7') THEN(CHGVAR VAR(&IN27) +
12000 VALUE('1'))
12100
12200 IF COND(&HRRGT *EQ '8') THEN(CHGVAR VAR(&IN28) +
12300 VALUE('1'))
12400
12500 IF COND(&HRRGT *EQ '9') THEN(CHGVAR VAR(&IN29) +
12600 VALUE('1'))
12701 /*--------------------------------------------------------------*/
12702 /* Display Left Digit of the Minute */
12703 /*--------------------------------------------------------------*/
12800 IF COND(&MINLFT *EQ '0') THEN(CHGVAR VAR(&IN30) +
12900 VALUE('1'))
13000
13100 IF COND(&MINLFT *EQ '1') THEN(CHGVAR VAR(&IN31) +
13200 VALUE('1'))
13300
13400 IF COND(&MINLFT *EQ '2') THEN(CHGVAR VAR(&IN32) +
13500 VALUE('1'))
13600
13700 IF COND(&MINLFT *EQ '3') THEN(CHGVAR VAR(&IN33) +
13800 VALUE('1'))
13900
14000 IF COND(&MINLFT *EQ '4') THEN(CHGVAR VAR(&IN34) +
14100 VALUE('1'))
14200
14300 IF COND(&MINLFT *EQ '5') THEN(CHGVAR VAR(&IN35) +
14400 VALUE('1'))
14500
14600 IF COND(&MINLFT *EQ '6') THEN(CHGVAR VAR(&IN36) +
14700 VALUE('1'))
14800
14900 IF COND(&MINLFT *EQ '7') THEN(CHGVAR VAR(&IN37) +
15000 VALUE('1'))
15100
15200 IF COND(&MINLFT *EQ '8') THEN(CHGVAR VAR(&IN38) +
15300 VALUE('1'))
15400
15500 IF COND(&MINLFT *EQ '9') THEN(CHGVAR VAR(&IN39) +
15600 VALUE('1'))
15701 /*--------------------------------------------------------------*/
15702 /* Display Right Digit of the Minute */
15703 /*--------------------------------------------------------------*/
15800 IF COND(&MINRGT *EQ '0') THEN(CHGVAR VAR(&IN40) +
15900 VALUE('1'))
16000
16100 IF COND(&MINRGT *EQ '1') THEN(CHGVAR VAR(&IN41) +
16200 VALUE('1'))
16300
16400 IF COND(&MINRGT *EQ '2') THEN(CHGVAR VAR(&IN42) +
16500 VALUE('1'))
16600
16700 IF COND(&MINRGT *EQ '3') THEN(CHGVAR VAR(&IN43) +
16800 VALUE('1'))
16900
17000 IF COND(&MINRGT *EQ '4') THEN(CHGVAR VAR(&IN44) +
17100 VALUE('1'))
17200
17300 IF COND(&MINRGT *EQ '5') THEN(CHGVAR VAR(&IN45) +
17400 VALUE('1'))
17500
17600 IF COND(&MINRGT *EQ '6') THEN(CHGVAR VAR(&IN46) +
17700 VALUE('1'))
17800
17900 IF COND(&MINRGT *EQ '7') THEN(CHGVAR VAR(&IN47) +
18000 VALUE('1'))
18100
18200 IF COND(&MINRGT *EQ '8') THEN(CHGVAR VAR(&IN48) +
18300 VALUE('1'))
18400
18500 IF COND(&MINRGT *EQ '9') THEN(CHGVAR VAR(&IN49) +
18600 VALUE('1'))
18700 /*--------------------------------------------------------------*/
18800 /* Display Left Digit of the Second */
18900 /*--------------------------------------------------------------*/
18901 IF COND(&SECLFT *EQ '0') THEN(CHGVAR VAR(&IN50) +
18902 VALUE('1'))
18903
18904 IF COND(&SECLFT *EQ '1') THEN(CHGVAR VAR(&IN51) +
18905 VALUE('1'))
18906
18907 IF COND(&SECLFT *EQ '2') THEN(CHGVAR VAR(&IN52) +
18908 VALUE('1'))
18909
18910 IF COND(&SECLFT *EQ '3') THEN(CHGVAR VAR(&IN53) +
18911 VALUE('1'))
18912
18913 IF COND(&SECLFT *EQ '4') THEN(CHGVAR VAR(&IN54) +
18914 VALUE('1'))
18915
18916 IF COND(&SECLFT *EQ '5') THEN(CHGVAR VAR(&IN55) +
18917 VALUE('1'))
18918
18919 IF COND(&SECLFT *EQ '6') THEN(CHGVAR VAR(&IN56) +
18920 VALUE('1'))
18921
18922 IF COND(&SECLFT *EQ '7') THEN(CHGVAR VAR(&IN57) +
18923 VALUE('1'))
18924
18925 IF COND(&SECLFT *EQ '8') THEN(CHGVAR VAR(&IN58) +
18926 VALUE('1'))
18927
18928 IF COND(&SECLFT *EQ '9') THEN(CHGVAR VAR(&IN59) +
18929 VALUE('1'))
19000 /*--------------------------------------------------------------*/
19100 /* Display Right Digit of the Second */
19200 /*--------------------------------------------------------------*/
19300 IF COND(&SECRGT *EQ '0') THEN(CHGVAR VAR(&IN60) +
19400 VALUE('1'))
19500
19600 IF COND(&SECRGT *EQ '1') THEN(CHGVAR VAR(&IN61) +
19700 VALUE('1'))
19800
19900 IF COND(&SECRGT *EQ '2') THEN(CHGVAR VAR(&IN62) +
20000 VALUE('1'))
20100
20200 IF COND(&SECRGT *EQ '3') THEN(CHGVAR VAR(&IN63) +
20300 VALUE('1'))
20400
20500 IF COND(&SECRGT *EQ '4') THEN(CHGVAR VAR(&IN64) +
20600 VALUE('1'))
20700
20800 IF COND(&SECRGT *EQ '5') THEN(CHGVAR VAR(&IN65) +
20900 VALUE('1'))
21000
21100 IF COND(&SECRGT *EQ '6') THEN(CHGVAR VAR(&IN66) +
21200 VALUE('1'))
21300
21400 IF COND(&SECRGT *EQ '7') THEN(CHGVAR VAR(&IN67) +
21500 VALUE('1'))
21600
21700 IF COND(&SECRGT *EQ '8') THEN(CHGVAR VAR(&IN68) +
21800 VALUE('1'))
21900
22000 IF COND(&SECRGT *EQ '9') THEN(CHGVAR VAR(&IN69) +
22100 VALUE('1'))
22200 /*--------------------------------------------------------------*/
22300 /* Display The Clock */
22400 /*--------------------------------------------------------------*/
22500 SNDRCVF RCDFMT(CLOCKD10) WAIT(*NO)
22600 MONMSG MSGID(CPF0887) EXEC(DO)
22700 RCVMSG MSGTYPE(*EXCP)
22800 RCVF
22900 IF COND(&IN03 *EQ '1') THEN(GOTO CMDLBL(END))
23000 ENDDO
23100 DLYJOB DLY(1)
23101 /*--------------------------------------------------------------*/
23102 /* Initialise the display indicators */
23103 /*--------------------------------------------------------------*/
23200 CHGVAR VAR(&IN11) VALUE('0')
23300 CHGVAR VAR(&IN12) VALUE('0')
23301
23400 CHGVAR VAR(&IN20) VALUE('0')
23500 CHGVAR VAR(&IN21) VALUE('0')
23600 CHGVAR VAR(&IN22) VALUE('0')
23700 CHGVAR VAR(&IN23) VALUE('0')
23800 CHGVAR VAR(&IN24) VALUE('0')
23900 CHGVAR VAR(&IN25) VALUE('0')
24000 CHGVAR VAR(&IN26) VALUE('0')
24100 CHGVAR VAR(&IN27) VALUE('0')
24200 CHGVAR VAR(&IN28) VALUE('0')
24300 CHGVAR VAR(&IN29) VALUE('0')
24301
24400 CHGVAR VAR(&IN30) VALUE('0')
24500 CHGVAR VAR(&IN31) VALUE('0')
24600 CHGVAR VAR(&IN32) VALUE('0')
24700 CHGVAR VAR(&IN33) VALUE('0')
24800 CHGVAR VAR(&IN34) VALUE('0')
24900 CHGVAR VAR(&IN35) VALUE('0')
25000 CHGVAR VAR(&IN36) VALUE('0')
25100 CHGVAR VAR(&IN37) VALUE('0')
25200 CHGVAR VAR(&IN38) VALUE('0')
25300 CHGVAR VAR(&IN39) VALUE('0')
25400
25500 CHGVAR VAR(&IN40) VALUE('0')
25600 CHGVAR VAR(&IN41) VALUE('0')
25700 CHGVAR VAR(&IN42) VALUE('0')
25800 CHGVAR VAR(&IN43) VALUE('0')
25900 CHGVAR VAR(&IN44) VALUE('0')
26000 CHGVAR VAR(&IN45) VALUE('0')
26100 CHGVAR VAR(&IN46) VALUE('0')
26200 CHGVAR VAR(&IN47) VALUE('0')
26300 CHGVAR VAR(&IN48) VALUE('0')
26400 CHGVAR VAR(&IN49) VALUE('0')
26500
26700 CHGVAR VAR(&IN50) VALUE('0')
26800 CHGVAR VAR(&IN51) VALUE('0')
26900 CHGVAR VAR(&IN52) VALUE('0')
27000 CHGVAR VAR(&IN53) VALUE('0')
27100 CHGVAR VAR(&IN54) VALUE('0')
27200 CHGVAR VAR(&IN55) VALUE('0')
27300 CHGVAR VAR(&IN56) VALUE('0')
27400 CHGVAR VAR(&IN57) VALUE('0')
27500 CHGVAR VAR(&IN58) VALUE('0')
27600 CHGVAR VAR(&IN59) VALUE('0')
27700
27800 CHGVAR VAR(&IN60) VALUE('0')
27900 CHGVAR VAR(&IN61) VALUE('0')
28000 CHGVAR VAR(&IN62) VALUE('0')
28100 CHGVAR VAR(&IN63) VALUE('0')
28200 CHGVAR VAR(&IN64) VALUE('0')
28300 CHGVAR VAR(&IN65) VALUE('0')
28400 CHGVAR VAR(&IN66) VALUE('0')
28500 CHGVAR VAR(&IN67) VALUE('0')
28600 CHGVAR VAR(&IN68) VALUE('0')
28700 CHGVAR VAR(&IN69) VALUE('0')
28800
28900 GOTO CMDLBL(RUN)
29000
29100 END: ENDPGM
* * * * E N D O F S O U R C E * * * *
| |
|
|
|
