× 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.



Absolutely. Here you go.

00016 WORKING-STORAGE SECTION.
00017
00018 01 WS-PROGRAM-MESSAGES.
00019 05 WS-DIAG-MSG.
00020 10 WS-DATA-1 PIC X(09).
00021 10 FILLER PIC X(01) VALUE SPACE.
00022 10 WS-DATA-2 PIC X(24).
00023 10 FILLER PIC X(01) VALUE SPACE.
00024 10 WS-DATA-3 PIC X(24).
00025 10 FILLER PIC X(01) VALUE SPACE.
00026 10 WS-DATA-4 PIC X(08).
00027 05 WS-MSG1A PIC X(78) VALUE
00028 ' PF1=EXIT PF2=FORWARD PF3=BACK'.
00029 05 WS-MSG1B PIC X(78) VALUE
00030 ' JUST FELL THROUGH '.
00031 05 WS-MSG02 PIC X(78) VALUE
00032 ' INVALID EMPLOYER ACCOUNT, MUST BE NUMERIC '.
00033 05 WS-MSG04 PIC X(78) VALUE
00034 ' THERE ARE MORE EMPLOYEE RECORDS. PF2=FORWARD PF3=BACK'.
00035 05 WS-MSG05 PIC X(78) VALUE
00036 ' PF3 IS AT TOP OF FILE '.
00037 05 WS-MSG06 PIC X(78) VALUE
00038 ' END OF EMPLOYEE FILE, PF3 TO GO BACK '.
00039 05 WS-MSG12 PIC X(78) VALUE
00040 ' START BROWSE FAILED. '.
00041 05 WS-MSG16 PIC X(78) VALUE
00042 ' REQUESTED STARTING POINT, OR BEGINNING OF FILE'.
00043 05 WS-MSG25.
00044 10 FILLER PIC X(39) VALUE
00045 ' NO WAGE RECORDS ON FILE FOR THIS EMPLO'.
00046 10 FILLER PIC X(39) VALUE
00047 'YER. '.
000048 05 WS-MSG26.
00049 10 FILLER PIC X(39) VALUE
00050 ' EMPLOYER ACCOUNT NUMBER NOT FOUND ON '.
00051 10 FILLER PIC X(39) VALUE
CL*3
00052 'EMPLOYER FILE. '.
00053
00054
00055 01 WS-AC-LENGTH PIC S9(04) COMP VALUE +45.
00056 01 WS-KL PIC S9(04) COMP VALUE +09.
00057 01 WS-AC-KEY-LEN PIC S9(04) COMP VALUE +24.
00058 01 WS-AC-COMM-LEN PIC S9(04) COMP VALUE +9999.
00059
00060 01 GB-RESP PIC S9(08) COMP VALUE 0.
CL*3 00061 01 BN-RESP PIC S9(08) COMP VALUE 0.

00062 01 BP-RESP PIC S9(08) COMP VALUE 0.
00063 01 RN-RESP PIC S9(08) COMP VALUE 0.
00064 01 RP-RESP PIC S9(08) COMP VALUE 0.
00065 01 RM-RESP PIC S9(08) COMP VALUE 0.
00066 01 R-RESP PIC S9(08) COMP VALUE 0.
00067
00068 ** CICS ATTRIBUTES
000069 ++INCLUDE ATTRIB *** Definition of CICS attributes D=Display,
P=Protected, etc.
000070
00071 ** AC EMPLOYER WAGE FILE
- Copybook definitions
000072 ++INCLUDE FILE-AC
000073
00077 COPY DFHAID.
00078
00079 COPY ac-map.
000080 ++INCLUDE ac-redef - Redefines for the output values in the map
000081
00082 LINKAGE SECTION.
00083 01 DFHCOMMAREA.
CL*3
000084 ++INCLUDE MAINCOMM - *** The default COMMAREA for the system
000085 05 WS-ac-COMMAREA.
00086 10 WS-COMM-BEGIN PIC X(09).
00087 10 WS-COMM-FIRST PIC X(24).
00088 10 WS-COMM-LAST PIC X(24).
00089

-----Original Message-----
From: cobol400-l-bounces@xxxxxxxxxxxx
[mailto:cobol400-l-bounces@xxxxxxxxxxxx] On Behalf Of Jim Essinger
Sent: Sunday, February 10, 2008 11:09 PM
To: COBOL Programming on the iSeries/AS400
Subject: Re: [COBOL400-L] CICS Problem

Hey Lora,

I don't see anything that might help you. Can you post the definitions from
working storage or file definitions? That way we can see field types and
sizes and such.

Jim

On Feb 10, 2008 8:15 PM, Lora <loravara@xxxxxxxxxxx> wrote:

Hi, Jim,

Actually, I suspect many of my questions are very basic. I'm
struggling to deal with the DFHCOMMAREA, and trying to understand why
it's behaving the way it does.

For instance, the primary function of the screen I'm building is to
read a VSAM file sequentially, and find all records with the same
employer account number. They'll be displayed in descending order.
When the account number changes, I stop displaying the data.

Thus, I use a Startbr, Readnext process to read through the file.
This works perfectly when moving forward. With each press of the
Scroll Forward key, a new screen of records is displayed.

For debugging purposes, I display the account number, and the first
and last key that are on the screen on the bottom line of the screen,
to prove that these values are being stored in the DFHCOMMAREA. They
are as I move forward through the file.

