× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Here's a third method, whether these are cleaner/more intuitive is
debatable :)

For BATCH processing, I always include common copybooks to handle standard
print output (QPRINT) - which includes the following definitions in a
print "work area" copybook:

03 QUSRJOBI-Variables.
05 h1-RcvrVar.
10 filler pic s9(09) Binary.
10 filler pic s9(09) value 273 Binary.
10 h1-RvJobName pic x(10) value spaces.
10 h1-RvJobUser pic x(10) value spaces.
10 h1-RvJobNbr pic x(06) value spaces.
10 filler pic x(229).
10 filler pic x(10).
05 h1-LenRcvrVar pic s9(09) value 273 Binary.
05 h1-FmtName pic x(08) value 'JOBI0400'.
05 h1-QlJobName pic x(26) value '*'.
05 h1-IntJobId pic x(16) value ' '.
05 h1-ApiErr.
10 filler pic s9(09) value 272 Binary.
10 filler pic s9(09) Binary.
10 h1-AeMsgId pic x(07) value spaces.
10 filler pic x(01).
10 h1-AeMsgDta pic x(256) value spaces.

In a common call routine to print page headings, the User-Id is
retrieved on first call:

call 'QUSRJOBI' using h1-RcvrVar
h1-LenRcvrVar
h1-FmtName
h1-QlJobName
h1-IntJobId
h1-ApiErr

You then have access to the Job Name, Job Number and User-Id.
.
.
.
For Interactive programs, define the display area attributes under
Special-Names:

special-names. attribute-data is at-area.

Then define the layout of the attribute area. This is defined in the
Display File programming guide (setup as another copybook).

*---> Attribute Data
* copy copyatr of include suppress.

Here is the copybook contents (among other things):

01 atr-area global.
05 atr-pgm-devname pic x(10) value spaces.
05 atr-dev-desc pic x(10) value spaces.
05 atr-user-id pic x(10) value spaces.
05 atr-dev-class pic x(01) value spaces.
05 atr-dev-type pic x(06) value spaces.
05 atr-req-dev pic x(01) value spaces.
05 atr-acq-status pic x(01) value spaces.
05 atr-inv-status pic x(01) value spaces.
05 atr-data-status pic x(01) value spaces.
05 atr-disp-dim.
10 atr-nbr-rows pic s9(04) value +0 comp-4.
10 atr-nbr-cols pic s9(04) value +0 comp-4.
05 atr-disp-blink pic x(01) value spaces.
05 atr-off-status pic x(01) value spaces.
05 atr-disp-locn pic x(01) value spaces.
05 atr-disp-type pic x(01) value spaces.
05 atr-kbd-type pic x(01) value spaces.
05 atr-conv-status pic x(01) value spaces.
05 atr-sync-level pic x(01) value spaces.
05 atr-conv-used pic x(01) value spaces.
05 atr-rloc-name pic x(08) value spaces.
05 atr-llu-name pic x(08) value spaces.
05 atr-local-netid pic x(08) value spaces.
05 atr-rlu-name pic x(08) value spaces.
05 atr-remote-netid pic x(08) value spaces.
05 atr-mode pic x(08) value spaces.
05 atr-work-control pic x(01) value spaces.
05 atr-color-display pic x(01) value spaces.
05 atr-allow-grid pic x(01) value spaces.
05 atr-lu6-state pic x(01) value spaces.
05 atr-lu6-conv pic x(08) value spaces.
05 filler pic x(31) value spaces.
05 atr-calling-party.
10 atr-rem-nbrlen pic s9(04) value +0 comp-4.
10 atr-rem-nbrtyp pic x(02) value spaces.
10 atr-rem-nbrpln pic x(02) value spaces.
10 atr-rem-nbr pic x(40) value spaces.
10 filler pic x(04) value spaces.
10 atr-rem-sublen pic s9(04) value +0 comp-4.
10 atr-rem-subtyp pic x(02) value spaces.
10 atr-rem-subadr pic x(40) value spaces.
10 filler pic x(01) value spaces.
10 atr-call-type pic x(01) value spaces.
10 atr-rem-adrlen pic s9(04) value +0 comp-4.
10 atr-rem-addr pic x(40) value spaces.
10 filler pic x(04) value spaces.
10 atr-rem-extlen pic s9(04) value +0 comp-4.
10 atr-rem-exttyp pic x(01) value spaces.
10 atr-rem-extadr pic x(40) value spaces.
10 filler pic x(04) value spaces.
10 atr-x25-calltyp pic x(01) value spaces.
05 atr-txn-progname pic x(64) value spaces.
05 atr-lu6-protected.
10 atr-lu6-len pic s9(04) value +0 comp-4.
10 atr-net-qual pic x(17) value spaces.
10 atr-inst-nbr pic x(06) value spaces.
10 atr-seq-nbr pic s9(04) value +0 comp-4.
05 atr-lu6-unprotected.
10 atr-lu6-ulen pic s9(04) value +0 comp-4.
10 atr-net-uqual pic x(17) value spaces.
10 atr-inst-unbr pic x(06) value spaces.
10 atr-seq-unbr pic s9(04) value +0 comp-4.

After opening the display file, retrieve the attributes using ACCEPT
and you now have access to the User-Id (along with other data):

*---> Get User-Id
accept atr-area from at-area
move atr-user-id to ws-userid

Because most of this is included in copybooks (which are automatically
generated via a homegrown COBOL code generator) - it makes life easy
for me...lol

Terry

-----Original Message-----
From: COBOL400-L [mailto:cobol400-l-bounces@xxxxxxxxxxxx] On Behalf Of Stone, Joel
Sent: Thursday, June 23, 2016 3:53 PM
To: 'COBOL Programming on the IBM i (AS/400 and iSeries)'
Subject: [COBOL400-L] Is there an easy way to retrieve the user-ID in an iseries COBOL ILE pgm?

I have seen two methods:


1) Pass it into the pgm as a parm

2) Use the PSDS and force an error as described in http://www.itjungle.com/fhg/fhg050113-story02.html


Is there a better, cleaner, more intuitive method?


Thanks


--
This is the COBOL Programming on the IBM i (AS/400 and iSeries) (COBOL400-L) mailing list To post a message email: COBOL400-L@xxxxxxxxxxxx To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/cobol400-l
or email: COBOL400-L-request@xxxxxxxxxxxx Before posting, please take a moment to review the archives at http://archive.midrange.com/cobol400-l.


Confidentiality Notice: The preceding e-mail message (including any attachments) contains information that may be confidential, protected by applicable legal privileges, or constitute non-public information. It is intended to be conveyed only to the designated recipient(s). If you are not an intended recipient of this message, please notify the sender by replying to this message and then delete it from your system. Use, dissemination, distribution or reproduction of this message by unintended recipients is not authorized and may be unlawful.


As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.