0% found this document useful (0 votes)
131 views

New Text Document

This document contains information about displaying user space data in RPG, including URLs, code snippets, and screen layout information. It provides the logic to retrieve data from a user space, load it into an array, and display it across multiple pages in a subfile with navigation buttons. Key details include calling the QUSPTRUS API to get a pointer to the user space data, loading each record into an array, writing the array to a subfile, and handling overflow to additional pages.

Uploaded by

sirajse
Copyright
© Attribution Non-Commercial (BY-NC)
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
131 views

New Text Document

This document contains information about displaying user space data in RPG, including URLs, code snippets, and screen layout information. It provides the logic to retrieve data from a user space, load it into an array, and display it across multiple pages in a subfile with navigation buttons. Key details include calling the QUSPTRUS API to get a pointer to the user space data, loading each record into an array, writing the array to a subfile, and handling overflow to additional pages.

Uploaded by

sirajse
Copyright
© Attribution Non-Commercial (BY-NC)
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 17

jobs@bankislami.com.pk,careerislami.b@hotmail.

com
http://www.youtube.com/watch?v=iA5EsqLBxrU
http://www.youtube.com/watch?v=lTmYU_y8fZY&feature=related
Net to fax
http://sendfreefax.net/send-free-fax-Pakistan.php

JOOMLA
http://hotfile.com/dl/11364941/f2aed14/Beginning_Joomla.7z.html

Schedule Appointment
Seat Availability
View Test Site Web Site
SOFTWORLD INTERNATIONAL PVT LTD
Karachi, Sind 74200
Phone: 2626380-81 Site Code: PK52
Room No 406 4th Floor
Landmark Plaza
Off I I Chundrigar Road
Opposite Jang Press

http://rpgiv.info
1--------
Remove blanks in a string
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Apr 21, 2010 at 05:46 AM
C eval refIdx = 1
C movea TmTrnRf refArray
C dow refIdx <= 50
C if refArray(refIdx) <> *Blanks
C eval crtTrnRef = %trim(crtTrnRef) +
C refArray(refIdx)
C endif
C eval refIdx += 1
C enddo
C eval TmTrnRf = crtTrnRef

2-------
Display User Space
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Apr 15, 2010 at 02:53 AM
Thanks to code400.com

