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


  • Subject: Why does the DELETE not work?
  • From: "Robert E. Burger" <rburger@xxxxxxxx>
  • Date: Wed, 26 Jan 2000 07:51:46 -0600

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

Follow-Ups:

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.