Re: Why does the DELETE not work? -- COBOL400-L

Robert,
I saw your message and I read a few replies.  Running in Debug or 
displaying some of your varibles would be a good idea.  
You could also utilize the invalid key phrase on the delete statement
and check the return code to help identify the problem. 
This information can be viewed at:
http://publib.boulder.ibm.com/pubs/html/as400/online/v4r3eng.htm

Once you get there, utilize the "Edit" on your tool bar and take the
"Find in Frame" option and type in Delete (it should take you to 6.2.11
of the ILE COBOL for AS/400 References book which is for V4R3).
You might need to select the correct version for your needs.

Hope you find the answer.  Let us know what caused the problem.
Scott Nance


Robert E. Burger wrote:
> 
> 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
+---
| 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