RPG Program
FUSRSPCD cf e workstn sfile(sfl001:sflrn1)
F infds(wsds)
** Width of subfile record
D limit c const(70)
** Number of subfile records
D norecs c const(12)
D SpaceLib s 20
D spcptr s *
* API Error Data Structure
D api_err ds
D errbytes 1 4b 0
D errbytesava 5 8b 0
D exception 9 15
D reserved 16 16
D data 17 271
D spcarray s 1a based(lineptr)
D Dim(Limit)
D lineptr s * inz(%addr(spline))
D spcdstr ds based(spcptr)
D spcdata 1a
D nextbyte 1a
D index s 5p 0
D count s 5p 0
D sflrn1 s 4p 0
D returnpt s 6a
D pgmsds sds
D @@@pgm 1 10
D @@@sts 11 15 0
D @@@stp 16 20
D @@@seq 21 28
D @@@psr 29 36
D @@@prm 37 39 0
D @@@typ 40 42
D @@@nbr 43 46
D @@@smi 47 50
D @@@ara 51 80
D @@@lib 81 90
D @@@dta 91 170
D @@@sid 171 174
D @@@rs1 175 200
D @@@fil 201 208
D @@@fis 209 243
D @@@job 244 253
D @@@usr 254 263
D @@@jbn 264 269 0
D @@@jdt 270 275 0
D @@@pgd 276 281 0
D @@@pgt 282 287 0
D @@@cmd 288 293
D @@@cmt 294 299
D @@@cml 300 303
D @@@src 304 313
D @@@srl 314 323
D @@@srm 324 333
D @@@rs2 334 429
*
* Standard include for all interactive programs
* named hexadecimal constants for function keys
D @f01 c const(x'31')
D @f02 c const(x'32')
D @f03 c const(x'33')
D @f04 c const(x'34')
D @f05 c const(x'35')
D @f06 c const(x'36')
D @f07 c const(x'37')
D @f08 c const(x'38')
D @f09 c const(x'39')
D @f10 c const(x'3A')
D @f11 c const(x'3B')
D @f12 c const(x'3C')
D @f13 c const(x'B1')
D @f14 c const(x'B2')
D @f15 c const(x'B3')
D @f16 c const(x'B4')
D @f17 c const(x'B5')
D @f18 c const(x'B6')
D @f19 c const(x'B7')
D @f20 c const(x'B8')
D @f21 c const(x'B9')
D @f22 c const(x'BA')
D @f23 c const(x'BB')
D @f24 c const(x'BC')
D @clear c const(x'BD')
D @enter c const(x'F1')
D @help c const(x'F3')
D @pagup c const(x'F4')
D @pagdn c const(x'F5')
D @print c const(x'F6')
* Standard include for all interactive programs
* display file information data structure
D wsds ds
* Identifies the key pressed
D key 369 369
* Identifies the subfile page rrn
D pagrrn 378 379b 0
*
C call 'QUSPTRUS'
C parm SpaceLib
C parm spcptr
C parm api_err
C write cmdfmt
C exsr loadnext
C dow key <> @f03
** Error trap - fell off the end of the Space - display last screen
C PtrError Tag
C select
C when key = @pagdn
C exsr loadnext
C exfmt sflctl
C other
C eval pos = 1
C exfmt sflctl
C endsl
C enddo
C eval *inlr = *on
C return
C *inzsr begsr
c *entry plist
c parm SpaceLib
c eval Space = %subst(Spacelib:1:10)
c eval Lib = %subst(Spacelib:11:10)
C eval sflrn1 = 1
C eval pos = 1
C endsr
C loadnext begsr
C eval count = 1
C dow (count <= norecs) and (not *in99)
C do limit index
C If SpcData < X'40'
C Eval SpcArray(Index) = X'41'
C Else
C eval spcarray(index) = spcdata
C Endif
C eval spcptr = %addr(nextbyte)
C enddo
C eval line# = (sflrn1 * limit) - (limit - 1)
C write sfl001
C eval spline = *blanks
C eval sflrn1 = sflrn1 + 1
C eval count = count + 1
C enddo
C eval pos = sflrn1 - 1
C endsr
C *Pssr Begsr
c Select
** Overflowed User Space - complete last line and display
C When @@@sts= 00222
C Eval *In99 = *ON
C eval line# = (sflrn1 * limit) - (limit - 1)
C Write Sfl001
C Eval Pos = sflrn1 - 1
C Exfmt SflCtl
C Other
C Endsl
C GoTo PtrError
C Endsr
Screen
A DSPSIZ(24 80 *DS3)
A CA03
A R SFL001 SFL
A LINE# 5Y 0O 8 2EDTCDE(3)
A SPLINE 70A O 8 8
A R SFLCTL SFLCTL(SFL001)
A SFLSIZ(0013)
A SFLPAG(0012)
A PAGEDOWN
A CA12
A OVERLAY
A N85 SFLDSP
A N85 SFLDSPCTL
A 85 SFLCLR
A 99 SFLEND(*MORE)
A POS 4S 0H SFLRCDNBR
A @@@PGM 10A O 1 3
A 1 29'Display User Space Data'
A DSPATR(HI)
A 1 73DATE
A EDTCDE(Y)
A @@@USR 10A O 2 3
A 2 73TIME
A 4 3'User Space ...:'
A DSPATR(HI)
A SPACE 10A O 4 19
A 5 3'Library ......:'
A DSPATR(HI)
A LIB 10A O 5 19
A 7 8'*...+....1....+....2....+....3....-
A +....4....+....5....+....6....+....-
A 7'
A FLD001 3 B 4 40RANGE('000' '999')
A CHECK(RZ)
A R CMDFMT
A 22 2'F3=Exit'
A COLOR(BLU)
3-------------
Split large String into two parts
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Apr 06, 2010 at 05:54 AM
D AmtInWordP1 S 61
D AmtInWordP2 S 84
D FullAmtWord S 145
D TotLen S 2 0
D Pos S 2 0
C Eval FullAmtWord = %Trim(p@words) + ' ONLY'
C Eval AmtInWordP1 = %SubSt(FullAmtWord : 1 : 61)
C Eval AmtInWordP2 = %SubSt(FullAmtWord :62 : 84)
C If AmtInWordP2 <> *Blanks
C Eval TotLen = 61
C Eval Pos = *Zeros
C Dow TotLen >= 1
C Eval TotLen -= 1
C Eval Pos = %Scan(' ' : AmtInWordP1 : TotLen)
C If Pos <> *Zeros
C Leave
C EndIf
C Eval TotLen -= 1
C EndDo
C Eval AmtInWordP1 = *Blanks
C Eval AmtInWordP1 = %SubSt(FullAmtWord : 1 : Pos)
C Eval AmtInWordP2 = *Blanks
C Eval AmtInWordP2 = %SubSt(FullAmtWord :Pos+1 : 84)
C EndIf
C Eval $AMTW1 = AmtInWordP1
C Eval $AMTW2 = AmtInWordP2

