1. Pengantar

Dalam tutorial ini penulis akan mencoba mengajarkan dasar-dasar konsep dan praktek yang harus dikuasai seseorang supaya bisa menggunakan AS/400 untuk melakukan pengolahan data.

2. Perangkat

Untuk bisa mengakses terminal AS/400 lewat jaringan TCP/IP maka anda membutuhkan software emulator terminal. Software emulator terminal yang digunakan di tutorial ini adalah tn5250. Situs web software ini adalah http://tn5250.sourceforge.net/. Distro Fedora sudah memiliki software ini dalam reponya dan bisa diinstall dengan perintah :

sudo yum install tn5250

Sedangkan distro Ubuntu memiliki software ini untuk Ubuntu 10.04 tapi software ini tetap bisa diinstalasi di distro Ubuntu yang lebih baru. Situs download untuk Ubuntu adalah http://packages.ubuntu.com/lucid/tn5250. Install juga software xterm supaya tn5250 menggunakan mode GUI.

AS/400 memiliki 24 kunci function sedangkan kebanyakan keyboard PC memiliki 12 kunci function. Tekan Shift lalu kunci function untuk menekan kunci function diatas 12. F13 adalah Shift-F1, F14 adalah Shift-F2 dan seterusnya. Jika anda membuat kesalahan masukan seperti menekan kunci di saat kursor tidak berada di posisi layar yang bisa menerima masukan maka layar akan terkunci dan muncul pesan X II dibagian paling bawah layar. Jika ini terjadi maka tekan tombol Ctrl untuk melepaskan kuncian layar.

3. AS/400 Hosting

Penulis menggunakan hosting AS/400 gratis dari situs http://rzkh.de. Daftarkan diri anda disana untuk mendapatkan akses gratis ke AS/400. Penulis mendaftarkan diri disana dengan nama user SAMUELF. Karena itu penulis mendapatkan 2 library yaitu SAMUELF1 dan SAMUELF2. Tutorial ini menggunakan dua library tersebut. Sesuaikan nama library dalam tutorial ini dengan nama library yang anda dapatkan.

4. Menu dan Command

Sign On

Layar Sign On AS/400. Masukkan user name dan password anda untuk masuk.

GUEST menu

Pada saat anda masuk ke AS/400 maka layar pertama yang ditampilkan adalah layar menu GUEST.

Menu adalah cara termudah menggunakan fasilitas yang disediakan oleh OS/400. Anda menjalankan item menu dengan mengetik angka item menu dan menekan kunci Enter. Menjalankan item menu bisa menampilkan menu baru atau menjalankan command.

OS/400 Main Menu

Menjalankan item menu 10 dari menu GUEST akan menampilkan menu MAIN.

User Tasks

Menjalankan item menu 1 dari menu MAIN menampilkan menu USER. Keluarlah dari menu dengan menekan F3.

Kita juga bisa menampilkan menu USER dengan mengetikkan perintah berikut:

===> GO USER

Command GO adalah command untuk menampilkan menu.

Work with Job

Menjalankan item menu 1 dari menu USER menampilkan menu dari command WRKJOB. Keluarlah dari command dengan menekan F3. Kita juga bisa menjalankan command WRKJOB dengan mengetikkan perintah berikut:

===> WRKJOB

Maka command WRKJOB akan dijalankan dan menampilkan menu. Keluarlah dari menu ini dengan menekan F3.

Submit Job

Dari menu MAIN akses kembali menu USER lalu jalankan item menu 4 yaitu Submit a Job. Layar diatas akan ditampilkan.

Item menu 4 menu USER menjalankan command SBMJOB. Command ini membutuhkan masukan dari user karena itu layar untuk menerima masukan ditampilkan.

Submit Job Help

Jika anda belum paham benar command yang anda panggil maka anda bisa menampilkan layar dokumentasi command. Gerakkan cursor anda ke baris paling atas ke tulisan "Submit Job" lalu tekan F1. Maka layar dokumentasi dari command akan ditampilkan.

Jika anda ingin menampilkan masukan yang bisa diterima oleh command maka anda bisa mengetik nama command lalu menekan tombol F4.

Silahkan anda menjelajahi menu yang disediakan oleh OS/400. Dengan menjelajahi menu yang disediakan anda akan mendapat gambaran fasilitas apa saja yang disediakan oleh OS/400.

5. Job dan Message

Setiap proses yang berjalan didalam OS/400 dinamakan job. Job yang berjalan melakukan komunikasi dengan user menggunakan message. Job bisa dijalankan secara interaktif ataupun batch. Job yang berjalan secara interaktif akan berjalan didalam subsystem QINTER sedangkan job yang berjalan secara batch akan berjalan dalam subsystem QBATCH.

Kita menampilkan message yang ditujukan untuk kita dengan menggunakan command:

===> DSPMSG
Display Messages

Jika kita sudah membaca semua message maka biasanya message tersebut kita hapus dengan menekan F13 atau F16.

Kita menampilkan job yang sedang berjalan dengan menggunakan command:

===> WRKACTJOB
Work with Active Jobs

Dari layar diatas bisa dilihat sebagian user yang sedang aktif memakai sistem.

Kita juga dapat melihat command apa saja yang sudah kita jalankan dan message yang dihasilkan job dari command tersebut dengan menggunakan command :

===> DSPJOBLOG
Display Job Log

Layar menampilkan job log mulai dari perintah yang terakhir dijalankan. Untuk bisa menampilkan perintah sebelumnya dalam format detail maka tekan F10 dan PageUp.

Display Job Log

Layar menampilkan command yang sudah dijalankan penulis.

6. Library, File, Member dan DDS

OS/400 adalah sistem operasi berbasis obyek. Semua yang disimpan oleh OS/400 adalah obyek. Obyek disimpan dalam library. Salah satu jenis obyek adalah file. Sebuah file fisik bisa berisi banyak member. Member adalah kumpulan record didalam file fisik. File di AS/400 bisa berupa file fisik (Physical File) atau file logis (Logical File).

File fisik digunakan untuk menyimpan source code atau data. File logis digunakan untuk menampilkan sebagian field dari file fisik, menampilkan urutan berdasarkan field-field tertentu dari file fisik atau menampilkan gabungan dari beberapa file fisik.

File untuk menyimpan data diciptakan dengan membuat struktur dari file data tersebut dalam member dari source file dengan tipe PF. Buat member CUSTPF di file QDDSSRC dalam library SAMUELF1 dengan tipe PF dengan command berikut:

===> STRSEU SRCFILE(SAMUELF1/QDDSSRC) SRCMBR(CUSTPF) TYPE(PF)

