ISeries As400 Blogger time

PROGRAM:

CLEAR SUBFILE

SFLCLR = ON

Write SUBFILE CONTROL

SFLCLR = OFF

SFLDSPCTL = ON

SFLEND = ON

DisplayFileRRN = 0

SETLL to FILE

LOAD SUBFILE

Read from file and write to subfile

Increment ProgramRRN by 1 for each record

DISPLAY SUBFILE

If ProgramRRN > 0

DisplayFileRRN = 1

SFLDSP = ON

Else

SFLDSP = OFF

EndIf

DOW *IN03 = *OFF

If RcdCursor <> 0

DisplayFileRRN = ProgramRRN

EndIf

Write MSGCTL (for message subfile)

If SFLDSP = OFF

Write EMPTYSUBFILE

EndIf

Write FOOTER

EXFMT SUBFILE CONTROL

NOTE:

Declare ProgramRRN - 4,0 in RPGLE & ASSIGN IT TO SUBFILE AS BELOW:

FSSM720D CF E WORKSTN

F SFILE(DisplaySubfile:ProgramRRN)

F SFILE(MessageSubfile:MessageRRN)

Declare SFLCSRRRN (&) SFLRCDNBR Keywords in DSPF:

Give this after declaring SFLDSP, SFLDSPCTL, SFLCLR, SFLEND(*MORE) & SFLINZ keywords in DSPF.

A SFLCSRRRN(&RcdCursor)

A S1RRN 4S 0H SFLRCDNBR(CURSOR)

A RcdCursor 5S 0H

(Make sure you have specified OVERLAY on Subfile Control & EMPTYSUBFILE records in Display File)

Sub file

Subfile Program Procedure in RPG

Unknown Thursday, 30 May 2013

To Copy Source Files Used In RCVNSF/SNDNSF To PC Files

For Subsequent External Transportation

CPYTOPCD FROMFILE(UTILITIES/QCLSRC) TOFLR(MY_FOLDER) +

FROMMBR(MY_MEMBER)

CL Programs

Copy Source Files Used In RCVNSF/SNDNSF To PC Files For Subsequent External Transportation

Unknown

Reorganize All Files In Selected Library

PGM PARM(&LIB)

DCLF FILE(MLIST)

DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* LIBRARY TO REORGANIZE */