4--------
Display List of the Environment Variables
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Mar 23, 2010 at 03:46 AM
Thanks to Scott Klement's post on SystemiNetwork

H DFTACTGRP(*NO) ACTGRP(*NEW)
D QUILNGTX PR ExtPgm('QUILNGTX')
D text 65535a const options(*varsize)
D length 10i 0 const
D msgid 7a const
D qualmsgf 20a const
D errorCode 20i 0 const
D Qp0zInitEnv pr 10i 0 extproc('Qp0zInitEnv')
D environ s * import('environ')
D env s * dim(32767)
D based(environ)
D x s 10i 0
D data s 65535a varying
/free
Qp0zInitEnv();
for x = 1 to %elem(env);
if env(x) = *null;
leave;
endif;
data = %str(env(x));
QUILNGTX( data: %len(Data): *blanks: *blanks: 0);
endfor;
*inlr = *on;
/end-free

5-----
Convert ASCII to/from EBCDIC
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Mar 09, 2010 at 05:18 AM
-------------- Member: TESTCONV ----------------------------
D/COPY ICONV_H
D TestMe S 5A
** Example of converting to EBCDIC:
c eval TestMe = x'48454c4c4f'
c callp ToEBCDIC(TestMe: %size(TestMe))
** And converting back to ASCII:
c eval TestMe = 'HELLO'
c callp ToASCII(TestMe: %size(TestMe))
c eval *inlr = *on

-------------- Member: ICONV_H -----------------------


D ToASCII PR 10I 0
D peBuffer 32766A options(*varsize)
D peBufSize 10U 0 value
D ToEBCDIC PR 10I 0
D peBuffer 32766A options(*varsize)
D peBufSize 10U 0 value

--------- member: ICONVR4 --------------------------------


H NOMAIN
D/COPY ICONV_H
D iconv_open PR 52A ExtProc('QtqIconvOpen')
D ToCode * value
D FromCode * value
D iconv PR 10I 0 ExtProc('iconv')
D Descriptor 52A value
D p_p_inbuf * value
D in_left 10U 0
D p_p_outbuf * value
D out_left 10U 0
D InitIConv PR 10I 0
D peWhich 10A const
D dsToASC DS
D ICORV_A 10I 0
D ICOC_A 10I 0 dim(12)
D dsToEBC DS
D ICORV_E 10I 0
D ICOC_E 10I 0 dim(12)
D dsASCII DS
D ascii_cp 10I 0 INZ(437)
D ascii_ca 10I 0 INZ(0)
D ascii_sa 10I 0 INZ(0)
D ascii_ss 10I 0 INZ(1)
D ascii_il 10I 0 INZ(0)
D ascii_eo 10I 0 INZ(1)
D ascii_r 8A INZ(*allx'00')
D dsEBCDIC DS
D ebcdic_cp 10I 0 INZ(37)
D ebcdic_ca 10I 0 INZ(0)
D ebcdic_sa 10I 0 INZ(0)
D ebcdic_ss 10I 0 INZ(1)
D ebcdic_il 10I 0 INZ(0)
D ebcdic_eo 10I 0 INZ(1)
D ebcdic_r 8A INZ(*allx'00')
D wkXLInit S 1A INZ(*OFF)
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This initializes the iconv() API for character conversion
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P InitIConv B
D InitIConv PI 10I 0
D peWhich 10A const
C* Don't initialize more than once:
c if wkXLInit = *ON
c return 0
c endif
* Initialize ASCII conv table:
c if peWhich <> '*EBCDIC'
c eval dsToASC = iconv_open(%addr(dsASCII):
c %addr(dsEBCDIC))
c if ICORV_A < 0
c return -1
c endif
c endif
* Initialize EBCDIC conv table:
c if peWhich <> '*ASCII'
c eval dsToEBC = iconv_open(%addr(dsEBCDIC):
c %addr(dsASCII))
c if ICORV_E < 0
c return -1
c endif
c endif
c eval wkXLInit = *ON
c return 0
P E

