Function SET231A
* =======================================================
* Process ........: SET_231
* Function .......: SET213A
* Created on .....: 05/12/2001 at 12:12:37
* Description ....: Access a file with null capable field
*
* Version.........: 1
*
* Full Description: The purpose of this function is to
* demonstrate that LANSA functions can work with
* OS/400 files that have null capable fields
*
* See also the definition of LANSA file S231PFA
* and the DDS for S231PFA (in source file
* SETCLSRC)
*
* If compiling this example, the LANSA data area
* DC@OSVEROP must contain *RPGIV and the default for the
* parameter ALWNULL for the OS/400 command CRTRPGMOD
* must be changed from *NO to *USRCTL
*
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* Minimum LANSA release: 9.0
*
* =======================================================
* Function control options
Function Options(*DIRECT)
Open Use_Option(OND)
*
* Group and field definitions
*
Define Field(#S_231REQ) Type(*CHAR) Length(075) Input_Atr(LC)
Override Field(#S_231AN1) Colhdg('Null' 'Capable' 'Text')
Override Field(#S_231AN2) Colhdg('Null' 'Capable' 'Number')
Override Field(#S_231AN3) Colhdg('Null' 'Capable' 'Binary')
*
*
Override Field(#S_231AN1) Length(010) Desc('Null capable text') Colhdg('Null' 'Capable' 'Text')
Override Field(#S_231AN2) Desc('Null capable number') Colhdg('Null' 'Capable' 'Number')
Override Field(#S_231AN3) Desc('Null capable binary number') Colhdg('Null' 'Capable' 'Binary')
*
*
Group_By Name(#S_GRPINS) Fields(#S_231AN1 #S_231AN2 #S_231AN3)
Group_By Name(#S_GRPCHG) Fields((#S_231AN1 *NC) #S_231AN2 #S_231AN3)
Group_By Name(#S_GRPDEL) Fields(#S_231AN1 #S_231AN2 #S_231AN3)
*
*
* Lists
*
Def_List Name(#S_LSTBRW) Fields(#S_231OPT (#S_231AN1 *NC) #S_231AN2 #S_231AN3 (#PRIFILRRN *HIDDEN))
*
*
* Mainline
*
*
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
Else
Message Msgtxt('Not available on PC')
Menu
Endif
*
Change Field(#S_231REQ) To('''1=Insert 2=Change 8=Delete''')
*
* Load test data
Execute Subroutine(ADD_DATA) With_Parms(A 0 0)
Execute Subroutine(ADD_DATA) With_Parms(B 11 11)
Execute Subroutine(ADD_DATA) With_Parms(C 12 12)
Execute Subroutine(ADD_DATA) With_Parms(D 13 13)
Execute Subroutine(ADD_DATA) With_Parms(E 14 14)
*
Begin_Loop
* The list entries are to be added in CHANGE mode
Set_Mode To(*CHANGE)
* Set all the fields used in the list to null
Change Field(#S_LSTBRW) To(*NULL)
* Add one entry to the list, using the current field
* values (null) and the current mode (*CHANGE)
Inz_List Named(#S_LSTBRW)
* Now add entries for all the records in the file
* in *CHANGE mode and with a user option of zero
Select Fields(#S_LSTBRW) From_File(S231PFA) Return_Rrn(#PRIFILRRN)
Add_Entry To_List(#S_LSTBRW)
Endselect
Set_Mode To(*DISPLAY)
*
Request Fields((#S_231REQ *L3 *P2 *NC *NOID)) Design(*DOWN) Identify(*LABEL) Down_Sep(001) Across_Sep(001) Browselist(#S_LSTBRW)
*
Selectlist Named(#S_LSTBRW)
Case Of_Field(#S_231OPT)
When Value_Is('= ''1''')
Execute Subroutine(SBR_INSERT)
When Value_Is('= ''2''')
Execute Subroutine(SBR_CHANGE)
When Value_Is('= ''8''')
Execute Subroutine(SBR_DELETE)
Endcase
Endselect
*
End_Loop
*
*
Subroutine Name(SBR_INSERT)
Request Fields(#S_GRPINS) Identify(*DESC) Menu_Key(*YES *RETURN)
Insert Fields(#S_GRPINS) To_File(S231PFA)
Endroutine
*
*
Subroutine Name(SBR_CHANGE)
Fetch Fields(#S_GRPCHG) From_File(S231PFA) With_Rrn(#PRIFILRRN)
Request Fields(#S_GRPCHG) Identify(*DESC) Menu_Key(*YES *RETURN)
Update Fields(#S_GRPCHG) In_File(S231PFA)
Endroutine
*
*
Subroutine Name(SBR_DELETE)
Fetch Fields(#S_GRPCHG) From_File(S231PFA) With_Rrn(#PRIFILRRN)
Display Fields(#S_GRPDEL) Identify(*DESC) Menu_Key(*YES *RETURN)
Delete From_File(S231PFA)
Endroutine
*
* Subroutine ADD_DATA
* Adds test data to the file if required
*
Subroutine Name(ADD_DATA) Parms(#S_231AN1 #S_231AN2 #S_231AN3)
Check_For In_File(S231PFA) With_Key(#S_231AN1)
If_Status Is_Not(*EQUALKEY)
Insert Fields(#S_GRPINS) To_File(S231PFA)
Endif
Endroutine
* =======================================================
* Process ........: SET_231
* Function .......: SET213A
* Created on .....: 05/12/2001 at 12:12:37
* Description ....: Access a file with null capable field
*
* Version.........: 1
*
* Full Description: The purpose of this function is to
* demonstrate that LANSA functions can work with
* OS/400 files that have null capable fields
*
* See also the definition of LANSA file S231PFA
* and the DDS for S231PFA (in source file
* SETCLSRC)
*
* If compiling this example, the LANSA data area
* DC@OSVEROP must contain *RPGIV and the default for the
* parameter ALWNULL for the OS/400 command CRTRPGMOD
* must be changed from *NO to *USRCTL
*
*
* Disclaimer: The following material is supplied as
* sample material only. No warranty concerning the
* material or its use in any way whatsoever is
* expressed or implied.
*
* Minimum LANSA release: 9.0
*
* =======================================================
* Function control options
Function Options(*DIRECT)
Open Use_Option(OND)
*
* Group and field definitions
*
Define Field(#S_231REQ) Type(*CHAR) Length(075) Input_Atr(LC)
Override Field(#S_231AN1) Colhdg('Null' 'Capable' 'Text')
Override Field(#S_231AN2) Colhdg('Null' 'Capable' 'Number')
Override Field(#S_231AN3) Colhdg('Null' 'Capable' 'Binary')
*
*
Override Field(#S_231AN1) Length(010) Desc('Null capable text') Colhdg('Null' 'Capable' 'Text')
Override Field(#S_231AN2) Desc('Null capable number') Colhdg('Null' 'Capable' 'Number')
Override Field(#S_231AN3) Desc('Null capable binary number') Colhdg('Null' 'Capable' 'Binary')
*
*
Group_By Name(#S_GRPINS) Fields(#S_231AN1 #S_231AN2 #S_231AN3)
Group_By Name(#S_GRPCHG) Fields((#S_231AN1 *NC) #S_231AN2 #S_231AN3)
Group_By Name(#S_GRPDEL) Fields(#S_231AN1 #S_231AN2 #S_231AN3)
*
*
* Lists
*
Def_List Name(#S_LSTBRW) Fields(#S_231OPT (#S_231AN1 *NC) #S_231AN2 #S_231AN3 (#PRIFILRRN *HIDDEN))
*
*
* Mainline
*
*
Def_Cond Name(*AS400) Cond('*CPUTYPE = AS400')
If Cond(*AS400)
Else
Message Msgtxt('Not available on PC')
Menu
Endif
*
Change Field(#S_231REQ) To('''1=Insert 2=Change 8=Delete''')
*
* Load test data
Execute Subroutine(ADD_DATA) With_Parms(A 0 0)
Execute Subroutine(ADD_DATA) With_Parms(B 11 11)
Execute Subroutine(ADD_DATA) With_Parms(C 12 12)
Execute Subroutine(ADD_DATA) With_Parms(D 13 13)
Execute Subroutine(ADD_DATA) With_Parms(E 14 14)
*
Begin_Loop
* The list entries are to be added in CHANGE mode
Set_Mode To(*CHANGE)
* Set all the fields used in the list to null
Change Field(#S_LSTBRW) To(*NULL)
* Add one entry to the list, using the current field
* values (null) and the current mode (*CHANGE)
Inz_List Named(#S_LSTBRW)
* Now add entries for all the records in the file
* in *CHANGE mode and with a user option of zero
Select Fields(#S_LSTBRW) From_File(S231PFA) Return_Rrn(#PRIFILRRN)
Add_Entry To_List(#S_LSTBRW)
Endselect
Set_Mode To(*DISPLAY)
*
Request Fields((#S_231REQ *L3 *P2 *NC *NOID)) Design(*DOWN) Identify(*LABEL) Down_Sep(001) Across_Sep(001) Browselist(#S_LSTBRW)
*
Selectlist Named(#S_LSTBRW)
Case Of_Field(#S_231OPT)
When Value_Is('= ''1''')
Execute Subroutine(SBR_INSERT)
When Value_Is('= ''2''')
Execute Subroutine(SBR_CHANGE)
When Value_Is('= ''8''')
Execute Subroutine(SBR_DELETE)
Endcase
Endselect
*
End_Loop
*
*
Subroutine Name(SBR_INSERT)
Request Fields(#S_GRPINS) Identify(*DESC) Menu_Key(*YES *RETURN)
Insert Fields(#S_GRPINS) To_File(S231PFA)
Endroutine
*
*
Subroutine Name(SBR_CHANGE)
Fetch Fields(#S_GRPCHG) From_File(S231PFA) With_Rrn(#PRIFILRRN)
Request Fields(#S_GRPCHG) Identify(*DESC) Menu_Key(*YES *RETURN)
Update Fields(#S_GRPCHG) In_File(S231PFA)
Endroutine
*
*
Subroutine Name(SBR_DELETE)
Fetch Fields(#S_GRPCHG) From_File(S231PFA) With_Rrn(#PRIFILRRN)
Display Fields(#S_GRPDEL) Identify(*DESC) Menu_Key(*YES *RETURN)
Delete From_File(S231PFA)
Endroutine
*
* Subroutine ADD_DATA
* Adds test data to the file if required
*
Subroutine Name(ADD_DATA) Parms(#S_231AN1 #S_231AN2 #S_231AN3)
Check_For In_File(S231PFA) With_Key(#S_231AN1)
If_Status Is_Not(*EQUALKEY)
Insert Fields(#S_GRPINS) To_File(S231PFA)
Endif
Endroutine