dksdel: PROCEDURE
   /* zex1209n */
   /* Deletes records in a delimited key-sequenced UDB    */
   ON ERROR FLUSH
   IF &1 = "" THEN DO
      SAY "Must enter file name as first parameter"
      FLUSH
      END /*do*/
   ELSE
      &filename = &1
   &id = DKSUDB
   CALL open_file SHARE &filename,&id
   CALL get_records SHARE &filename,&id
   CALL close_file SHARE &filename,&id
   EXIT
   /* ==================== OPEN FILE ==================== */
   open_file: PROCEDURE SHARE &filename,&id
      /* Opens file for NonStop NET/MASTER and NCL */
      SAY "Opening "&filename
      INTCMD "UDBCTL OPEN="&filename" ID="&id
      INTREAD
      FILE OPEN ID=&id FORMAT=DELIMITED
      SELECT &SYS.FILE.RC
         WHEN 0 THEN SAY "0 Read-only access"
         WHEN 4 THEN SAY "4 Read and write access"
         WHEN 8 THEN SAY "8 Read, write, and delete access"
         WHEN 12 THEN SAY "12 No access"
         WHEN 16 THEN SAY "16 "&SYSMSG
         OTHERWISE
            SAY Unexpected error
      END /*select*/
   END open_file
   /* ==================== GET RECORDS =================== */
   get_records: PROCEDURE SHARE &filename,&id
      /* Get records and displays them on OCS window */
      &key = 1
      FILE GET KEY=&key UPDATE VARS=&field*
      SELECT &SYS.FILE.RC
         WHEN 0 THEN DO
            SAY "0 Record retrieved"
            SAY "Key is "&SYS.FILE.KEY
            END /*do*/
         WHEN 4 THEN SAY "4 Record not found or EOF"
         WHEN 8 THEN SAY "8 Error "&SYS.FILE.ERROR
         WHEN 16 THEN SAY "16 "&SYSMSG
         OTHERWISE
            SAY Unexpected error
      END /*select*/
      DO WHILE &SYS.FILE.RC = 0
         DO &fno = 1 TO &SYS.VARCNT
            SAY "Field "&fno" is "&field&fno
         END /*do*/
         CALL delete_record SHARE &key
         FILE GET KEY=&key UPDATE VARS=&field*
         SELECT &SYS.FILE.RC
            WHEN 0 THEN DO
               SAY "0 Record retrieved"
               SAY "Key is "&SYS.FILE.KEY
               END /*do*/
            WHEN 4 THEN SAY "4 Record not found or EOF"
            WHEN 8 THEN SAY "8 Error "&SYS.FILE.ERROR
            WHEN 16 THEN SAY "16 "&SYSMSG
            OTHERWISE
               SAY Unexpected error
         END /*select*/
      END /*do while*/
   END get_records
   /* ================= DELETE RECORD ==================== */
   delete_record: PROCEDURE SHARE &key
      /* Deletes a record */
      &answer = N
      SAY "Delete record? (Y/N) Default=N"
      CMDLINE "-GO ID="&SYS.NCLID _N
      PAUSE VARS=&answer PARSE=NO SEGMENT=1
      IF UPPER(&answer) = Y THEN DO
         FILE DEL KEY=&key
         SELECT &SYS.FILE.RC
            WHEN 0 THEN SAY "0 Record deleted"
            WHEN 4 THEN SAY "4 Record not found"
            WHEN 8 THEN SAY "8 Error "&SYS.FILE.ERROR
            WHEN 16 THEN SAY "16 "&SYSMSG
            OTHERWISE
               SAY Unexpected error
         END /*select*/
      END /*do*/
      &key = &key + 1
      RETURN &key
   END delete_record
   /* ==================== CLOSE FILE ==================== */
   close_file: PROCEDURE SHARE &filename,&id
   /* Close file from NCL and NonStop NET/MASTER */
   SAY "Closing "&filename
   FILE CLOSE ID=&id
   SELECT &SYS.FILE.RC
      WHEN 16 THEN SAY "16 Closed"
      OTHERWISE
         SAY Unexpected error
      END /*select*/
   INTCMD "UDBCTL CLOSE="&filename
   INTREAD
   END close_file
END dksdel