This blog gives you a quick look related to Special Programs on iSeries AS400.Special programs are not widely used or very less people know about it; however there are some good things therefore they come into the picture.
Special programs basically used with database files whose device type is 'Special', however other types under devices are
DISK, WORKSTN, PRINTER, SEQ & SPECIAL.
Special programs are like trigger programs which get fired automatically whenever you do some changes to DB files. The main difference between trigger & special program is, trigger programs invoked whenever you do some record changes with database file like following.
1. Insert Record
2. Delete Record
3. Update Record.
4. Read Record.
Trigger programs associated with events like *BEFORE & *AFTER which are associated with above 4 record related things.
Special programs are similar to trigger programs however they associated with opcodes which are used in program.
For Egg.
If you do a
Read/ReadP/ReadPE/Chain/Update/Write with file (Logical or Physical) then special programs invoked automatically. We can then replace this above opcodes with SQL statements in a new subroutine.
I know it is bit difficult to understand this, therefore I am here giving a quick example of how special programs are coded.
Step #1: Create View
We need to create view over a physical file like following in SQL.
For this from AS400 command line type: STRSQL
DROP VIEW PF001VW;
CREATE VIEW PF001VW AS
SELECT *FROM PF001
Note: Views cannot be created over logical files because views are itself logical files.
Step #2: Program: RPGLE001 (RPGLE)
Change the existing RPGLE program to use Special program as follows.
*************** Beginning of data ***********************************
0001.00 H*-------------------------------------------------------
0002.00 H* RPGLE001 : Main Program
0003.00 H* Author : Niranjan Diwan
0004.00 H* Date : 31-Dec-2009
0005.00 H* Description: This is Main Program, which is changed
0006.00 H* to use 'Special Program' concept.
0007.00 H*-------------------------------------------------------
0008.00 H Option (*Srcstmt: *NoDebugIO) Dftactgrp (*No)
0009.00 H Actgrp (*Caller) AlwNull (*UsrCtl)
0010.00 *
0011.00 F*PF001 IF E K Disk
0012.00 *
0013.00 * View declaration instead of PF001
0014.00 FPF001VW IF E Special PgmName('RPGLE002')
0015.00 F Plist(PlistPF001)
0016.00 F Rename(PF001VW:Rcd01)
0017.00 *
0018.00 FPF002 O E Disk
0019.00 *
0020.00 * Stand-alone work fields.
0021.00 D KeyEmpNo S Like(EmpNo)
0022.00 D KeyEName S Like(EName)
0023.00 D StatusPF001VW S 1A
0024.00 *
0025.00 * Main Line
0026.00 C Exsr ReadSR
0027.00 C Exsr UpdateSR
0028.00 C Exsr SetLLReadSR
0029.00 *
0030.00 C Eval *Inlr = *On
0031.00 C Return
0032.00 *-------------------------------------------------------
0033.00 * Subroutine: Read
0034.00 *-------------------------------------------------------
0035.00 C ReadSR BegSR
0036.00 C Eval SetFile = 'Y'
0037.00 C Eval Opcode = 'READ'
0038.00 *
0039.00 * This Read Rcd01 will automatically call Special Pgm.
0040.00 C Read Rcd01
0041.00 C* If %Found(Pf001)
0042.00 * Instead of %Found, check StatusPF001VW = '0'
0043.00 * for successful fetch.
0044.00 C Dow StatusPF001VW = '0'
0045.00 *
0046.00 C Empno Dsply
0047.00 C Read Rcd01
0048.00 C EndDo
0049.00 C ReadSRE EndSR
0050.00 *-------------------------------------------------------
0051.00 * Subroutine: Update
0052.00 *-------------------------------------------------------
0053.00 C UpdateSR BegSR
0054.00 C Eval SetFile = 'Y'
0055.00 C Eval Opcode = 'CHAIN'
0056.00 C Eval KeyCount = 1
0057.00 C Eval KeyEmpNo = 1
0058.00 C Eval KeyEName = 'Niranjan Diwan'
0059.00 *
0060.00 C Read Rcd01
0061.00 * Instead of Chain, Read & pass
0062.00 * those key values to Special Program as above.
0063.00 C* KeyPf001 Chain RPf001
0064.00 C* If %Found(Pf001)
0065.00 *
0066.00 * Check StatusPF001VW = '0' for successful fetch.
0067.00 C If StatusPF001VW = '0'
0068.00 *
0069.00 C Exsr WriteSR
0070.00 C EndIf
0071.00 C UpdateSRE EndSR
0072.00 *-------------------------------------------------------
0073.00 * Subroutine: SetLL Read
0074.00 *-------------------------------------------------------
0075.00 C SetLLReadSR BegSR
0076.00 C Eval SetFile = 'Y'
0077.00 C Eval Opcode = 'SLLREAD'
0078.00 C Eval KeyCount = 1
0079.00 C Eval KeyEmpNo = 1
0080.00 C Eval KeyEName = 'Niranjan Diwan'
0081.00 * Instead of SetLL, Read & pass
0082.00 * those key values to Special Program as above.
0083.00 C* KeyPf001 SetLL RPf001
0084.00 *
0085.00 C Read Rcd01
0086.00 C* If %Found(Pf001)
0087.00 *
0088.00 * Check StatusPF001VW = '0' for successful fetch.
0089.00 C If StatusPF001VW = '0'
0090.00 *
0091.00 C* Read RPf001
0092.00 C Ename Dsply
0093.00 C EndIf
0094.00 C SetLLReadSRE EndSR
0095.00 *-------------------------------------------------------
0096.00 * Subroutine: Write to file PF002
0097.00 *-------------------------------------------------------
0098.00 C WriteSR BegSR
0099.00 C Write RPF002
0100.00 C WriteSRE EndSR
0101.00 *-------------------------------------------------------
0102.00 * Subroutine: InzSR
0103.00 *-------------------------------------------------------
0104.00 C *InzSR BegSR
0105.00 * Do not need key values for Chain / SetLL B'coz
0106.00 * those are replaced with OPCODE - Read.
0107.00 *
0108.00 * Key list for logical file - PF001
0109.00 C* KeyPf001 Klist
0110.00 C* Kfld KeyEmpNo
0111.00 C* Kfld KeyEName
0112.00 *
0113.00 * Special Program parameter list
0114.00 C PlistPF001 Plist
0115.00 C Parm StatusPF001VW 1
0116.00 C Parm Opcode 10
0117.00 C Parm SetFile 1
0118.00 C Parm KeyCount 3 0
0119.00 C Parm KeyEmpNo
0120.00 C Parm KeyEName
0121.00 *
0122.00 C EndSR
****************** End of data *********************************
Step #3: Special Program (SQLRPGLE)
Note: While compiling special program use CLOSQLCSR parameter value = ‘*ENDACTGRP’ like following example.
CRTSQLRPGI OBJ (&OBJLIB/&OBJNAM) SRCFILE (&SRCLIB/&SRCFIL) SRCMBR (&SRCMBR) COMMIT (*NONE) OBJTYPE (*PGM) CLOSQLCSR (*ENDACTGRP)
Program: RPGLE002 (SQLRPGLE)
Create new member with source type as SQLRPGLE as Special program as follows.
*************** Beginning of data ***********************************
0001.00 H*-------------------------------------------------------
0002.00 H* RPGLE002 : Special Program
0003.00 H* Type : SQLRPGLE
0004.00 H* Author : Niranjan Diwan
0005.00 H* Description: Special Program that handles these
0006.00 H* opcodes: Chain / SetLL / SetGT / Read / ReadE / ReadPE
0007.00 H*-------------------------------------------------------
0008.00 H Option (*Srcstmt: *NoDebugIO) DftActgrp (*No)
0009.00 H Actgrp (*Caller) AlwNull (*UsrCtl)
0010.00 *
0011.00 D Buffer E Ds ExtName(PF001VW)
0012.00 *
0013.00 D FileName C 'PF001VW'
0014.00 D Field1 C 'EmpNo'
0015.00 D Field2 C 'EName'
0016.00 *
0017.00 D MainStm S 250A
0018.00 D FileSelect S 200
0019.00 D WhereClause S 200
0020.00 D OrderBy S 200
0021.00 D SaveOpcode S 10
0022.00 D Sign S 3
0023.00 *
0024.00 C Select
0025.00 C When Option = 'O'
0026.00 C Clear Buffer
0027.00 *
0028.00 C When Option = 'R'
0029.00 C Exsr ReadSR
0030.00 *
0031.00 C When Option = 'C'
0032.00 C/Exec SQL
0033.00 C+ Close Cursor_Pf001VW
0034.00 C/End-exec
0035.00 *
0036.00 C Eval *Inlr = *On
0037.00 *
0038.00 C Endsl
0039.00 *
0040.00 C Return
0041.00 ********************************************************
0042.00 * Perform a READ thru the file
0043.00 ********************************************************
0044.00 *
0045.00 C ReadSR BegSR
0046.00 *
0047.00 * If operation code changed then,
0048.00 * close cursor to set up new operation code
0049.00 C If Opcode <> SaveOpcode or SetFile = 'Y'
0050.00 C Eval SaveOpcode = OpCode
0051.00 C Eval SetFile = 'N'
0052.00 C Clear Sqlstt
0053.00 C/Exec SQL
0054.00 C+ Close Cursor_Pf001VW
0055.00 C/End-Exec
0056.00 *
0057.00 * Set Up File select.
0058.00 C Exsr SetFileSelect
0059.00 *
0060.00 * Set Up Where Clause to utilize
0061.00 * number of keys needed.
0062.00 C Exsr SetWhereClause
0063.00 *
0064.00 * Set Up Order By Clause.
0065.00 C Exsr SetOrderBy
0066.00 *
0067.00 * Set Up Dynamic SQL Main Statement.
0068.00 C Eval MainStm = %Trim(FileSelect) + ' ' +
0069.00 C %Trim(WhereClause) + ' '+
0070.00 C %Trim(OrderBy)
0071.00 *
0072.00 C/Exec SQL
0073.00 C+ Declare Cursor_Pf001VW cursor for MainSelect
0074.00 C/End-exec
0075.00 *
0076.00 C/Exec SQL
0077.00 C+ Prepare MainSelect from: Mainstm
0078.00 C/End-exec
0079.00 *
0080.00 C/Exec SQL
0081.00 C+ Open Cursor_Pf001VW
0082.00 C/End-exec
0083.00 *
0084.00 * End-If for Opcode <> SaveOpcode or SetFile = 'Y'
0085.00 C EndIf
0086.00 *
0087.00 C/Exec SQL
0088.00 C+ Fetch Cursor_Pf001VW into :Buffer
0089.00 C/End-exec
0090.00 *
0091.00 * Check Sqlstt & return file Status i.e. StatusPF001VW
0092.00 C Select
0093.00 C When Sqlstt < '02000'
0094.00 C Eval Status = '0'
0095.00 C When Sqlstt = '02000'
0096.00 C Eval Status = '1'
0097.00 C Clear Buffer
0098.00 C Other
0099.00 C Eval Status = '2'
0100.00 C Endsl
0101.00 *
0102.00 C Move Sqlstt Error
0103.00 C EndSR
0104.00 ********************************************************
0105.00 * Entry parameter list, & default parameters are -
0106.00 *
0107.00 * Option : File related action (O-Open/ C-Close/
0108.00 * R-Read/ W-Write/ D-Delete/ U-Update)
0109.00 * StatusCode : Result of operation ('0'-Normal/
0110.00 * '1'-EOF/ '2'-Error)
0111.00 * Error : Type of error occurred
0112.00 * Buffer : The record Buffer-Ds for the special file
0113.00 ********************************************************
0114.00 C *InzSR BegSR
0115.00 C *Entry Plist
0116.00 C Parm Option 1
0117.00 C Parm StatusCode 1
0118.00 C Parm Error 5 0
0119.00 C Parm Buffer
0120.00 C Parm Status 1
0121.00 C Parm OpCode 10
0122.00 C Parm SetFile 1
0123.00 C Parm KeyCount 3 0
0124.00 C Parm Key1 5 0
0125.00 C Parm Key2 20
0126.00 C EndSR
0127.00 ********************************************************
0128.00 * Subroutine: SetFileSelect
0129.00 * This subroutine selects the View-Name.
0130.00 ********************************************************
0131.00 C SetFileSelect Begsr
0132.00 C Eval FileSelect = 'Select * from ' +
0133.00 C FileName + ' '
0134.00 C EndSr
0135.00 ********************************************************
0136.00 * Subroutine: SetOrderby
0137.00 * This subroutine sets the order based on OpCode.
0138.00 ********************************************************
0139.00 C SetOrderby Begsr
0140.00 C Select
0141.00 C When OpCode = 'SETLLREAD'
0142.00 C Eval OrderBy = ' Order by ' +
0143.00 C Field1 + ', ' +
0144.00 C Field2 + ', '
0145.00 *
0146.00 C When OpCode = 'READPE' Or
0147.00 C OpCode = 'READP' Or
0148.00 C OpCode = 'SGTREADP'
0149.00 C Eval OrderBy = ' Order by ' +
0150.00 C Field1 + ' desc, ' +
0151.00 C Field2 + ' desc, '
0152.00 *
0153.00 C Other
0154.00 C Eval OrderBy = ' Order by ' +
0155.00 C Field2 + ', ' +
0156.00 C Field1
0157.00 C Endsl
0158.00 C Endsr
0159.00 ********************************************************
0160.00 * Subroutine: SetWhereClause
0161.00 * This subroutine prepares where clause based on OpCode.
0162.00 ********************************************************
0163.00 C SetWhereClauseBegSr
0164.00 C Select
0165.00 C When OpCode = 'READ'
0166.00 C Clear WhereClause
0167.00 *
0168.00 C Other
0169.00 C Select
0170.00 C When OpCode = 'SETLLREAD'
0171.00 C Eval Sign = ' >= '
0172.00 C When OpCode = 'SGTREADP'
0173.00 C Eval Sign = ' <= '
0174.00 *
0175.00 C Eval WhereClause = 'Where ' + Field1 + Sign +
0176.00 C '''' + %Trim(%Char(Key1)) + ''''
0177.00 *
0178.00 C If KeyCount = 0 or KeyCount > 1
0179.00 C Eval WhereClause = 'Where ' + Field2 +
0180.00 C Sign + Key2
0181.00 C EndIf
0182.00 *
0183.00 C Other
0184.00 C Eval Sign = ' = '
0185.00 C Eval WhereClause = 'Where ' +
0186.00 C Field1 + Sign + %Char(Key1)
0187.00 *
0188.00 C If KeyCount = 0 or KeyCount > 1
0189.00 C Eval WhereClause = 'Where ' +
0190.00 C Field1 + Sign + %Char(Key1) +
0191.00 C ' ' + 'And ' + Field2 + Sign + Key2
0192.00 C EndIf
0193.00 *
0194.00 C EndSl
0195.00 C EndSl
0196.00 C EndSr
****************** End of data **************************************