Lalu isi dengan code berikut:

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QDDSSRC(CUSTPF)
      * DATE     : 2014-02-02
      *
      * FILE DEFINITION
     A                                      UNIQUE
      * RECORD DEFINITION
     A          R CUSPFR                    TEXT('CUSTOMER')
      * FIELD DEFINITION
     A            CSNUM         10S 0       TEXT('NUMBER')
     A                                      COLHDG('NUMBER')
     A            CSNAME        30A         TEXT('NAME')
     A                                      COLHDG('NAME')
     A            CSBDAY          L         TEXT('BIRTH DAY')
     A                                      COLHDG('BIRTH DAY')
     A                                      DATFMT(*ISO)
     A            CSADDR        50A         TEXT('ADDRESS')
     A                                      COLHDG('ADDRESS')
     A            CSPOST         5A         TEXT('POST CODE')
     A                                      COLHDG('POST CODE')
     A            CSEML         50A         TEXT('EMAIL')
     A                                      COLHDG('EMAIL')
      * KEY DEFINITION
     A          K CSNUM

Kata kunci UNIQUE di baris pertama digunakan untuk menyatakan bahwa file data ini memiliki 1 atau lebih fields yang nilainya unik. Baris berikutnya dimulai dengan huruf R yang berarti ini adalah definisi record. Kata kunci TEXT digunakan untuk mendokumentasikan keterangan record dan field.

Kata kunci COLHDG digunakan untuk mendefinisikan keterangan yang ditampilkan kepada pemakai. Field didefinisikan dengan panjang field, tipe data dan jumlah desimal dibelakang koma untuk field angka. Dalam file CUSTPF tipe data yang digunakan adalah S (Zoned Decimal), A (Character) dan L (Date). Kata kunci DATFMT digunakan untuk menentukan format dari tanggal. Format *ISO berarti tanggal akan ditampilkan dalam format YYYY-MM-DD. Baris yang dimulai dengan huruf K mendefinisikan nama field yang digunakan sebagai key yaitu CSNUM.

Bahasa yang digunakan untuk mendefinisikan file fisik dan file logis data dinamakan bahasa DDS (Data Description Specification). Untuk mempelajari DDS lebih mendalam maka anda bisa membaca buku dokumentasi DDS yaitu "DDS Reference Concepts". Untuk mempelajari DDS untuk file fisik dan file logis data maka anda bisa membaca buku dokumentasi "DDS Reference Physical and Logical Files".

Sesudah source code untuk file fisik ditulis maka anda harus melakukan kompilasi untuk membentuk file fisik tersebut. Gunakan command berikut untuk melakukan kompilasi.

===> CRTPF FILE(SAMUELF1/CUSTPF) SRCFILE(SAMUELF1/QDDSSRC)

Penulis memasukkan data ke dalam CUSTPF. Anda bisa menampilkan isi file CUSTPF yang sudah anda buat dengan menggunakan command berikut:

===> DSPPFM FILE(SAMUELF1/CUSTPF)
Display Physical File Member

Mari kita buat file logis berdasarkan file fisik CUSTPF. Kita harus membuat source code untuk file logis tersebut:

===> STRSEU SRCFILE(SAMUELF1/QDDSSRC) SRCMBR(CUSTLF) TYPE(LF)

Lalu isi dengan code berikut:

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QDDSSRC(CUSTLF)
      * DATE     : 2014-02-02
      *
      * RECORD DEFINITION
     A          R CUSLFR                    PFILE(SAMUELF1/CUSTPF)
      * FIELD DEFINITION
     A            CSBDAY
     A            CSNAME
      * KEY DEFINITION
     A          K CSBDAY
     A          K CSNAME

Berdasarkan code diatas maka file logis ini hanya menampilkan sebagian field dari file fisik dan merubah urutan data yang ditampilkan.

Sesudah source code untuk file logis ditulis maka anda harus melakukan kompilasi untuk membentuk file logis tersebut. Gunakan command berikut untuk melakukan kompilasi.

===> CRTLF FILE(SAMUELF1/CUSTLF) SRCFILE(SAMUELF1/QSRC)

Anda bisa menampilkan isi file CUSTLF yang sudah anda buat dengan menggunakan command berikut:

===> DSPF FILE(SAMUELF1/CUSTLF)
Display File

Data yang ditampilkan oleh file logis disortir berdasarkan CSBDAY dan CSNAME. Hanya field CSBDAY dan CSNAME yang ditampilkan oleh file logis CUSTLF sesuai dengan source code file logis.

7. DFU

Salah satu cara memasukkan data kedalam file fisik adalah dengan menggunakan program DFU. Program DFU adalah program yang diciptakan oleh tools DFU. Jalankan command berikut:

===> STRDFU
AS/400 Data File Utility (DFU)

Jalankan item menu 5. Layar berikut akan tampil:

Update Data Using Temporary Program

Masukkan nilai untuk Data file dan Library sehingga sesuai dengan layar diatas. Lalu tekan Enter.

WORK WITH DATA IN A FILE

Layar entry data DFU ditampilkan dalam mode CHANGE. Kita ingin mengubah record nomor 25 maka kita masukkan 25 lalu menekan Enter.

WORK WITH DATA IN A FILE

Layar menampilkan record nomor 25. Jika ingin menambah record maka tekan F9.

WORK WITH DATA IN A FILE

Keluarlah dari program DFU dengan menekan F3.

End Data Entry

Tekan Enter untuk mengakhiri program.

Tutorial diatas hanya membahas bagaimana memasukkan data lewat DFU menggunakan temporary program. Sesudah selesai memasukkan data maka program DFU yang digunakan akan dihapus. Kita bisa membuat program DFU yang lebih permanen akan tetapi mengingat banyaknya keterbatasan DFU maka penulis tidak akan membahas DFU secara mendalam. Penulis mempersilahkan pembaca bermain-main dengan tools STRDFU jika ingin memahami DFU lebih lanjut.

8. Query

Setelah mempelajari memasukkan data menggunakan DFU maka kita akan mempelajari bagaimana menampilkan/mencetak data yang sudah kita masukkan. Untuk melakukan hal ini kita akan mempelajari bagaimana menggunakan fasilitas query di AS/400.

Untuk mengakses fasilitas query di AS/400 anda menjalankan command berikut:

====> WRKQRY
Work with Queries

Masukkan nilai 1 untuk Option, CUSQRY untuk Query dan SAMUELF1 untuk library lalu tekan Enter.

Define the Query

Pilih sesuai dengan layar diatas lalu tekan Enter.

Specify File Selections

Masukkan CUSTPF untuk File dan SAMUELF1 untuk library lalu tekan Enter.

Specify File Selections

Tekan Enter lagi untuk konfirmasi.

Define the Query

Tekan F3 untuk menyimpan dan menjalankan query.

Exit this Query

Simpan definisi query lalu jalankan query secara interaktif. Tekan Enter.

Display report

Hasil query ditampilkan dilayar.

Work with Queries

Kita kembali ke layar Work with Queries. Keluarlah dari layar ini dengan menekan F3. Jalankan command berikut untuk menjalankan query dan merubah output query ke printer:

===> RUNQRY QRY(SAMUELF1/CUSQRY) OUTTYPE(*PRINTER)

Untuk melihat hasil query maka kita perlu melihat spool file dengan perintah:

===> WRKSPLF
Work with All Spooled Files

Spool file hasil query ditampilkan dengan nama QPQUPRFIL. Isi Opt dengan angka 5 lalu tekan Enter.

Display Spooled Files

