rss
email
twitter
facebook

Sunday, December 2, 2012

Contoh Program Cobol File Relatif


       IDENTIFICATION DIVISION.
       PROGRAM-ID. RELATIF.
       AUTHOR. ROMI.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT MHS ASSIGN TO DISK.
           ORGANIZATION IS RELATIVE.
           ACCESS MODE IS DYNAMIC.
           RELATIVE KEY IS NO-REL.
           FILE STATUS IS STATUS-SALAH.
       DATA DIVISION.
       FILE SECTION.    
       FD MHS.
           LABEL RECORD IS STANDARD.
           VALUE OF FILE-ID IS 'DATA.DAT'.
           DATA RECORD IS RECMHS.
       01 RECMHS.
           02 NPM PIC 9(8).
           02 NAMA PIC X(20).
           02 KELAS PIC X(5).
       WORKING-STORAGE SECTION.
       01 JUDUL.
           02 WS-NAMA PIC X(25).
           02 WS-NPM PIC 9(8).
           02 WS-KELAS PIC X(8).
           02 NPM-CARI PIC 9(8).


       01 TAMBAH-DATA PIC X.
           88 LAGI VALUE 'Y', 'y'.
           88 TDK VALUE 'T', 't'.
       01 X PIC 9 VALUE 0.
       77 STATUS-SALAH PIC XX.
       77 NO-REL PIC 9 (8).
       77 PIL PIC X.
       77 PIL2 PIC X.
       77 PIL3 PIC X.
       77 CR-NPMX PIC X VALUE 'Y'.
      
       SCREEN SECTION.
       01 HAPUS.
           02 BLANK SCREEN.
       01 MASUKAN.
           02 LINE 5 COLUMN 24 VALUE 'NPM   : '.
           02 COLUMN PLUS 2 PIC X(8) TO NPM.
           02 LINE 7 COLUMN 24 VALUE 'NAMA  : '.
           02 COLUMN PLUS 2 PIC X(20) TO NAMA.
           02 LINE 9 COLUMN 24 VALUE 'KELAS : '.
           02 COLUMN PLUS 2 PIC X(5) TO KELAS.
       01 MENU.
           02 LINE 5 COLUMN 27 '<>'.
           02 LINE PLUS 2 COLUMN 21 '[1] BUAT / INPUT FILE'.
           02 LINE PLUS 1 COLUMN 21 '[2] TAMPIL FILE'.
           02 LINE PLUS 1 COLUMN 21 '[3] CARI DATA'.
           02 LINE PLUS 1 COLUMN 21 '[4] EXIT'.
           02 LINE PLUS 2 COLUMN 21 'PILIH : '.
           02 COLUMN PLUS 1 PIC X TO PIL.
       01 CARI-X.
           02 BLANK SCREEN.
           02 LINE 5 COLUMN 25 'NPM YANG DICARI : '.
           02 COLUMN PLUS 1 PIC X(8) TO NPM-CARI.

       PROCEDURE DIVISION.
       PROGRAM-UTAMA.
           COMPUTE X = 0.
           DISPLAY HAPUS.
           DISPLAY MENU.
           ACCEPT MENU.
           IF PIL = '1' GO TO BUKA.
           IF PIL = '2' GO TO TAMPIL.
           IF PIL = '3' GO TO CARI.
           IF PIL = '4' GO TO SELESAI.
       BUKA.
           OPEN OUTPUT MHS.
           GO TO BUKA2.
       BUKA2.
           DISPLAY HAPUS.
           DISPLAY MASUKAN.
           ACCEPT MASUKAN.
           COMPUTE NO-REL = NPM - 50498000.
           WRITE RECMHS.
           DISPLAY (15, 23) 'MASIH ADA DATA [Y/T] ? '
           ACCEPT TAMBAH-DATA.
           IF LAGI GO TO BUKA2.
           CLOSE MHS.
           GO TO PROGRAM-UTAMA.
       TAMPIL.
           DISPLAY HAPUS
           DISPLAY (1, 1) 'NAMA'.
           DISPLAY (1, 22) 'NPM'.
           DISPLAY (1, 32) 'KELAS'.
           OPEN INPUT MHS.
           COMPUTE X = 1.
           GO TO TAMPIL2.
       TAMPIL2.
           IF PIL = 'Y' GO TO TAMPIL3.
       TAMPIL3.
           COMPUTE X = X + 1.
           MOVE X TO LIN.
           READ MHS NEXT RECORD AT END GO TO TAMPIL4.
           MOVE NAMA TO WS-NAMA.
           MOVE NPM TO WS-NPM.
           MOVE KELAS TO WS-KELAS.
           DISPLAY (LIN, 1) WS-NAMA.
           DISPLAY (LIN, 22) WS-NPM.
           DISPLAY (LIN, 32) WS-KELAS.
       TAMPIL4.
           ACCEPT PIL.
           CLOSE MHS.
           GO TO PROGRAM-UTAMA.
       CARI2.
           MOVE 'N' TO CR-NPMX.
           DISPLAY CARI-X.
           ACCEPT CARI-X.
           OPEN INPUT MHS.
           GO TO CARI2.
       CARI2.
           READ MHS NEXT AT END GO TO CARI3.
           MOVE NAMA TO WS-NAMA.
           MOVE NPM TO WS-NPM.
           MOVE KELAS TO WS-KELAS.
           IF NPM-CARI = WS-NPM GO TO KETEMU.
           GO TO CARI2.
       KETEMU.
           DISPLAY HAPUS.
           DISPLAY (7, 23) 'DATA NPM : ' WS-NPM.
           DISPLAY (9, 23) 'NAMA     : ' WS-NAMA.
           DISPLAY (11, 23) 'KELAS    : ' WS-KELAS.
           DISPLAY (15, 23) 'CARI DATA LAGI ? '.
           ACCEPT ( , ) PIL2.
           CLOSE MHS.
           IF PIL2 = 'Y' OR PIL2 = 'y' GO TO CARI.
           GO TO PROGRAM-UTAMA.
       CARI3.
           DISPLAY HAPUS.
           DISPLAY 'DATA TIDAK ADA...'.
           DISPLAY 'Press Escape / Enter Unutk Cari Lagi..'.
           DISPLAY 'X Untuk Ke Menu Utama, Lalu Tekan Enter..'.
           ACCEPT ( , ) PIL3.
           CLOSE MHS.
           IF PIL3 = 'X' OR PIL3 = 'x' GO TO PROGRAM-UTAMA.
           GO TO CARI.
          
       SELESAI.
           DISPLAY HAPUS.
           DISPLAY (2, 2) 'Good Bye.......'.
           STOP RUN.

0 comments:

Post a Comment