The problem occurs when I press the key to start scrolling backward.
At that point, the account number is replaced by spaces. I know why
this happens, because I write it to the DFHCOMMAREA each time I
execute a successful startbr, and the program is failing on the
STARTBR when going backward.

In addition, the first key on the screen, the one I'll need to use to
start the browse backward, seems to become corrupted. The first four
characters of the 24-byte key are replaced by spaces, and the fifth by
a B, though I have no idea where that comes from, since the key is
entirely numeric, though it's stored in an alphanumeric field.

Because this key is now invalid, when it's used in the STARTBR
operation, the start browse fails.

Yet just before I pressed the Scroll back key, that key was displayed
properly on the screen, so I have no idea what happened to it.

The code for the Scroll backward process follows:

00136 IF EIBAID = DFHPF3
00137 PERFORM 7100-CLEAR-SCREEN THRU 7100-EXIT
00138 MOVE ACEMPNOI TO E-NUMBER ESD-EMP-ACCT-NO
00139 MOVE 0 TO E-SEQ
00140 PERFORM 1000-LOAD-BROWSE-KEY THRU 1000-EXIT
00141 PERFORM 1070-READ-EAFILE THRU 1070-EXIT
00142 SET ACMAP-CTR TO 12
00143 PERFORM 1111-START-BROWSE THRU 1111-EXIT
000144 PERFORM 1250-READ-PREV THRU 1250-EXIT
00145 UNTIL (ACMAP-CTR < 01)
00146 OR (RP-RESP = 20)
00147 OR (AC-EMPLOYER-ID < ACEMPNOI)
00148 PERFORM 1350-END-BROWSE THRU 1350-EXIT
00149 IF WS-AC-SSN1(1) NUMERIC
00150 MOVE WS-MSG04 TO ACERRO
00151 MOVE -1 TO ACEMPNOL
00152 PERFORM 7900-SEND-MAP-RETURN THRU 7900-EXIT
00153 ELSE
00154 PERFORM 7100-CLEAR-SCREEN THRU 7100-EXIT
00155 MOVE 0 TO AC-KEY
00156 MOVE ACEMPNOI TO AC-EMPLOYER-ID ESD-EMP-ACCT-NO
00157 MOVE ACEMPNOI TO E-NUMBER
00158 MOVE 0 TO E-SEQ
00159 SET ACMAP-CTR TO 1
00160 PERFORM 1070-READ-EAFILE THRU 1070-EXIT
00161 PERFORM 1100-START-BROWSE THRU 1100-EXIT
00162 PERFORM 1150-READ-NEXT THRU 1150-EXIT
00163 UNTIL (ACMAP-CTR > 12)
00164 OR (RN-RESP = 20)
00165 OR (AC-EMPLOYER-ID > ACEMPNOI)
00166 PERFORM 1350-END-BROWSE THRU 1350-EXIT
00167 MOVE WS-MSG05 TO ACERRO
00168 MOVE -1 TO ACEMPNOL
00169 PERFORM 7900-SEND-MAP-RETURN THRU 7900-EXIT.

...

00196 1000-LOAD-BROWSE-KEY.
000197 MOVE WS-COMM-FIRST TO AC-KEY.
00198 1000-EXIT. EXIT.

*** And this is where it fails ...

00284 1111-START-BROWSE.
00285 MOVE SPACES TO WS-COMM-BEGIN.
00286 EXEC CICS STARTBR
00287 DATASET('ACCOUNT')
00288 RIDFLD(AC-KEY)
00289 EQUAL
00290 RESP(BP-RESP)
00291 END-EXEC.
000292
000293 IF BP-RESP = DFHRESP(NORMAL)
00294 MOVE ACEMPNOI TO WS-COMM-BEGIN
00295 GO TO 1111-EXIT.
00296
00297 IF BP-RESP = DFHRESP(NOTFND)
00298 MOVE WS-MSG25 TO ACERRO
00299 MOVE -1 TO ACEMPNOL
00300 MOVE U-A-D-M TO ACEMPNOA
00301 PERFORM 7900-SEND-MAP-RETURN THRU 7900-EXIT
00302 ELSE
*** It always stops here, with a Resp of 16, INVREQ.

000303 PERFORM 7100-CLEAR-SCREEN THRU 7100-EXIT
00304 MOVE WS-MSG12 TO ACERRO
00305 MOVE -1 TO ACEMPNOL
00306 PERFORM 7900-SEND-MAP-RETURN THRU 7900-EXIT.
00307 1111-EXIT. EXIT.

-----Original Message-----
From: cobol400-l-bounces@xxxxxxxxxxxx
[mailto:cobol400-l-bounces@xxxxxxxxxxxx] On Behalf Of Jim Essinger
Sent: Saturday, February 02, 2008 3:28 PM
To: COBOL Programming on the iSeries/AS400
Subject: Re: [COBOL400-L] CICS Problem

Lora,

I think your questions are just fine here, as long as you realize that
there may be some differences between i5/OS COBOL (even the CICS
version) and what you are doing on a mainframe. What we have to offer
may or may not help.
Ask away, and if we can, we will answer to the best of our knowledge.

Jim



--
This is the COBOL Programming on the iSeries/AS400 (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.


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.