Tutorial diatas hanya membahas penggunaan query sesederhana mungkin. Mengingat keterbatasan query penulis tidak akan membahas query secara mendalam. Penulis mempersilahkan pembaca bermain-main dengan tools WRKQRY jika ingin memahami query lebih lanjut.

Jika pembaca mampu memasukkan data dengan program DFU dan menampilkan/mencetak data tersebut maka pembaca sudah menguasai dasar-dasar pengolahan data di AS/400.

DFU dan Query memiliki batasan-batasan tertentu. Untuk bisa mengatasi keterbatasan ini maka dibutuhkan kemampuan pemrograman dari RPG.

9. Pemrogaman RPG Dasar

Pertama-tama kita akan membuat program untuk menambahkan, mengubah, menghapus dan membaca record dalam sebuah tabel. Program macam ini biasanya disebut program CRUD (Create, Read, Update and Delete).

Untuk menerima input dari user kita menggunakan display file. Bahasa yang digunakan untuk mendefinisikan display file adalah bahasa yang sama dengan yang digunakan untuk mendefinisikan physical dan logical file yaitu DDS (Data Description Specification).

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QDDSSRC(CUSTDF)
      * DATE     : 2014-02-06
      *
     A                                      REF(SAMUELF1/CUSTPF)

Baris pertama dari CUSTDF menyatakan bahwa CUSTDF menggunakan physical file CUSTPF sebagai referensi. Definisi panjang dan tipe data field dalam CUSTDF bisa menggunakan definisi dalam CUSTPF.

     A          R KEYR                                             <1>
     A                                      CA03(03)               <2>
     A                                      CA15(15)               <3>
     A                                  1  2USER                   <4>
     A                                  1 24'CUSTOMER KEY'         <5>
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)         <6>
     A                                      EDTCDE(Y)
     A                                  1 72TIME                   <7>
      *
     A                                  3  2'NUMBER    :'
     A            CSNUMD    R        B  3 15REFFLD(CSNUM)          <8>
      *
     A                                 23  2'F3=Exit  F15=Browse'  <9>
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)             <10>
  1. Layar pertama didefinisikan sebagai record format dengan nama KEYR.

  2. Jika function key F3 ditekan akan menyalakan indikator 03.

  3. Jika function key F15 ditekan akan menyalakan indikator 15.

  4. Tampilkan user yang memakai program.

  5. Tampilkan CUSTOMER KEY sebagai nama layar dengan warna putih.

  6. Tampilkan tanggal dengan format dari system dan menampilkan abad. Tanggal 6 Maret 2014 akan ditampilkan sebagai 3/06/2014.

  7. Tampilkan waktu dengan format HH:MM:SS.

  8. Tampilkan dan terima input dalam field CSNUMD. Field CSNUMD menggunakan definisi dari field CSNUM di CUSTPF.

  9. Tampilkan keterangan function key yang diterima program dalam warna biru.

  10. Tampilkan message dari program. Panjang field 78 dan tipe datanya karakter. Field ditampilkan dengan warna putih.

Layar pertama di gunakan untuk menerima input key dari CUSTPF yaitu field CSNUMD. Key ini jika ada dalam file artinya user mau melakukan perubahan record sedangkan jika key ini tidak ada artinya user mau melakukan penambahan record. Jika user ingin melihat record yang sudah tersimpan maka bisa dilakukan dengan browse record yang ada dengan menekan F15. Jika sudah selesai menggunakan program dan ingin keluar dari program maka user bisa menekan F3.

RPG adalah bahasa pemrograman yang pada awalnya menyimpan source code dalam format fixed. Dalam format ini maka karakter pada kolom ke 6 menentukan spesifikasi yang digunakan pada baris tersebut. Karakter tertentu pada kolom tertentu memiliki makna yang berbeda-beda sesuai spesifikasi pada baris tersebut. Komentar ditandai dengan karakter * pada kolom ke 7.

Selain format fixed RPG memiliki format free untuk spesifikasi tertentu. Penulis tidak akan menggunakan format free dalam tutorial ini. Source code yang ditulis dalam format free tidak bisa divalidasi oleh tools editing standard yaitu SEU. Kalau kita menggunakan format free maka dibutuhkan tools tambahan.

Spesifikasi yang kita gunakan untuk program kita hanyalah 3 yaitu: F, D dan C. Spesifikasi F digunakan untuk mendefisinikan file yang dipakai dan bagaimana kita ingin mengakses file tersebut. Spesifikasi D digunakan untuk mendefinisikan variabel yang digunakan program. Spesifikasi C digunakan untuk melakukan pengolahan data.

Versi RPG yang digunakan dalam tutorial ini adalah ILE RPG. Anda dapat membaca buku ILE RPG Programmer’s Guide dan ILE RPG Reference untuk mendalami bahasa pemrograman ILE RPG.

Editor yang kita gunakan untuk mengedit source code yaitu SEU (Source Entry Utility) bisa menampilkan prompt yang sesuai dengan spesifikasi dari baris source code. Prompt ditampilkan dengan menekan function key F4. Dalam prompt anda juga dapat membaca dokumentasi dari kolom yang harus diisi dengan menekan function key F1.

Dalam program ini kita membuka file fisik CUSTPF dan juga file logis CUSLF1. File CUSTPF digunakan untuk mengubah dan dan menambah record sedangkan file CUSLF1 digunakan untuk browsing record yang ada dalam file.

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QDDSSRC(CUSLF1)
      * DATE     : 2014-02-09
      *
      * RECORD DEFINITION
     A          R CSLF1R                    PFILE(SAMUELF1/CUSTPF)
      * FIELD DEFINITION
     A            CSNUM
     A            CSBDAY
     A            CSNAME
      * KEY DEFINITION
     A          K CSNAME

