× 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: RE: Why does the DELETE not work?
  • From: "Stone, Joel" <StoneJ@xxxxxxxxxxxxxxxx>
  • Date: Wed, 26 Jan 2000 17:22:37 -0500

Title: RE: Why does the DELETE not work?

How is the file being sorted?  If by chance the change you talked about was to add OPNQRYF in front of the pgm, then the deletes are occurring to a temp file, not the live file.



-----Original Message-----
From: Robert E. Burger [mailto:rburger@home.net]
Sent: Wednesday, January 26, 2000 8:52 AM
To: COBOL400-L@midrange.com
Subject: Why does the DELETE not work?


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