|
midrange.com
I appologize if this message comes through twice -- my ISP has been having some
problems with outbound mail. Since it hasn't
appeared on the list in the 8 hours since I sent it I figure either it isn't
going to or this one won't either!
I'm sure that this is a very fundamental question, but having no COBOL training
or experience to speak of, I am going nuts
trying to figure out why the code presented below won't work. The concept is
that as records are added to another database, a
trigger program (which I am proud to say works great!) puts records into this
file (CSLABL). These records will be used to
print offender case file folder labels. A CL program periodically checks the
CSLABL file for 10 or more records (each offender
gets 2 labels on a 2 wide by 10 row label sheet) and calls this program to
print a page if there are at least 10 records in the
file. When I had this designed with the records in offener ID order
(CS-MLNUM2-LABL), each record would be deleted right after
it was printed. But, we need the labels printed in alpha order instead of ID
order. When I made that change, the labels print
in alpha order as expected, but the DELETE does not delete the record. Where
am I going wrong? I've got a sponge double-stick
taped to my forehead so it won't hurt to bad when I smack myself on the head!
Thanks in advance,
Robert E. Burger
Information Systems Coordinator
Tarrant County CSCD
Fort Worth, Texas, USA
=============================
AS/400 9406-620 running OS/400 V4R4
AS/400 9406-170 running OS/400 V4R4
IDENTIFICATION DIVISION.
PROGRAM-ID. CSLABL.
AUTHOR. ROBERT E. BURGER - TARRANT COUNTY CSCD
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CS-LABELS-FILE
ASSIGN TO DATABASE-CSLABL
ORGANIZATION INDEXED
ACCESS MODE IS DYNAMIC
FILE STATUS IS FILE-STATUS
RECORD KEY IS CS-LABELS-KEY.
SELECT NAME-REPORT
ASSIGN TO PRINTER-CSDEPLPRTF.
DATA DIVISION.
FILE SECTION.
FD CS-LABELS-FILE
LABEL RECORDS ARE STANDARD.
01 CS-LABELS-RECORD.
05 CS-LABELS-KEY.
10 CS-LNAME-LABL PIC X(20).
10 CS-FNAME-LABL PIC X(20).
10 CS-CASENO-LABL PIC X(22).
05 CS-MNAME-LABL PIC X(20).
05 CS-AGE-LABL PIC 9(2).
05 CS-SEX-LABL PIC X.
05 CS-RACE-LABL PIC X.
05 CS-STATUTE-LABL PIC X(20).
05 CS-STATUTEDES-LABL PIC X(50).
05 CS-SUPERDATE-LABL PIC 9(8).
05 CS-TERMDATE-LABL PIC 9(8).
05 CS-DISCHDATE-LABL PIC 9(8).
05 CS-PRIMECLASS-LABL PIC X(4).
05 CS-CASESTAT-LABL PIC X.
05 CS-CRTID-LABL PIC X(4).
05 CS-MLNUM2-LABL PIC 9(9).
FD NAME-REPORT
LABEL RECORDS ARE STANDARD.
01 PRINT-LINE PIC X(90).
WORKING-STORAGE SECTION.
01 CA-CLIENT-TMP PIC X(40).
01 NOTHING PIC 9(1) VALUE 0.
01 DATE-MO PIC X(2).
01 DATE-DA PIC X(2).
01 DATE-YR PIC X(4).
01 REC-CNT PIC 99.
01 FILE-STATUS PIC XX.
88 RECORD-IS-NOT-ON-FILE VALUE "23" "46".
88 RECORD-IS-LOCKED VALUE "9D".
88 THERE-ARE-NO-MORE-RECORDS VALUE "10" "12" "14" "23" "46".
88 RECORD-IS-RELEASED VALUE "00".
01 DETAIL-LINE-1.
05 MLNUM2-RPT PIC 9(9).
05 FILLER PIC X(11) VALUE SPACES.
05 CASENO-RPT PIC X(20).
* ADDITION DETAIL LINE CODE OMMITTED FOR BREVITY
LINKAGE SECTION.
PROCEDURE DIVISION.
DECLARATIVES.
FILE-ERRORS SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON CS-LABELS-FILE.
END DECLARATIVES.
MAIN SECTION.
A001-MAIN.
OPEN I-O CS-LABELS-FILE,
OUTPUT NAME-REPORT.
INITIALIZE CS-LABELS-RECORD.
PERFORM U100-START-LABELS-FILE.
PERFORM U100-READ-LABELS-NEXT.
PERFORM B000-START-PROCESS THRU B000-START-PROCESS-EXIT
10 TIMES.
CLOSE CS-LABELS-FILE,
NAME-REPORT.
STOP RUN.
B000-START-PROCESS.
INITIALIZE PRINT-LINE,
DETAIL-LINE-1.
MOVE CS-MLNUM2-LABL TO MLNUM2-RPT.
MOVE CS-CASENO-LABL TO CASENO-RPT.
WRITE PRINT-LINE FROM DETAIL-LINE-1.
* ADDITION DETAIL LINE MOVE AND WRITE CODE OMMITTED FOR BREVITY
DELETE CS-LABELS-FILE.
B000-START-PROCESS-EXIT.
PERFORM U100-READ-LABELS-NEXT.
U100-READ-LABELS-FILE.
READ CS-LABELS-FILE.
IF RECORD-IS-LOCKED
GO TO U100-READ-LABELS-FILE.
U100-READ-LABELS-NEXT.
READ CS-LABELS-FILE NEXT.
IF RECORD-IS-LOCKED
GO TO U100-READ-LABELS-NEXT.
U100-START-LABELS-FILE.
MOVE SPACES TO CS-LNAME-LABL.
START CS-LABELS-FILE KEY IS GREATER THAN CS-LABELS-KEY.
IF RECORD-IS-LOCKED
GO TO U100-START-LABELS-FILE.
+---
| This is the COBOL/400 Mailing List!
| To submit a new message, send your mail to COBOL400-L@midrange.com.
| To subscribe to this list send email to COBOL400-L-SUB@midrange.com.
| To unsubscribe from this list send email to COBOL400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---END
As an Amazon Associate we earn from qualifying purchases.
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.