Definisi file logis CUSLF1.

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QRPGLESRC(CUSCRUD)
      * DATE     : 2014-02-06
      *
     FCUSTPF    UF A E           K DISK                       <1>
     FCUSLF1    IF   E           K DISK                       <2>
     FCUSTDF    CF   E             WORKSTN                    <3>
     F                                     SFILE(BROSFLR:RRN)
      *
     D CSNAMES         S                   LIKE(CSNAME)       <4>
     D SFLPAG          C                   CONST(15)          <5>
     D SFLPAGP1        C                   CONST(16)
      *
     C                   DOW       NOT *IN03                  <6>
      *
     C                   EXFMT     KEYR                       <7>
      *
     C                   SELECT
      *
     C                   WHEN      *IN03                      <8>
     C                   EXSR      BYE
      *
     C                   WHEN      *IN15                      <9>
     C                   EXSR      BROWSE
      *
     C                   OTHER                                <10>
     C                   EVAL      MSGD = ''
     C                   IF        CSNUMD <= 0                <11>
     C                   EVAL      MSGD = 'Number must be greater than zero'
     C                   ENDIF
     C                   IF        MSGD = ''                  <12>
     C                   EXSR      ADDUPD
     C                   ENDIF
      *
     C                   ENDSL
      *
     C                   ENDDO
  1. Kolom ke 7 berisi nama file CUSTPF. Kolom 17 berisi U artinya file CUSTPF dibuka dengan mode update. Kolom 18 berisi F artinya file akan diakses secara prosedural dan tidak menggunakan looping internal RPG. Kolom 20 berisi A artinya record bisa ditambahkan dalam file ini. Kolom 22 berisi E artinya file ini menggunakan definisi eksternal. Kolom 34 berisi K artinya file ini diakses menggunakan key. Kolom 36 berisi DISK artinya artinya file ini adalah file fisik atau logis.

  2. Kolom ke 7 berisi nama file CUSLF1. Kolom 17 berisi I artinya file CUSLF1 dibuka dengan mode input. Kolom 18 berisi F artinya file akan diakses secara prosedural dan tidak menggunakan looping internal RPG. Kolom 22 berisi E artinya file ini menggunakan definisi eksternal. Kolom 34 berisi K artinya file ini diakses menggunakan key. Kolom 36 berisi DISK artinya artinya file ini adalah file fisik atau logis.

  3. Kolom ke 7 berisi nama file CUSTDF. Kolom 17 berisi C artinya file CUSLF1 dibuka dengan mode input dan output. Kolom 18 berisi F artinya file akan diakses secara prosedural dan tidak menggunakan looping internal RPG. Kolom 22 berisi E artinya file ini menggunakan definisi eksternal. Kolom 36 berisi WORKSTN artinya artinya file ini adalah file display. Kolom 44 berisi SFILE(BROSFLR:RRN) artinya subfile bernama BROSFLR akan menyimpan relative record number dari subfile dalam variabel bernama RRN. Konsep subfile dan relative record number akan dijelaskan belakangan.

  4. Kolom 7 berisi nama variabel CSNAMES. Kolom 24 berisi S artinya variabel ini berdiri sendiri dan bukan bagian dari struktur data. Kolom 44 berisi LIKE(CSNAME) artinya panjang dan tipe data variabel mengacu kepada field bernama CSNAME. Field ini didefinisikan di CUSTPF.

  5. Kolom 7 berisi nama variabel SFLPAG. Kolom 24 berisi C artinya variabel ini adalah konstanta. Kolom 44 berisi CONST(15) artinya nilai konstanta adalah 15.

  6. Lakukan pengulangan selagi indikator 03 tidak hidup. Indikator 03 hidup jika function key F3 ditekan.

  7. Lakukan output ke layar bernama KEYR di file display CUSTDF lalu tunggu input dari user.

  8. Jika indikator 03 hidup yang artinya function key F3 ditekan maka keluar dari program dengan menjalankan subrutin BYE.

  9. Jika indikator 15 hidup yang artinya function key F15 ditekan maka browse record dengan menjalankan subrutin BROWSE.

  10. Jika indikator 03 dan 15 mati artinya user menekan enter key. Bersihkan variabel MSGD.

  11. Jika variabel CSNUMD yang diinput user sama atau lebih kecil dari nol maka tampilkan pesan kesalahan pada user dengan mengisi variabel MSGD.

  12. Jika MSGD tidak berisi artinya tidak ada kesalahan input CSNUMD maka jalankan subrutin ADDUPD.

     A          R ADDUPDR                   CSRLOC(LINE POS)       <1>
     A                                      CA03(03)               <2>
     A                                      CA12(12)
     A                                      CA23(23)
     A                                  1  2USER                   <3>
     A                                  1 24'CUSTOMER ADD/UPDATE'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
      *
     A                                  3  2'NUMBER    :'          <4>
     A            CSNUMD    R        O  3 15REFFLD(CSNUM)
     A                                  4  2'NAME      :'
     A            CSNAME    R        B  4 15
     A                                  5  2'BIRTHDAY  :'
     A            CSBDAY    R        B  5 15
     A                                  6  2'ADDRESS   :'
     A            CSADDR    R        B  6 15
     A                                  7  2'POST CODE :'
     A            CSPOST    R        B  7 15
     A                                  8  2'EMAIL     :'
     A            CSEML     R        B  8 15
      *
     A            LINE           3  0H                             <5>
     A            POS            3  0H
      *
     A                                 23  2'F3=Exit  F12=Cancel  F23=Delete'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)
  1. CSRLOC(LINE POS) artinya lokasi kursor bisa dikendalikan oleh program lewat variabel LINE dan POS.

  2. Tiga function key bisa diterima oleh layar ini F3, F12 dan F23. Function key F3 akan menyalakan indikator 03. Digunakan untuk keluar dari program. Function key F12 akan menyalakan indikator 12. Digunakan untuk kembali ke layar sebelumnya. Function key F23 akan menyalakan indikator 23. Digunakan untuk menghapus record yang ditampilkan.

  3. Header standard dari program yang menampilkan nama user, nama layar, tanggal dan waktu.

  4. Field-field dari CUSTPF sesuai dengan CSNUMD yang diinput user di layar KEYR. CSNUMD hanyalah output karena key dari record tidak boleh diubah. Field lainnya adalah field output/input.

  5. Variabel LINE dan POS adalah variabel hidden yang digunakan program untuk mengatur posisi kursor. LINE adalah baris dan POS adalah kolom dari kursor.

     C     ADDUPD        BEGSR
      *
     C                   CLEAR     *ALL          CUSPFR              <1>
     C     CSNUMD        CHAIN     CUSTPF                            <2>
     C                   EVAL      CSNUM = CSNUMD                    <3>
      *
     C                   DOU       *IN12                             <4>
      *
     C                   EXFMT     ADDUPDR                           <5>
      *
     C                   SELECT
      *
     C                   WHEN      *IN03                             <6>
     C                   EXSR      BYE
      *
     C                   WHEN      *IN12                             <7>
     C                   LEAVE
      *
     C                   WHEN      *IN23                             <8>
     C                   IF        %FOUND
     C                   EXSR      DEL
     C                   IF        *IN23
     C                   LEAVE
     C                   ENDIF
     C                   ENDIF
      *
     C                   OTHER                                       <9>
     C                   EVAL      MSGD = ''
     C                   EVAL      POS = 15
      *
     C                   SELECT
      *
     C                   WHEN      CSNAME  = ''                      <10>
     C                   EVAL      MSGD = 'Name must not blank'
     C                   EVAL      LINE = 4
      *
     C                   WHEN      CSBDAY  = D'0001-01-01'
     C                   EVAL      MSGD = 'Birthday must not 0001-01-01'
     C                   EVAL      LINE = 5
      *
     C                   WHEN      CSADDR = ''
     C                   EVAL      MSGD = 'Address must not blank'
     C                   EVAL      LINE = 6
      *
     C                   WHEN      CSPOST = ''
     C                   EVAL      MSGD = 'Post code must not blank'
     C                   EVAL      LINE = 7
      *
     C                   WHEN      CSEML = ''
     C                   EVAL      MSGD = 'Email must not blank'
     C                   EVAL      LINE = 8
      *
     C                   ENDSL
      *
     C                   IF        MSGD = ''                         <11>
     C                   IF        %FOUND
     C                   UPDATE    CUSPFR
     C                   ELSE
     C                   WRITE     CUSPFR
     C                   ENDIF
     C                   LEAVE
     C                   ENDIF
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C                   EVAL      *IN12 = *OFF                      <12>
     C                   EVAL      *IN23 = *OFF
     C                   EVAL      MSGD = ''
      *
     C                   ENDSR
  1. Inisialisasi seluruh field yang ada di record format CUSPFR ke nilai kosong. CUSPFR adalah record format dari file fisik CUSTPF.

  2. Cari record dengan key CSNUMD di file CUSTPF. Jika record ditemukan maka record format CUSPFR akan berisi nilai dari file fisik CUSTPF sedangkan jika tidak ditemukan akan berisi nilai kosong karena diinisialisasi di baris sebelumnya.

  3. Isi field CSNUM dengan nilai variabel CSNUMD. Hal ini perlu dilakukan karena jika record tidak ditemukan maka nilai CSNUM akan kosong. Key dari CUSTPF yaitu CSNUM tidak boleh bernilai kosong.

  4. Lakukan pengulangan sampai indikator 12 hidup. Indikator 12 hidup jika function key F12 di tekan.

  5. Lakukan output ke layar bernama ADDUPDR di file display CUSTDF lalu tunggu input dari user.

  6. Jika indikator 03 hidup yang artinya function key F3 ditekan maka keluar dari program dengan menjalankan subrutin BYE.

  7. Jika indikator 12 hidup yang artinya function key F12 ditekan maka keluar dari pengulangan.

  8. Jika indikator 23 hidup yang artinya function key F23 ditekan dan record ada dalam file CUSTPF maka tampilkan layar konfirmasi untuk menghapus record dengan menjalankan subrutin DEL. Jika indikator 23 hidup sesudah menjalankan subrutin DEL artinya function key F23 ditekan lagi dan record dihapus maka keluar dari pengulangan. Penghapusan record membutuhkan konfirmasi ulang dari user untuk menghindari penghapusan yang tidak disengaja. Jadi untuk menghapus record user harus menekan F23 maka layar konfirmasi ditampilkan. Jika user memutuskan untuk menghapus maka harus menekan F23 sekali lagi barulah record dihapus.

  9. Jika indikator 03,12 dan 23 mati artinya user menekan enter key. Maka variabel MSGD untuk menampilkan pesan kesalahan dikosongkan. Lalu kursor ditaruh dikolom 15 dengan mengisi variabel POS.

  10. Jika salah satu nilai field tidak lolos validasi nilai maka variabel MSGD diisi dengan pesan kesalahan dan cursor ditaruh dibaris dimana field input berada.

  11. Jika variabel MSGD kosong artinya semua field lolos validasi maka lakukan ubah jika record sudah ada dan lakukan tambah jika record belum ada.

  12. Jika keluar dari pengulangan dengan menekan F12 maka indikator 12 dan 23 dimatikan dan MSGD diisi nilai kosong.