*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Translate a buffer from EBCDIC codepage 37 to ASCII 819
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P ToASCII B Export
D ToASCII PI 10I 0
D peBuffer 32766A options(*varsize)
D peBufSize 10U 0 value
D p_Buffer S *
c if initiconv('*BOTH') < 0
c return -1
c endif
c eval p_buffer = %addr(peBuffer)
c return iconv(dsToASC: %addr(p_buffer):peBufSize:
c %addr(p_buffer): peBufSize)
P E

*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Translate a buffer from ASCII codepage 819 to EBCDIC 37
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P ToEBCDIC B Export
D ToEBCDIC PI 10I 0
D peBuffer 32766A options(*varsize)
D peBufSize 10U 0 value
D p_Buffer S *
c if initiconv('*BOTH') < 0
c return -1
c endif
c eval p_buffer = %addr(peBuffer)
c return iconv(dsToEBC: %addr(p_buffer):peBufSize:
c %addr(p_buffer): peBufSize)
P E

6-------
Retrieve DB Trigger Information
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Mar 08, 2010 at 10:50 PM
Thanks to i5tools web site

**********************************************************************
* Retrieve DB Trigger Information
**********************************************************************
* API's Used:
*
* Retrieve Database File Description (QDBRTVFD) API
* Format FILD0100
**********************************************************************
*
**********************************************************************
* Modification History:
*
*
* Mod# Date Who Description
* ----- -------- ----------- --------------------------------------
*
**********************************************************************
H/IF DEFINED(*CRTBNDRPG)
H DFTACTGRP(*NO)
H/ELSE
H NOMAIN
H/ENDIF
H OPTION(*SRCSTMT:*NODEBUGIO)
H EXTBININT(*YES)
* File Definition Header (Qdb_Qdbfh) - FILD0100
D Qdb_Qdbfh Ds based(PtrH)
d Qdbfyret 9b 0
d Qdbfyavl 9b 0
d Qdbfhflg 2
d 4
d Qdbflbnum 4b 0
d Qdbfknum 4b 0
d Qdbfkmxl 4b 0
d Qdbfkflg 1
d Qdbfkfdm 1
d 8
d Qdbfhaut 10
d Qdbfhupl 1
d Qdbfhmxm 4b 0
d Qdbfwtfi 4b 0
d Qdbfhfrt 4b 0
d Qdbfhmnum 4b 0
d 9
d Qdbfbrwt 4b 0
d Qaaf 1
d Qdbffmtnum 4b 0
d Qdbfhfl2 2
d Qdbfvrm 4b 0
d Qaaf2 2
d Qdbfhcrt 13
d 2
d qdbfhtxt 50
d 13
d Qdbfsrcf 10
d Qdbfsrcm 10
d Qdbfsrcl 10
d Qdbfkrcv 1
d 23
d Qdbftcid 5u 0
d Qdbfasp 2
d 1
d Qdbfmxfnum 4b 0
d 76
d Qdbfodic 9b 0
d 14
d Qdbffigl 4b 0
d Qdbfmxrl 4b 0
d 8
d Qdbfgkct 4b 0
d Qdbfos 9b 0
d 8
d Qdbfocs 9b 0
d 4
d Qdbfpact 2
d Qdbfhrls 6
d 20
d Qdbpfof 9b 0
d Qdblfof 9b 0
d Qdbfnlsb 1
d Qdbflang 3
d Qdbfcnty 2
d Qdbfjorn 9b 0
d 18
* Physical File Specific Attributes (Qdb_Qdbfphys)- FILD0100
D Qdb_Qdbpf Ds based(PtrA)
D qdbfpAlc 2
D qdbfcMPs 1
D Qdbfoff_sqpt 4b 0
D Reserved_29 4b 0
D Qdbfprnum 4b 0
D qdbpRNum 9b 0
D qdbfpRI 4b 0
D qdbRINum 4b 0
D qdbfORID 9b 0
D qdbBits33 1
D qdbfOTrg 9b 0
* Offset to Trigger (qdbftrg)
D qdbfTrgN 4b 0
* No of triggers
D qdbfOFCS 9b 0
D qdbfCstN 9b 0
D qdbfODL 9b 0
D 6
* Trigger Description Area (Qdb_Qdbftrg)- FILD0100
D Qdb_Qdbftrg Ds based(PtrT)
D qdbfTrgT 1
D qdbfTrgE 1
D qdbfTPgm 10
D qdbfTPLb 10
D qdbfTUpd 1
D qdbBits69 1
D 24
* API Error Structure - ERRC0200 format
D ERRC0200Ds Ds inz qualified
D MsgKey 10i 0 inz(-1)
D BytesProv 10i 0 inz(%size(ERRC0200Ds.MsgData))
D BytesAval 10i 0
D MsgID 7a
D filler 1a
D cCCSID 10i 0
D OffMsgData 10i 0
D LenMsgData 10i 0
D MsgData 32767a