DSPFD FILE(&LIB/*ALL) TYPE(*MBRLIST) +

OUTPUT(*OUTFILE) OUTFILE(UTILITIES/MLIST)

MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(EOF))

READ:

RCVF

MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EOF))

RGZPFM FILE(&MLLIB/&MLFILE)

MONMSG MSGID(CPF0000)

GOTO CMDLBL(READ)

EOF:

ENDPGM

CL Programs

Reorganize All Files In Selected Library

Unknown

Find (Or CREATE) A Source Code For An OBJECT

CHKOBJ OBJ(&OBJLIB/&OBJNAME) OBJTYPE(&OBJTYPE)

DSPOBJD OBJ(&OBJLIB/&OBJNAME) OBJTYPE(&OBJTYPE) +

OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ)

OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/QADSPOBJ)

RCVF

MONMSG CPF0864 EXEC(RETURN)

IF COND(&OPTION *EQ 'E') THEN(STRSEU +

SRCFILE(&ODSRCL/&ODSRCF) SRCMBR(&ODSRCM) +

OPTION(2))

ELSE CMD(IF COND(&OPTION *EQ 'D') THEN(STRSEU +

SRCFILE(&ODSRCL/&ODSRCF) SRCMBR(&ODSRCM) +

OPTION(5)))

ELSE CMD(SNDPGMMSG MSG('SOURCE IS LOCATED IN +

MEMBER' *BCAT &ODSRCM *BCAT 'IN FILE' +

*BCAT &ODSRCL *TCAT '/' *CAT &ODSRCF +

*TCAT '.') MSGTYPE(*COMP))

DLTOVR FILE(QADSPOBJ)

CL Programs

Find (Or CREATE) A Source Code For An OBJECT

Unknown

Connect To A Target System Where You Can Sign On As If You Were Attached Locally

STRPASTHR RMTLOCNAME(PRODUCTION) VRTCTL(*NONE) +

RMTUSER(PRODUCTION) RMTPWD(PASSWORD)

ENDPASTHR

CL Programs

Connect To A Target System Where You Can Sign On As If You Were Attached Locally

Unknown

Lookahead field(not an indicator).

Lookahead can be used only with a primary or secondary file.

The indicators specified in these positions are used in conjunction with the record identification codes (positions 21 through 41).

Indicators

Positions 19 and 20 associate an indicator with the record type defined on this line. The normal entry is one of the indicators 01 to 99; however, the control level indicators L1 through L9 and LR can be used to cause certain total steps to be processed. If a control level indicator is specified, lower control level indicators are not set on. The halt indicators H1 through H9 can be used to stop processing. The return indicator (RT) is used to return to the calling program.

When a record is selected for processing and satisfies the conditions indicated by the record identification codes, the appropriate record identifying indicator is set on. This indicator can be used to condition calculation and output operations. Record identifying indicators can be set on or set off by the programmer. However, at the end of the cycle, all record identifying indicators are set off before another record is selected.

Lookahead Fields

The entry of ** is used for the lookahead function. This function lets you look at information in the next record in a file. You can look not only at the file currently selected for processing but also at other files present but not selected during this cycle.

Field description lines must contain From and To entries in the record, a field name, and decimal positions if the field is numeric. Note that a lookahead field may not be specified as a field name or as a data structure name on Input Specifications or as a Result Field on Calculation Specifications.

Positions 15 and 16 must contain an alphabetic entry. The lookahead fields are defined in positions 53 through 58 of the lines following the line containing ** in positions 19 and 20. Positions 59 through 74 must be blank.

Any or all of the fields in a record can be defined as lookahead fields. This definition applies to all records in the file, regardless of their type. If a field is used both as a lookahead field and as a normal input field, it must be defined twice with different names.

The lookahead function can be specified only for primary and secondary files and can be specified only once for a file. It cannot be used for full procedural files (identified by an F in position 16 of the file description specifications), or with AND or OR lines.

When a record is being processed from a combined file or an update file, the data in the lookahead field is the same as the data in the record being processed, not the data in the next record.

The lookahead function causes information in the file information data structure to be updated with data pertaining to the lookahead record, not to the current primary record.

If an array element is specified as a lookahead field, the entire array is classified as a lookahead field.

Lookahead fields are filled with nines when all records in the file have been processed so that the end of the file can be recognized.

AS400

Look ahead

Unknown

To UNLOAD A TAPE

PGM PARM(&DEV &VOL1)

DCL VAR(&DEV ) TYPE(*CHAR) LEN( 10)

DCL VAR(&VOL1 ) TYPE(*CHAR) LEN( 10)

DCL VAR(&MSG ) TYPE(*CHAR) LEN( 256)

CHKTAP DEV(&DEV) VOL(&VOL1) ENDOPT(*UNLOAD)

MONMSG MSGID(CPF0000)

CHGVAR VAR(&MSG) VALUE('Restores completed. Tape ' +

*CAT &DEV *CAT ' Unloaded. Thanks')

SNDMSG MSG(&MSG) TOUSR(*SYSOPR)

END: ENDPGM

CL Programs

To UNLOAD A TAPE

Unknown Wednesday, 29 May 2013

program sets the ATTENTION Key To Call Pre-Defined Program

PGM

SETATNPGM PGM(MYLIBRARY/MYPROGRAM)

CALL MYPROGRAM

ENDPGM

CL Programs

program sets the ATTENTION Key To Call Pre-Defined Program

Unknown

To Retrieve ALL Libraries in QSYS to OUTFILE and Display Them in CL Program

(Command : PRTLIBANL)

PGM

DCLF FILE(QTEMP/OBJLST)

DSPOBJD OBJ(QSYS/*ALL) OBJTYPE(*LIB) +

OUTPUT(*OUTFILE) OUTFILE(QTEMP/OBJLST)

READ: RCVF

MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END))

IF COND((%SST(&ODOBNM 1 1) *EQ 'Q') *OR +

(%SST(&ODOBNM 1 1) *EQ '#')) THEN(GOTO READ)

PRTLIBANL LIB(&ODOBNM)

MONMSG MSGID(CPF0000)

GOTO CMDLBL(READ)

END: ENDPGM

CL Programs

To Retrieve ALL Libraries in QSYS to OUTFILE and Display Them in CL Program (Command : PRTLIBANL)

Unknown

Integrated File System

It is a part of OS/400 that supports stream input/output and storage management.

It comprises 10 file systems, each have its own logical structure and rules for interacting with storage information.

Support for storing the information in stream file.
A hierarchy directory structure. (Objects maintain in Tree structure). Based on this access to object is feasible by specifying the path through the directory.
A common interface enables to the user and applications to access the stream files, database file, documents and other objects

Basic Concept:

Directory:

A directory is a special object that is used to locate objects by names that you specify. Each directory contain list of objects. The directory branches have subordinate branches called as subdirectories.

When your job is started, the system looks in your user profile for the name of your home directory. If it does not exist, the home directory is change to root (/) directory.

Note: /home directory is sub directory under root (/) directory

Link:

A link is a named connection between a directory and an object. A link can be used as a path name or as part of path name.

There are two types of links, Hard Link and Symbolic Links

Item	Hard Link	Symbolic Links
Name resolution	Faster. A hard link have direct reference to object.	Slower. It contains a path name to find the object.
Object existence	Required. An object must be exit.	Optional. It can refer to object that does not exit.
Object deletion	Restricted. It should be unlinked to delete an object.	Unrestricted. The object can be deleted.
Static object (attributes do not change)	Faster. Name resolution is primary performance concern.	Slower.
Scope	Restricted. It cannot cross file system.	Unrestricted. It can cross file system.

Stream file:

It is randomly accessible sequence of bytes, with no further structure imposed by the system.

IFS support for storing and operating information in the form of stream files. The object type is *STMF

Stream file

…………………………………………………………………………

Database file (with Records) (Two records): It has predefined subdivision.

Field 1 field 2 Field N

……………	……………	……………
……………	……………	……………

Note: There are other three concepts which are not covered here, namely Name Continuity, Extended attributes and Scanning support.

Command To Copy To Stream File From Database File:

CPYTOSTMF FROMMBR(&FROMFLD) TOSTMF(&TOFLD)+

STMFOPT(*ADD) STMFCODPAG(*PCASCII)

For file and directory the authority need to be given as public to get the access to user:

CHGAUT OBJ(&TOFLD) USER(*PUBLIC) DTAAUT(*RWX) +

OBJAUT(*ALL)

AS400

Integrated File System

Unknown

RPGLE - Program writes to source physical file then uses CPYTOSTMF

FZZPOOUTD CF E WORKSTN

FSOURCE O E DISK Rename(SOURCE:FMT1) Prefix(X)

F UsrOpn

FSRBPOH IF E K DISK

FSRBPOL IF E K DISK

FSRBPRG IF E K DISK

FXABMAIL IF E K DISK

D*=======================================================

D* Commands for QCMDEXC

D*=======================================================

D* CLRPFM FILE(QGPL/SOURCE) MBR(XXXX)

D CLRPFM DS

D Text1 1 25 Inz('CLRPFM FILE(QGPL/SOURCE) ')

D Text2 26 31 Inz(' MBR(')

D Member1 32 42

D* CRTSRCPF FILE(QGPL/SOURCE) RCDLEN(112) MBR(XXXX)

D CRTSRCPF DS

D Text2A 1 27 Inz('CRTSRCPF FILE(QGPL/SOURCE)')

D Text2B 28 44 Inz(' RCDLEN(112) MBR(')

D Member2 45 55

D* ADDPFM FILE(QGPL/SOURCE) MBR(JAMIEF)

D ADDPFM DS

D Text2C 1 29 Inz('ADDPFM FILE(QGPL/SOURCE) MBR(')

D Member3 30 41

D* OVRDBF FILE(MODELS) TOFILE(QGPL/SOURCE) MBR(XXXX)

D OVRDBF DS

D Text3 1 27 Inz('OVRDBF FILE(SOURCE) TOFILE')

D Text4 27 44 Inz('(QGPL/SOURCE) MBR(')

D Member4 45 55

D* CPYTOSTMF FROMMBR('/QSYS.LIB/QGPL.LIB/SOURCE.FILE/OUTP.MBR')

D* TOSTMF('/RJAPO/%%%%%%%%%%/#########.###')

D* STMFOPT(*REPLACE)

D CPYTOSTMF DS

D Text5 1 25 Inz('CPYTOSTMF FROMMBR(''/QSYS')

D Text6 25 44 Inz('.LIB/QGPL.LIB/SOURCE')

D Text7 45 50 Inz('.FILE/')

D Member5 51 70

D Text8 71 79 Inz(' TOSTMF(''')

D TheRest 80 256

D* del 'RJAPO/&USER/#######.###'

D DEL DS

D Text13 1 11 Inz('Del ''RJAPO/')

D TheRest2 12 256

D MD DS

D Text14 1 11 Inz('md ''RJAPO/')

D Directory 11 40

D ADDLIBLE DS

D Text15 1 22 Inz('addlible busintl *Last')

D ISODate S D

D InPO S 7

D DecPO S 7 0

D Str S 3 0

D End S 4 0

D Len S 4 0

D Count S 4 0

D Loop S 4 0

D #Fnd S 4 0

D InCode S 10

D @Scrn1 S 01 Inz('Y')

D CURRENTMO S 2 0

D X S 2 0

D Dec12 S 12 0

D Chr12 S 12

D OutDsm S 03 Inz('HAN')

D OutAddress S 40

D OutLoc S 50

D Name S 09

D Chr1 S 01

D ScreenError S 1

D MONTH S 2

D CURRENTYR S 4 0

D YEAR S 4

D PYear1 S 4

D PYear2 S 4

D PYear3 S 4

D FlagNo S 1 Inz('N')

D CmdString S 256

D CmdLength S 15 5

D* Program Info

D SDS

D @PGM 001 010

D @PARMS 037 039 0

D @JOB 244 253

D @USER 254 263

D @JOB# 264 269 0

C*============================================================

C* M A I N L I N E

C*============================================================

C @User Chain XABMAIL

C If %Found(XABMAIL)

C Eval W1EMAIL = %Trim(W1EMAIL) +

C %trim(XAEADR) +

C %trim('@Code400.com')

C Else

C Eval W1EMAIL = 'SomeOne@Code400.com'

C Endif

C Reset @Scrn1

C Dow @Scrn1 = 'Y'

C Exfmt WIN1

C Select

C When *In03 Or *In12

C Clear @Scrn1

C Other

C Exsr $Valid

C If ScreenError = *Blanks

C Exsr $ReadIt

C Exsr $Email

C Eval W1MSG = 'File sent to Folder & Emailed'

C Clear W1PO

C Endif

C Endsl

C Enddo

C Eval *INLR = *On

C*=============================================================

C* $ReadIt - Read the PO data

C*=============================================================

CSR $ReadIt Begsr

C Exsr $Open

C Move W1PO DecPO

C PoKey01 Chain SRBPOH

C If %Found(SRBPOH)

C PoKey01 Setll SRBPOL

C PoKey01 Reade SRBPOL

C Dow Not%Eof(SRBPOL)

C If OLSTAT <> 'D'

C Z-add OLOQTY Dec12

C Move Dec12 Chr12

C Do 12 X

C Eval Chr1 = %Subst(Chr12:X:1)

C If Chr1 <> '0'

C Leave

C Endif

C Enddo

C OLPRDC Chain SRBPRG

C If %Found(SRBPRG)

C Eval XSRCDTA = %Trim(XSRCDTA) +

C %Trim('"') + %Trim(PGPRDCS2) +

C %Trim('",')

C + %Trim(%Subst(Chr12:X))

C Write FMT1

C Clear XSRCDTA

C Endif

C PoKey01 Reade SRBPOL

C Enddo

C Endif

C EXSR $StreamIt

C Endsr

C*=============================================================

C* $Open - reset the overides for each DSM to build

C*=============================================================

CSR $Open Begsr

C* Setup member name(s)

C Eval Member1 = %Trim(NAME) + %Trim(')')

C Eval Member2 = %Trim(NAME) + %Trim(')')

C Eval Member3 = %Trim(NAME) + %Trim(')')

C Eval Member4 = %Trim(NAME) + %Trim(')')

C Eval Member5 = %Trim(NAME) + %Trim('.MBR/'')' )

C If %Open(SOURCE)

C Close SOURCE

C Endif

C* Clear the source file and do data base override

C Movel(p) CRTSRCPF CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C* Add member that is the name

C Movel(p) ADDPFM CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C Movel(p) CLRPFM CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C Movel(p) OVRDBF CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C If Not%Open(SOURCE)

C Open SOURCE

C Endif

C* Create the IFS folder by user profile

C Eval Directory = %Trim(name) +

C %Trim('''')

C Movel(p) MD CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C Endsr

C*=============================================================

C* $StreamIt - Streamfile the data.

C*=============================================================

C $StreamIt Begsr

C If %Open(SOURCE)

C Close SOURCE

C Endif

C* Delete old one by same PO Number

C Eval TheRest2 = %Trim(NAME)

C +%Trim('/') + %Trim('PO') +

C %Trim(W1PO) + %Trim('.csv')

C + %Trim('''')

C Movel(p) DEL CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C* Build the stream file command 'RJAPO/&USER/#######.###'

C Eval TheRest = %Trim('RJAPO/') +

C %Trim(NAME) +

C %Trim('/') +

C %Trim('PO') + %Trim(W1PO) +

C %Trim('.csv') + %Trim(''')')

C + ' STMFOPT(*REPLACE)'

C + ' STMFCODPAG(*PCASCII)'

C Eval OutLoc =

C %Trim('RJAPO/') +

C %Trim(NAME) +

C %Trim('/') +

C %Trim('PO') + %Trim(W1PO) +

C %Trim('.csv')

C Movel(p) CPYTOSTMF CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C Endsr

C*=============================================================

C* $Valid - Check screen entries

C*=============================================================

CSR $Valid Begsr

C Clear ScreenError

C Clear W1MSG

C If W1PO = *Blanks Or W1PO = '0000000'

C Eval W1MSG = 'Invalid PO Entered.'

C Eval ScreenError = 'Y'

C Else

C Move W1PO DecPO

C PoKey01 Chain SRBPOH

C If Not%Found(SRBPOH)

C Eval W1MSG = 'Invalid PO Entered.'

C Eval ScreenError = 'Y'

C Endif

C Eval Name = %Trim('PO') + %Trim(W1PO)

C Endsr

C*=============================================================

C* $Email - Email this to someone

C*=============================================================

CSR $Email Begsr

C Call 'BICTL02C'

C Parm OutDsm

C Parm W1Email OutAddress

C Parm OutLoc

C Endsr

C*=============================================================

C* *Inzsr - Initial one time run subroutine.

C*=============================================================

C *Inzsr Begsr

C* Klist(s)

C PoKey01 Klist

C Kfld FlagNo

C Kfld DecPO

C *MDY Move UDATE ISODate

C Movel(p) ADDLIBLE CmdString

C Eval Len = %Len(%Trim(CmdString))

C Call 'QCMDEXC' 99

C Parm CmdString

C Parm Len CmdLength

C Endsr

C*=============================================================

RPGLE Programs

source physical file then uses CPYTOSTMF

Unknown

Subscribe to: Posts ( Atom )