Subfile adalah file dalam display file. Subfile digunakan untuk menampilkan record dalam file fisik/logis. Karena jumlah record dalam file fisik/logis bersifat dinamis maka subfile juga bersifat dinamis.

Ada macam-macam teknik untuk menggunakan subfile. Dalam program ini penulis menggunakan teknik dengan skalabilitas terbaik yang bisa menampilkan file dengan isi jutaan record tanpa masalah. Teknik yang digunakan adalah subfile satu halaman dalam satu waktu (page at a time subfile). Kekurangan teknik ini adalah kompleksitasnya dan teknik ini menggunakan banyak kekuatan CPU. Teknik lain lebih sederhana akan tetapi makin banyak record dalam sebuah file maka makin banyak memori yang digunakan. Teknik subfile lain tidak cocok digunakan untuk file dengan jumlah record yang banyak sekali.

Untuk menggunakan subfile maka kita harus mendefinisikan 3 record format dalam file display:

  1. Subfile. Definisi field dalam file fisik yang akan ditampilkan.

  2. Subfile control. Mengatur perilaku dari subfile.

  3. Footer. Menampilkan keterangan function key dan pesan kesalahan.

     A          R BROSFLR                   SFL                      <1>
     A            CSNUM     R        O  7  2                         <2>
     A            CSNAME    R        O  7 14
     A            CSBDAY    R        O  7 46
  1. Kolom 45 berisi nilai SFL yang menandakan record format BROSFLR adalah subfile.

  2. Field yang akan ditampilkan mengacu ke CUSTPF dan bersifat output saja.

     A          R BROSFCR                   SFLCTL(BROSFLR)          <1>
     A                                      CA03(03)                 <2>
     A                                      CA12(12)
     A                                      SFLSIZ(0015)             <3>
     A                                      SFLPAG(0015)             <4>
     A                                      OVERLAY                  <5>
     A                                      ROLLUP(25)               <6>
     A                                      ROLLDOWN(26)
     A N32                                  SFLDSP                   <7>
     A N31                                  SFLDSPCTL                <8>
     A  31                                  SFLCLR                   <9>
     A  90                                  SFLEND(*MORE)            <10>
     A                                      SFLCSRRRN(&RRNC)         <11>
     A            RRN            4S 0H                               <12>
     A            RRNC           5S 0H
     A                                  1  2USER                     <13>
     A                                  1 24'CUSTOMER BROWSE'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
     A                                  4  2'NAME      :'            <14>
     A            CSNAMED   R        B  4 15REFFLD(CSNAME)
     A                                  6  2'NUMBER'                 <15>
     A                                      DSPATR(HI)
     A                                  6 14'NAME'
     A                                      DSPATR(HI)
     A                                  6 46'BIRTHDAY'
     A                                      DSPATR(HI)
  1. Kolom 45 berisi nilai SFLCTL(BROSFLR) yang menandakan record format BROSFCR adalah subfile control dari subfile yang bernama BROSFLR.

  2. Function key yang bisa diterima layar ini adalah F3 dan F12. Function key F3 akan menyalakan indikator 03. Digunakan untuk keluar dari program. Function key F12 akan menyalakan indikator 12. Digunakan untuk kembali ke layar sebelumnya.

  3. Jumlah record dalam subfile adalah 15.

  4. Jumlah record dalam 1 halaman subfile adalah 15.

  5. Kolom 45 berisi nilai OVERLAY artinya layar ini bisa ditampilkan bersama sama dengan layar lain. Perilaku normal file display adalah menghapus sebuah layar sebelum menampilkan layar lain. Dengan kata kunci OVERLAY maka apa yang ditulis layar ini tidak akan dihapus saat kita menampilkan layar lain.

  6. Key PgDn akan menyalakan indikator 25 sedangkan key PgUp akan menyalakan indikator 26.

  7. Jika indikator 32 mati maka tampilkan subfile yang dikendalikan oleh subfile control. Indikator ini diperlukan jika tidak ada record dalam file fisik/logis. Menampilkan subfile tanpa record akan menyebabkan error. Jadi jika tidak ada record dalam file fisik/logis maka subfile tidak di tampilkan.

  8. Jika indikator 31 mati maka tampilkan subfile bersama subfile control.

  9. Jika indikator 31 hidup maka kosongkan isi dari subfile.

  10. Jika indikator 90 hidup artinya record terakhir sudah ditampilkan. Masih ada record yang belum ditampilkan diindikasikan dengan text More… di bagian kanan paling bawah subfile. Jika record terakhir sudah ditampilkan maka text Bottom akan ditampilkan.

  11. Relative record number berdasarkan posisi cursor disimpan dalam variabel RRNC.

  12. Relative record number disimpan dalam variabel RRN dan relative record number berdasarkan posisi cursor disimpan dalam variabel RRNC. Kedua variabel ini adalah variabel tersembunyi yang tidak ditampilkan dilayar dan hanya diakses oleh program.

  13. Header standard dari program yang menampilkan nama user, nama layar, tanggal dan waktu.

  14. Menampilkan dan menerima input variabel CSNAMED. Variabel ini digunakan untuk mencari record yang kolom namanya diawali dengan nilai dari variabel ini.

  15. Header keterangan untuk field yang ditampilkan subfile dalam warna putih.

     A          R BROSFFR
     A                                 23  2'F3=Exit  F12=Cancel'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)

Layar footer menampilkan keterangan function key dan pesan program.

     C     BROWSE        BEGSR
      *                                                                <1>
     C                   EVAL      MSGD = 'Select record using cursor and Enter'
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   DOU       *IN12                               <2>
      *
     C                   WRITE     BROSFFR                             <3>
     C                   EVAL      MSGD = ''
     C                   EXFMT     BROSFCR
      *
     C                   SELECT
      *
     C                   WHEN      *IN03                               <4>
     C                   EXSR      BYE
      *
     C                   WHEN      *IN12                               <5>
     C                   LEAVE
      *
     C                   WHEN      CSNAMED <> *BLANKS                  <6>
     C     CSNAMED       SETLL     CSLF1R
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
     C                   CLEAR                   CSNAMED
      *
     C                   WHEN      CSNAMED = *BLANKS AND RRNC > *ZERO  <7>
     C     RRNC          CHAIN     BROSFLR
     C                   EVAL      CSNUMD = CSNUM
     C                   EXSR      ADDUPD
     C     CSNAMES       SETLL     CSLF1R
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   WHEN      *IN25 AND (NOT *IN90)               <8>
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   WHEN      *IN26 AND (NOT *IN32)               <9>
     C                   EXSR      GOBACK
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C     *LOVAL        SETLL     CSLF1R                              <10>
     C                   EVAL      *IN12 = *OFF
      *
     C                   ENDSR
  1. Tampilkan pesan cara memilih record untuk diubah dengan memindahkan cursor dan menekan enter. Jalankan subrutin CLRSFL untuk membersihkan subfile lalu jalankan subrutin SFLBLD untuk menampilkan subfile.

  2. Lakukan pengulangan sampai indikator 12 menyala yang berarti function key F12 ditekan.

  3. Tampilkan layar footer BROSFFR. Bersihkan pesan lalu tampilkan layar subfile control BROSFCR untuk menerima input.

  4. Jika function key F3 ditekan maka indikator 03 menyala dan keluar dari program dengan menjalankan subrutin BYE.

  5. Jika function key F12 ditekan maka indikator 12 menyala dan keluar dari pengulangan.

  6. Jika field CSNAMED diisi maka geser record ke posisi dimana CSNAME sama atau lebih besar dari CSNAMED.

  7. Jika field CSNAMED kosong dan RRN dari cursor lebih besar dari nol berarti user menggeser cursor untuk memilih record lalu menekan enter. Ubah nilai CSNUMD ke nilai CSNUM dari record lalu jalankan subrutin ADDUPD. Geser record ke posisi dimana field CSNAME sama atau lebih besar dari CSNAMES. Nilai field CSNAMES berasal dari field CSNAME record pertama dari subfile sebelum dilakukan perubahan atau penghapusan melalui subrutin ADDUPD.

  8. Jika function key PgDn ditekan maka indikator 25 menyala dan jika akhir dari record belum tercapai maka jalankan subrutin CLRSFL untuk membersihkan subfile lalu jalankan subrutin SFLBLD untuk menampilkan subfile.

  9. Jika function key PgUp ditekan maka indikator 26 menyala dan jika ada record dalam file maka jalankan subrutin GOBACK untuk menggeser mundur posisi record, jalankan subrutin CLRSFL untuk membersihkan subfile lalu jalankan subrutin SFLBLD untuk menampilkan subfile.

  10. Jika keluar dari pengulangan maka geser record ke record pertama lalu matikan indikator 12.

     C     CLRSFL        BEGSR
     C                   EVAL      RRN = *ZERO
     C                   EVAL      *IN31 = *ON
     C                   WRITE     BROSFCR
     C                   EVAL      *IN31 = *OFF
     C                   EVAL      *IN32 = *OFF
     C                   ENDSR

Isi nilai RRN dengan nol. Hidupkan indikator 31 dan tampilkan subfile control BROSFCR maka tampilan subfile dilayar akan dibersihkan. Matikan indikator 31 untuk membersihkan subfile dan indikator 32 untuk menampilkan subfile.

     C     SFLBLD        BEGSR
      *
     C                   DO        SFLPAG                              <1>
     C                   READ      CSLF1R                                 90
     C                   IF        *IN90                               <2>
     C                   LEAVE
     C                   ENDIF
     C                   EVAL      RRN = RRN + 1                       <3>
     C                   WRITE     BROSFLR
     C                   IF        RRN = 1                             <4>
     C                   EVAL      CSNAMES = CSNAME
     C                   ENDIF
     C                   ENDDO
      *
     C                   IF        RRN = *ZERO                         <5>
     C                   EVAL      *IN32 = *ON
     C                   ENDIF
      *
     C                   ENDSR
  1. Lakukan pengulangan sebanyak nilai konstanta SFLPAG. Baca file logis CSLF1R dan jika akhir record tercapai maka nyalakan indikator 90.

  2. Jika akhir record tercapai maka indikator 90 menyala dan keluar dari pengulangan.

  3. Tambahkan 1 ke nilai variabel RRN. Tampilkan layar subfile BROSFLR.

  4. Jika record adalah record ke 1 maka simpan nilai field CSNAME ke variabel CSNAMES.

  5. Sesudah keluar dari pengulangan jika RRN berisi nol artinya file logis tidak memiliki record maka hidupkan indikator 32 supaya layar subfile tidak ditampilkan.

     C     GOBACK        BEGSR
      *
     C     CSNAMES       SETLL     CSLF1R                              <1>
     C                   DO        SFLPAGP1                            <2>
     C                   READP     CSLF1R
     C                   IF        %EOF                                <3>
     C     *LOVAL        SETLL     CSLF1R
     C                   LEAVE
     C                   ENDIF
     C                   ENDDO
      *
     C                   ENDSR
  1. Geser record ke posisi dimana field CSNAME sama atau lebih besar dari CSNAMES.

  2. Lakukan pengulangan sebanyak nilai konstanta SFLPAGP1. Baca mundur 1 record.

  3. Jika awal record tercapai maka geser record ke posisi pertama lalu keluar dari pengulangan.

     A          R DELR                      CA03(03)                   <1>
     A                                      CA12(12)
     A                                      CA23(23)
     A                                  1  2USER                       <2>
     A                                  1 24'CUSTOMER DELETE'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
      *
     A                                  3  2'NUMBER    :'              <3>
     A            CSNUMD    R        O  3 15REFFLD(CSNUM)
     A                                  4  2'NAME      :'
     A            CSNAME    R        O  4 15
     A                                  5  2'BIRTHDAY  :'
     A            CSBDAY    R        O  5 15
     A                                  6  2'ADDRESS   :'
     A            CSADDR    R        O  6 15
     A                                  7  2'POST CODE :'
     A            CSPOST    R        O  7 15
     A                                  8  2'EMAIL     :'
     A            CSEML     R        O  8 15
      *                                                                <4>
     A                                 23  2'F3=Exit  F12=Cancel  F23=Delete'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)
  1. Tiga function key bisa diterima oleh layar ini F3, F12 dan F23. Function key F3 akan menyalakan indikator 03. Digunakan untuk keluar dari program. Function key F12 akan menyalakan indikator 12. Digunakan untuk kembali ke layar sebelumnya. Function key F23 akan menyalakan indikator 23. Digunakan untuk menghapus record yang ditampilkan.

  2. Header standard dari program yang menampilkan nama user, nama layar, tanggal dan waktu.

  3. Field-field dari CUSTPF sesuai dengan CSNUMD yang diinput user di layar KEYR. Semua field hanyalah output karena ini layar konfirmasi delete.

  4. Keterangan function key dan pesan program.

     C     DEL           BEGSR
      *
     C                   EVAL      MSGD = 'Press F23 again to delete'  <1>
      *
     C                   DOU       *IN23                               <2>
      *
     C                   EXFMT     DELR                                <3>
      *
     C                   SELECT
      *
     C                   WHEN      *IN03                               <4>
     C                   EXSR      BYE
      *
     C                   WHEN      *IN12                               <5>
     C                   LEAVE
      *
     C                   WHEN      *IN23                               <6>
     C                   DELETE    CUSPFR
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C                   EVAL      *IN12 = *OFF                        <7>
     C                   EVAL      MSGD = ''
      *
     C                   ENDSR
  1. Tampilkan pesan untuk menekan F23 sekali lagi untuk menghapus.

  2. Lakukan pengulangan sampai indikator 23 menyala yang artinya function key F23 ditekan.

  3. Tampilkan layar konfirmasi delete DELR.

  4. Jika function key F3 ditekan maka indikator 03 menyala dan keluar dari program dengan menjalankan subrutin BYE.

  5. Jika function key F12 ditekan maka indikator 12 menyala dan keluar dari pengulangan.

  6. Jika function key F23 ditekan maka indikator 23 menyala dan hapus record.

  7. Matikan indikator 12 dan isi field pesan MSGD dengan nilai kosong.

     C     BYE           BEGSR
     C                   CLOSE     CUSLF1
     C                   CLOSE     CUSTPF
     C                   CLOSE     CUSTDF
     C                   EVAL      *INLR = *ON
     C                   RETURN
     C                   ENDSR

Subrutin untuk keluar dari program. Tutup semua file yang dipakai: CUSLF1, CUSTPF dan CUSTDF. Nyalakan indikator INLR untuk memerintahkan RPG melakukan pembersihan internal. Kembali ke program yang memanggil program ini.

Source code lengkap display file CUSTDF

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QDDSSRC(CUSTDF)
      * DATE     : 2014-02-06
      *
     A                                      REF(SAMUELF1/CUSTPF)
      *
     A          R KEYR
     A                                      CA03(03)
     A                                      CA15(15)
     A                                  1  2USER
     A                                  1 24'CUSTOMER KEY'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
      *
     A                                  3  2'NUMBER    :'
     A            CSNUMD    R        B  3 15REFFLD(CSNUM)
      *
     A                                 23  2'F3=Exit  F15=Browse'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)
      *
     A          R ADDUPDR                   CSRLOC(LINE POS)
     A                                      CA03(03)
     A                                      CA12(12)
     A                                      CA23(23)
     A                                  1  2USER
     A                                  1 24'CUSTOMER ADD/UPDATE'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
      *
     A                                  3  2'NUMBER    :'
     A            CSNUMD    R        O  3 15REFFLD(CSNUM)
     A                                  4  2'NAME      :'
     A            CSNAME    R        B  4 15
     A                                  5  2'BIRTHDAY  :'
     A            CSBDAY    R        B  5 15
     A                                  6  2'ADDRESS   :'
     A            CSADDR    R        B  6 15
     A                                  7  2'POST CODE :'
     A            CSPOST    R        B  7 15
     A                                  8  2'EMAIL     :'
     A            CSEML     R        B  8 15
      *
     A            LINE           3  0H
     A            POS            3  0H
      *
     A                                 23  2'F3=Exit  F12=Cancel  F23=Delete'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)
      *
     A          R BROSFLR                   SFL
     A            CSNUM     R        O  7  2
     A            CSNAME    R        O  7 14
     A            CSBDAY    R        O  7 46
      *
     A          R BROSFCR                   SFLCTL(BROSFLR)
     A                                      CA03(03)
     A                                      CA12(12)
     A                                      SFLSIZ(0015)
     A                                      SFLPAG(0015)
     A                                      OVERLAY
     A                                      ROLLUP(25)
     A                                      ROLLDOWN(26)
     A N32                                  SFLDSP
     A N31                                  SFLDSPCTL
     A  31                                  SFLCLR
     A  90                                  SFLEND(*MORE)
     A                                      SFLCSRRRN(&RRNC)
     A            RRN            4S 0H
     A            RRNC           5S 0H
     A                                  1  2USER
     A                                  1 24'CUSTOMER BROWSE'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
     A                                  4  2'NAME      :'
     A            CSNAMED   R        B  4 15REFFLD(CSNAME)
     A                                  6  2'NUMBER'
     A                                      DSPATR(HI)
     A                                  6 14'NAME'
     A                                      DSPATR(HI)
     A                                  6 46'BIRTHDAY'
     A                                      DSPATR(HI)
      *
     A          R BROSFFR
     A                                 23  2'F3=Exit  F12=Cancel'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)
      *
     A          R DELR                      CA03(03)
     A                                      CA12(12)
     A                                      CA23(23)
     A                                  1  2USER
     A                                  1 24'CUSTOMER DELETE'
     A                                      DSPATR(HI)
     A                                  1 61DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                  1 72TIME
      *
     A                                  3  2'NUMBER    :'
     A            CSNUMD    R        O  3 15REFFLD(CSNUM)
     A                                  4  2'NAME      :'
     A            CSNAME    R        O  4 15
     A                                  5  2'BIRTHDAY  :'
     A            CSBDAY    R        O  5 15
     A                                  6  2'ADDRESS   :'
     A            CSADDR    R        O  6 15
     A                                  7  2'POST CODE :'
     A            CSPOST    R        O  7 15
     A                                  8  2'EMAIL     :'
     A            CSEML     R        O  8 15
      *
     A                                 23  2'F3=Exit  F12=Cancel  F23=Delete'
     A                                      COLOR(BLU)
     A            MSGD          78A  O 24  2DSPATR(HI)

Source code lengkap program RPG ILE CUSCRUD

      * AUTHOR   : SAMUEL FRANKLYN <SFRANKLYN AT GMAIL.COM>
      * LOCATION : SAMUELF1/QRPGLESRC(CUSCRUD)
      * DATE     : 2014-02-06
      *
     FCUSTPF    UF A E           K DISK
     FCUSLF1    IF   E           K DISK
     FCUSTDF    CF   E             WORKSTN
     F                                     SFILE(BROSFLR:RRN)
      *
     D CSNAMES         S                   LIKE(CSNAME)
     D SFLPAG          C                   CONST(15)
     D SFLPAGP1        C                   CONST(16)
      *
     C                   DOW       NOT *IN03
      *
     C                   EXFMT     KEYR
      *
     C                   SELECT
      *
     C                   WHEN      *IN03
     C                   EXSR      BYE
      *
     C                   WHEN      *IN15
     C                   EXSR      BROWSE
      *
     C                   OTHER
     C                   EVAL      MSGD = ''
     C                   IF        CSNUMD <= 0
     C                   EVAL      MSGD = 'Number must be greater than zero'
     C                   ENDIF
     C                   IF        MSGD = ''
     C                   EXSR      ADDUPD
     C                   ENDIF
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C     ADDUPD        BEGSR
      *
     C                   CLEAR     *ALL          CUSPFR
     C     CSNUMD        CHAIN     CUSTPF
     C                   EVAL      CSNUM = CSNUMD
      *
     C                   DOU       *IN12
      *
     C                   EXFMT     ADDUPDR
      *
     C                   SELECT
      *
     C                   WHEN      *IN03
     C                   EXSR      BYE
      *
     C                   WHEN      *IN12
     C                   LEAVE
      *
     C                   WHEN      *IN23
     C                   IF        %FOUND
     C                   EXSR      DEL
     C                   IF        *IN23
     C                   LEAVE
     C                   ENDIF
     C                   ENDIF
      *
     C                   OTHER
     C                   EVAL      MSGD = ''
     C                   EVAL      POS = 15
      *
     C                   SELECT
      *
     C                   WHEN      CSNAME  = ''
     C                   EVAL      MSGD = 'Name must not blank'
     C                   EVAL      LINE = 4
      *
     C                   WHEN      CSBDAY  = D'0001-01-01'
     C                   EVAL      MSGD = 'Birthday must not 0001-01-01'
     C                   EVAL      LINE = 5
      *
     C                   WHEN      CSADDR = ''
     C                   EVAL      MSGD = 'Address must not blank'
     C                   EVAL      LINE = 6
      *
     C                   WHEN      CSPOST = ''
     C                   EVAL      MSGD = 'Post code must not blank'
     C                   EVAL      LINE = 7
      *
     C                   WHEN      CSEML = ''
     C                   EVAL      MSGD = 'Email must not blank'
     C                   EVAL      LINE = 8
      *
     C                   ENDSL
      *
     C                   IF        MSGD = ''
     C                   IF        %FOUND
     C                   UPDATE    CUSPFR
     C                   ELSE
     C                   WRITE     CUSPFR
     C                   ENDIF
     C                   LEAVE
     C                   ENDIF
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C                   EVAL      *IN12 = *OFF
     C                   EVAL      *IN23 = *OFF
     C                   EVAL      MSGD = ''
      *
     C                   ENDSR
      *
     C     BROWSE        BEGSR
      *
     C                   EVAL      MSGD = 'Select record using cursor and Enter'
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   DOU       *IN12
      *
     C                   WRITE     BROSFFR
     C                   EVAL      MSGD = ''
     C                   EXFMT     BROSFCR
      *
     C                   SELECT
      *
     C                   WHEN      *IN03
     C                   EXSR      BYE
      *
     C                   WHEN      *IN12
     C                   LEAVE
      *
     C                   WHEN      CSNAMED <> *BLANKS
     C     CSNAMED       SETLL     CSLF1R
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
     C                   CLEAR                   CSNAMED
      *
     C                   WHEN      CSNAMED = *BLANKS AND RRNC > *ZERO
     C     RRNC          CHAIN     BROSFLR
     C                   EVAL      CSNUMD = CSNUM
     C                   EXSR      ADDUPD
     C     CSNAMES       SETLL     CSLF1R
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   WHEN      *IN25 AND (NOT *IN90)
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   WHEN      *IN26 AND (NOT *IN32)
     C                   EXSR      GOBACK
     C                   EXSR      CLRSFL
     C                   EXSR      SFLBLD
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C     *LOVAL        SETLL     CSLF1R
     C                   EVAL      *IN12 = *OFF
      *
     C                   ENDSR
      *
     C     CLRSFL        BEGSR
     C                   EVAL      RRN = *ZERO
     C                   EVAL      *IN31 = *ON
     C                   WRITE     BROSFCR
     C                   EVAL      *IN31 = *OFF
     C                   EVAL      *IN32 = *OFF
     C                   ENDSR
      *
     C     SFLBLD        BEGSR
      *
     C                   DO        SFLPAG
     C                   READ      CSLF1R                                 90
     C                   IF        *IN90
     C                   LEAVE
     C                   ENDIF
     C                   EVAL      RRN = RRN + 1
     C                   WRITE     BROSFLR
     C                   IF        RRN = 1
     C                   EVAL      CSNAMES = CSNAME
     C                   ENDIF
     C                   ENDDO
      *
     C                   IF        RRN = *ZERO
     C                   EVAL      *IN32 = *ON
     C                   ENDIF
      *
     C                   ENDSR
      *
     C     GOBACK        BEGSR
      *
     C     CSNAMES       SETLL     CSLF1R
     C                   DO        SFLPAGP1
     C                   READP     CSLF1R
     C                   IF        %EOF
     C     *LOVAL        SETLL     CSLF1R
     C                   LEAVE
     C                   ENDIF
     C                   ENDDO
      *
     C                   ENDSR
      *
     C     DEL           BEGSR
      *
     C                   EVAL      MSGD = 'Press F23 again to delete'
      *
     C                   DOU       *IN23
      *
     C                   EXFMT     DELR
      *
     C                   SELECT
      *
     C                   WHEN      *IN03
     C                   EXSR      BYE
      *
     C                   WHEN      *IN12
     C                   LEAVE
      *
     C                   WHEN      *IN23
     C                   DELETE    CUSPFR
      *
     C                   ENDSL
      *
     C                   ENDDO
      *
     C                   EVAL      *IN12 = *OFF
     C                   EVAL      MSGD = ''
      *
     C                   ENDSR
      *
     C     BYE           BEGSR
     C                   CLOSE     CUSLF1
     C                   CLOSE     CUSTPF
     C                   CLOSE     CUSTDF
     C                   EVAL      *INLR = *ON
     C                   RETURN
     C                   ENDSR