* QDBRTVFD Receiver
D QDBRTVFDRcv s 32766a
D NbrTrg s 10i 0
D NxtTrg s 10i 0
D Nxt s 10i 0
D PtrD s * inz
D Ptr s * inz
* Trigger Info
D TrgDs Ds qualified
D TrgTime 10a
D TrgEvent 10a
D TrgCond 10a
D qdbfTPgm 10a
D qdbfTPLb 10a
* Prototypes
* Retrieve File Description - FILD0100
D RtvFileDesc Pr
D pFile 20a const
* Retrieve File Description - FILD0400
D RtvFileDesc4 Pr
D pFile 20a const
* Retrieve Triggers
D RtvTriggers Pr
* Retrieve Database File Description (QDBRTVFD) API
D QDBRTVFD Pr extpgm('QDBRTVFD')
D pRtnRcvVar 32766a const options(*varsize)
D pLenRcvVar 10i 0 const
D pRtnFileLib 20a const
D pFmtName 10a const
D pInFileLib 20a const
D pInRecFmt 10a const
D pOvrProc 1a const
D pSystem 10a const
D pFmtType 10a const
D APIerrorDS Like(ERRC0200Ds)
* Entry Parameters
D Main PR extpgm('DSPTRG2R')
D 20a
D Main PI
D pFileLib 20a
/free
*inlr=*on;
// Retrieve File Description - FILD0100
RtvFileDesc(pFileLib);
// Retrieve List Of Triggers
If qdbfTrgN > 0;
RtvTriggers();
Endif;
/end-free
**************************************************************
* Get file description
**************************************************************
p RtvFileDesc b export
D pi
D pFile 20a const
D RtnFile s 20a
/free
// Retrieve Object Description
QDBRTVFD( QDBRTVFDRcv : %size(QDBRTVFDRcv) : RtnFile :
'FILD0100' : pFile : '*FIRST' :
'0' : '*LCL' : '*INT' : Errc0200Ds );
if ERRC0200Ds.BytesAval > 0;
//Exsr SendMsg;
Endif;
PtrH = %addr(QDBRTVFDRcv);
PtrA = PtrH + Qdbpfof;
return;
/end-free
p RtvFileDesc e
**************************************************************
* Retrieve Triggers - FILD0100
**************************************************************
p RtvTriggers b export
d pi
/free
//NxtTrg = Qdbfotrg + 1;
PtrT = PtrH + Qdbfotrg;
For Nxt = 1 To qdbfTrgN;
TrgDs.qdbfTPgm = qdbfTPgm;
TrgDs.qdbfTPLb = qdbfTPLb;
// Trigger Time
select;
when qdbfTrgT = '1';
TrgDs.TrgTime= 'After';
when qdbfTrgT = '2';
TrgDs.TrgTime= 'Before';
other;
clear TrgDs.TrgTime;
EndSl;
// Trigger Event
select;
when qdbfTrgE = '1';
TrgDs.TrgEvent = 'Insert';
when qdbfTrgE = '2';
TrgDs.TrgEvent = 'Delete';
when qdbfTrgE = '3';
TrgDs.TrgEvent = 'Update';
when qdbfTrgE = '4';
TrgDs.TrgEvent = 'Read';
other;
clear TrgDs.TrgEvent;
EndSl;
// Trigger Condition
If TrgDs.TrgEvent = 'Update';
select;
when qdbfTUpd = '1';
TrgDs.TrgCond = 'Always';
when qdbfTUpd = '2';
TrgDs.TrgCond = 'Change';
other;
clear TrgDs.TrgCond;
EndSl;
else;
Clear TrgDs.TrgCond;
Endif;
PtrT = PtrT + %Size(qdb_qdbfTrg);
EndFor;
/end-free
p RtvTriggers e

