Friday, 28 August 2015

Contoh program Cobol pada organisasi file sequential


Contoh Program untuk memasukkan data

IDENTIFICATION DIVISION.
PROGRAM-ID. CONTOH-FILE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
          SELECT PEGAWAI ASSIGN TO DISK
          ORGANIZATION IS SEQUENTIAL
          ACCESS MODE IS SEQUENTIAL.
          FILE-STATUS IS STATUS-SALAH.
DATA DIVISION.
FILE SECTION.
FD    PEGAWAI
         LABEL RECORD IS STANDARD
         VALUE OF FILE-ID IS ‘PEG.DAT’
         DATA RECORD IS REC-PEG.
01     REC-PEG.
         02 NAMA PIC X(10).
         02 ALAMAT PIC X(20).
         02 UMUR PIC 99.
WORKING-STORAGE SECTION.
77     STATUS-SALAH PIC XX.
01     SUDAH-BENAR PIC X.
         88 BENAR VALUE ‘y’, ‘Y’.
         88 BELUM VALUE ‘T’,’t’.
01     MASUKKAN-DATA-LAGI PIC X.
        88 LAGI VALUE ‘Y’, ‘y’.
        88 TIDAK VALUE ‘T’, ‘t’.
SCREEN SECTION.
01    HAPUS-LAYAR.
        02 BLANK SCREEN.
01    LAYAR-DATA.
        02 LINE 4 COLUMN 5 ‘NAMA :’
        02 COLUMN PLUS 1 PIC X(10) TO NAMA.
        02 LINE 5 COLUMN 5 ‘ALAMAT :’
        02 COLUMN PLUS 1 PIC X(25) TO ALAMAT.
        02 LINE 6 COLUMN 5 ‘UMUR :’
        02 COLUMN PLUS 1 PIC 99 TO UMUR.
PROCEDURE DIVISION.
BUKA-FILE.
        OPEN OUTPUT PEGAWAI.
MULAI.
       MOVE SPACE TO SUDAH-BENAR
       PERFORM INPUT-DATA UNTIL BENAR
       PERFORM REKAM-DATA
       PERFORM ADA-LAGI.
TANYA-ADA-LAGI.
       IF LAGI GO TO MULAI.
SELESAI.
      CLOSE PEGAWAI.
      STOP RUN.
INPUT-DATA.
      DISPLAY HAPUS-LAYAR
      DISPLAY LAYAR-DATA
      ACCEPT LAYAR-DATA.
      DISPLAY (10, 5) ‘SUDAH BENAR (Y/T) ?’
      ACCEPT ( , ) SUDAH-BENAR.
REKAM-DATA.
     MOVE SPACE TO STATUS-SALAH
     WRITE REC-PEG.
     PERFORM TANYA-REKAM.
ADA-LAGI.
     DISPLAY (12, 5) ‘ADA LAGI DATA (Y/T) ? ‘
     ACCEPT ( , ) MASUKKAN-DATA-LAGI.
TANYA-REKAM.
     IF STATUS-SALAH =’34’
                  DISPLAY (12, 5) ‘DISK FULL’.
------------------------------------********-----------------------------------
NILAI STATUS ORGANISASI FILE URUT

NILAI      KETERANGAN
       00      TDK TERJADI KESALAHAN
       10      EOF
       30      FILE NOT FOUND
       34      DISK SPACE FULL
       91      STRUKTUR FILE RUSAK
Previous Post
Next Post

0 comments: