You are currently browsing the category archive for the ‘RPG/AS 400’ category.


 d up              C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
 d lo              C                   'abcdefghijklmnopqrstuvwxyz'
 d case            S            100A
 c     *entry        plist
 c                   parm                    case
 /FREE
       case = %xlate(lo:up:case);
 /END-FREE
 

tanpa JDFTVAL maka join tersebut adalah inner join. artinya record yang ditampilakan adalah record yang value dari join field harus match di kedua file tsb
dengan JDFTVAL maka join tersebut adalah outer (Left) Join. artinya record yang ditampilkan adalah seluruh record dari PF1, dan field dari PF2 yang berkorespondensi dengan PF1. jika di PF2 tidak ada, maka terisi blank.

PF1 :

A          R PF1PR            
A            NAMA          10A
A            ALAMAT        10A
A            TLP           12A
A          K NAMA

PF2 :

A          R PF2PR            
A            NAMA          10A
A            STATUS         1A
A            ANAK           2A
A          K NAMA

Join1:

A                                      JDFTVAL        
A          R LFJOINR                   JFILE(PF1 PF2) 
A                                                     
A          J                           JOIN(1 2)      
A                                      JFLD(NAMA NAMA)
A*                                                    
A            NAMA                      JREF(1)        
A            ALAMAT                    JREF(1)        
A            TLP                       JREF(1)        
A            STATUS                    JREF(2)        
A            ANAK                      JREF(2)

       
Join2:

A          R LFJOINR                   JFILE(PF1 PF2) 
A                                                     
A          J                           JOIN(1 2)      
A                                      JFLD(NAMA NAMA)
A*                                                    
A            NAMA                      JREF(1)        
A            ALAMAT                    JREF(1)        
A            TLP                       JREF(1)        
A            STATUS                    JREF(2)        
A            ANAK                      JREF(2)

note: key (K) tidak mempengaruihi isi join yang akan ditampilkan. K hanya sebagai indexing atau key chain.

Banyak metode yang dapat digunakan untuk mengambil source code dari AS/400 ke PC. Saya lebih sering menggunakan FTP, karena lebih mudah dapat dibaca di PC berupa text file. Kali ini akan saya coba ulas sedikit cara mengambil source code dari AS/400 ke PC (Os. Windows).

Asumsi bahwa source code yang akan diambil berada di :

AS/400 dengan IP : 10.10.1.10
Library : Eden
Source File : QRPGLESRC
Member : TST1R

Cara simple untuk mengambil code tersebut adalah menggunakan commad prompt yang tersedia di Windows. Berikut langkah-langkahnya

1. Nyalakan aplikasi command prompt. Secara default apliasi ini ada di “Program Files” -> “Accesories” -> “Command Prompt”. Tips : tekan Win+R, kemudian ketikan “cmd” (tanpa tanda kutip) dan Enter.

2. Tuju ke folder yang akan dijadikan tempat untuk menyimpan source code yang akan diambil. Misalkan saya akan menyimpan di Drive D, maka commandnya adalah “D:”.

3. Akses server AS/400 menggunakan FTP. Ketikan command FTP ip-Address, dalam hal ini : “FTP 10.10.1.10” (tanpa tanda kutip). Kemudian Log-in.

4. Set library source code sebagai current library. Gunakan command “CD nama-library”, dalam hal ini : “CD Eden” (tanpa tanda kutip).

6. Ambil source code. Gunakan command “Get nama-source-file.nama-member”, dalam hal ini : “Get QRPGLESRC.TST1R” (tanpa tanda kutip).

7. Maka source code akan ada di dirve D dengan nama file : Qrpglesrc.Tst1R. Source code ini berupa text file, bisa dibuka di notepad atau text editor lainnya.

8. Untuk keluar dari FTP dan Command Prompt, ketikan command bye – enter – exit – enter.

Kurang lebih jika step-step ini dijalankan yang muncul di layar command prompt akan seperti ini :

Microsoft Windows XP [Version 5.1.2600]
(C) Copyright 1985-2001 Microsoft Corp.
C:\Documents and Settings>d:
D:\>FTP 10.10.1.10
Connected to 10.10.1.10.
220-QTCP at AS400.
220 Connection will close if idle more than 5 minutes.
User (10.10.1.10:(none)): eden
331 Enter password.
Password:
230 EDEN logged on.
ftp> cd eden
250 "EDEN" is current library.
ftp> get qrpglesrc.tst1r
200 PORT subcommand request successful.
150 Retrieving member TST1R in file QRPGLESRC in library EDEN.
250 File transfer completed successfully.
ftp: 633 bytes received in 0.09Seconds 6.73Kbytes/sec.
ftp> bye
221 QUIT subcommand received.
D:\> exit

Untuk selanjutnya, dengan beberapa modifikasi, cara ini saya gunakan sebagai salah satu cara dalam mem-backup source code AS/400.

klo RPGLE pake %trim, CL pake *TCAT.

exp :

CHGVAR     VAR(&LINK) VALUE('/' *TCAT &HOME *TCAT '/' *TCAT &FOLDER *TCAT '/' *CAT &ALL)

Tergiur liat LinkedIn nya si bos, akhirnya ikutan bikin juga deh. Tapi masih bingung bikin resume nya.. hahahahaha… :p

My Profesional Profile at LinkedIn 😉

Bagi para pecinta indicator, mungkin ini sedikit tips untuk mempermudah membaca code dikemudian hari.

Buat variable found/not found :

D Found           S              1A   INZ('0')
D NotFound        S              1A   INZ('1')

Kemudian di kodingan bisa seperti ini :

c     DISKEY        chain     T1KEN10LR                          96
c                   if        *in96 = NotFound

atau

c     DISKEY        chain     T1AGUNAR                           98
c                   if        *in98 = NotFound or
c                             (*in98 = Found and aStaval = 'S')

Toh ini akan sama aja dengan :

c     DISKEY        chain     T1KEN10LR                          96
c                   if        *in96 = '1'

atau

c     DISKEY        chain     T1AGUNAR                           98
c                   if        *in98 = '1' or
c                             (*in98 = '0' and aStaval = 'S')

Cuma perlu diingat, untuk command LOOKUP found itu bernilai ‘1’ dan not found bernilai ‘0’ (kebalikan dari chain/reade)

 

*Nb. Tips ini didapat dari mas Prayugo ketika diskusi optimalisasi JF.

Error/Message CPF4131 adalah Runtime Error. Hal ini biasanya terjadi karena Program RPG dan FILE tidak sinkron. Skenario kasus yang biasanya menyebabkan CPF4131 :

1. RPG A di-compile dengan kondisi FILE 1 (PF/LF).

2. Ada perubahan struktur di File 1 tersebut, lalu di-compile.

3. RPG A yang menggunakan File 1 tidak di-compile ulang.

4. Run RPG A, maka MSGW CPF4131

Pertanyaannya : “Bagaimana bisa tahu atau memastikan bahwa RPG A sudah benar menggunakan File 1 ?

Jawab : Menggunakan command DSPPGMREF dan DSPFD

Penjelasan :

Isi dari Error CPF4131 adalah sebagai berikut :

Message ID . . . . . . . . . :   CPF4131
Message file . . . . . . . . :   QCPFMSG
Library  . . . . . . . . . . :     QSYS


Message . . . . :   Level check on file &2 in library &3 with member &4.
Cause . . . . . :   The file requested to be opened is file &1.  The file
actually opened is file &2 in library &3.  For the file actually opened, the
record format level identifiers supplied by the program does not match the
file actually opened.
Recovery  . . . :   Do one of the following, then try the request again:
-- Compile the program again.
-- Specify the *NO value for the LVLCHK parameter as an override using the
appropriate OVRDBF, OVRDSPF, OVRICFF, or OVRPRTF command.

Perhatikan yang di cetak tebal. Dikatakan bahwa : “Record Format Level Indentifier does not match”.

1. Cara untuk mengetahui untuk mengetahui Record Format Level Identifier pada File adalah dengan menggunakan command DSPFD <nama file>. Contoh, berikut adalah bagian informasi menggunakan DSPFD dari File T1MSTRKO :

Record  Format Level
Format       Fields   Length  Identifier
T1MSTRKR        108     1083  37DC85F1F3062

Diketahui bahwa Identifier dari T1MSTRKO adalah 37DC85F1F3062. Nilai ini tentunya berbeda-beda pada setiap file.

2. Cara untuk mengetahui Record Format Level Identifier dari setiap File yang digunakan pada program RPG adalah dengan menggunakan command DSPPGMREF <nama program>. Contoh, berikut adalah bagian informasi  menggunakan DSPPGMREF dari Program DISMVALR (Program ini menggunakan File T1MSTRKO) :

Object  . . . . . . . . . . . . . . . . . :     T1MSTRKO
Library . . . . . . . . . . . . . . . . . :       JF-(sensor :p)-D
Object type . . . . . . . . . . . . . . . :       *FILE
File name in program  . . . . . . . . . . :       T1MSTRKO
File usage  . . . . . . . . . . . . . . . :       Input
Output
Update
Number of record formats  . . . . . . . . :           1
Record Format      Format Level Identifier Field Count
T1MSTRKR              37DC85F1F3062 108

Terlihat bahwa Identifier dari T1MSTRKO yang digunakan adalah 37DC85F1F3062. Dan ini sama dengan File Identifier pada T1MSTRKO, sehingga ketika DISMVALR di-run tidak akan memunculkan message CPF4131 untuk file T1MSTRKO. Jika Berbeda ?

Apa yang harus diperhatikan ketika mereviu suatu code ?

1. Jangan sampai ada LOOP yang tidak punya exit condition. Jika terjadi kasus ini FATAL akibatnya, bisa bikin server down karena cpu proses bisa mencapai 100%.

2. Jangan pelit kasih komentar, bikin susah orang lain buat baca code.

3. Khusus RPG. Jika menggunakan File dengan Spec File Type : “U” dan kita hanya perlu Read Data tanpa UPDATE (atau proses record lainnya) MAKA gunakan extend operation code N. (exp : “CHAIN(N)”). Chain terhadap File dengan Type “U” akan me-lock record tersebut. Lock akan lepas ketika telah sampai pada line Update/Delete terhadap File tersebut.

4. …

*Ini sama aja dengan Apa yang harus diperhatikan ketika coding

Melanjutkan tulisan saya tentang “Read File From Table”, saya mencoba mengembangkannya menjadi program untuk Monitor Status Job atau Subsystem.

Program monitor ini dengan sedikit modifikasi dapat berjalan secara batch sehingga dapat terus memonitor kondisi job pada subsystem tertentu.

Untuk File SPOOL1P dapat dilihat pada post tentang RPG sebelumnya. Berikut potongan code CL :

DCL        VAR(&STSJOB) TYPE(*CHAR) LEN(4)
DCLF       FILE(SPOOL1P)
CLRPFM     FILE(&LIBD/SPOOL1P)
WRKACTJOB  OUTPUT(*PRINT) SBS(&SBS)
CPYSPLF    FILE(QPDSPAJB) TOFILE(&LIBD/SPOOL1P) SPLNBR(*LAST)
DLTSPLF    FILE(QPDSPAJB) SPLNBR(*LAST)
E:
RCVF       RCDFMT(SPOOLR)
MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(F))
CHGVAR     VAR(&RECORD) VALUE(&RECORD+1)
CHGVAR     VAR(&STSJOB) VALUE(%SST(&SPOOL 111 4))
IF         COND(&RECORD *LE 10) THEN(GOTO CMDLBL(E))
IF         COND(&STSJOB *EQ 'MSGW') THEN(DO)
/* put some handler here */
ENDDO
GOTO       CMDLBL(E)
F:

Akhirnya ada juga tentang AS400 yang bisa saya share disini, sekalian reminder juga buat sendiri… :p

klo perlu read table (PF) tapi pengen di CL kita bisa pake command RCVF (Receive File). Nah, nama file yang akan dibuka di declare dulu pake DCLF (Declare File) dibagian declare variabel. CPF0864 (End of file detected for file) bisa digunakan untuk nge-cek apakah record found or not found.

Contoh code :

* PF (SPOOL1P) :
A          R SPOOLR
A            SPOOL 133A

/*CL :*/
PGM

DCL  VAR(&STSJOB) TYPE(*CHAR) LEN(4)
DCLF FILE(SPOOL1P)

RCVF   RCDFMT(SPOOLR)
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(EXIT))
CHGVAR VAR(&STSJOB) VALUE(%SST(&SPOOL 111 4))

EXIT:
ENDPGM

Command ini selanjutnya saya kembangkan untuk cek status job, apakah MSGW atau tidak. Untuk bagian ini…. insya Allah saya posting lagi nanti… 😉
Semoga bermanfaat…