7------
Retrieve Job Status (QWCRJBST) API
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Mar 08, 2010 at 10:49 PM
Thanks to i5tools web site

**************************************************************************
* Retrieve Job Status (QWCRJBST) API
**************************************************************************
* Common API Error Structure
D APIErrDs DS
D APIBytes 10I 0 Inz(%size(APIErrDs))
D APIBytesOut 10I 0
D APIErrID 7A
D APIReserved 1A
D APIErInDta 256A

* API Receiver Structure for QWCRJBST


D QWCRJBSTrcv DS
D BytesRtn 10I 0
D BytesAvl 10I 0
D JobStatus 10A
D IntJobID 16A
D QualJobName 26A
* Retrieve Job Status (QWCRJBST) API
d RtvJobSts PR ExtPgm('QWCRJBST')
d pRcvVar likeds(QWCRJBSTrcv)
d pRcvVarLen 10i 0
d pJobID 26a
d pFormat 8a
d pAPIError likeds(APIErrDs)
D RtnMsg S 50A
* API Parameters
D RcvrLen S 10I 0 Inz(%size(QWCRJBSTrcv))
D JobIDFmt S 8A Inz('JOBS0300')
D JobID S 26A
* Parameters
D Main Pr extpgm('RTVJOBSTAT')
D 10a
D 10a
D 6a
* Parameters
D Main Pi
D pJobName 10a
D pUserID 10a
D pJobNbr 6a
/free
JobID = pJobName + pUserID + pJobNbr;
RtvJobSts( QWCRJBSTrcv : RcvrLen : JobID : JobIDFmt : APIErrDs );
RtnMsg = 'The Job Status is: ' + JobStatus;
Dsply '' ' ' RtnMsg;
Return;
/end-free
8--------
Write to Job Log
User Rating: / 0
PoorBest
Written by Admin (Chamara)
Mar 03, 2010 at 11:45 PM
H BNDDIR('QC2LE')
H OPTION(*SRCSTMT) DFTACTGRP(*NO)
D writeJobLog PR 10I 0 ExtProc('Qp0zLprintf')
D logMsg * Value OPTIONS(*STRING)
D s1 * Value OPTIONS(*STRING:*NOPASS)
D s2 * Value OPTIONS(*STRING:*NOPASS)
D s3 * Value OPTIONS(*STRING:*NOPASS)
D s4 * Value OPTIONS(*STRING:*NOPASS)
D s5 * Value OPTIONS(*STRING:*NOPASS)
D s6 * Value OPTIONS(*STRING:*NOPASS)
D s7 * Value OPTIONS(*STRING:*NOPASS)
D s8 * Value OPTIONS(*STRING:*NOPASS)
D s9 * Value OPTIONS(*STRING:*NOPASS)
D s10 * Value OPTIONS(*STRING:*NOPASS)
/free
writeJobLog('Invalid Customer Number %s %s' :
'1234' :
'ABC Customer');
writeJobLog(X'25');
*INLR = *ON;
/end-free

9-------
Centering Text in RPG IV
User Rating: / 1
PoorBest
Written by Admin (Chamara)
Feb 18, 2010 at 04:36 AM
//=================================================================//
// Procedure: center //
//-----------------------------------------------------------------//
// Center text within field of specified length. //
// //
// Parameters: //
// I: instr -- string to center //
// I: len -- length of field to center within //
// //
// Returns: String of length "len" with text "instr" centered //
// within. //
//=================================================================//
P center b
D center pi 100a varying
D instr 100a value varying
D len 10i 0 value
D outstr s 100a varying
D pos s 10i 0
/free
// Check if input string is bigger than desired output
instr = %trim(instr);
if %len(instr) > len;
%len(instr) = len;
endif;
// Find position of centered string in output
pos = %div(len - %len(instr):2) + 1;
// Build and return centered output string
%len(outstr) = len;
%subst(outstr:pos) = instr;
return outstr;
/end-free
P center e
10-----------

You might also like

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy