Function SET231B
* =======================================================
* Process ........: SET_231
* Function .......: SET231B
* 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 S231PFB
* and the DDS for S231PFB (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)
*
* Group and field definitions
*
Define Field(#S_231REQ) Type(*CHAR) Length(075) Input_Atr(LC)
Override Field(#S_231BKY) Length(010) Desc('Key - NOT null capable') Colhdg('Key Field' 'NOT null' 'capable')
Override Field(#S_231BV1) Length(010) Desc('Null capable text') Colhdg('Null' 'Capable' 'Text')
Override Field(#S_231BV2) Desc('Null capable number') Colhdg('Null' 'Capable' 'Number')
Override Field(#S_231BV3) Desc('Null capable binary number') Colhdg('Null' 'Capable' 'Binary')
Override Field(#S_231BF1) Desc('Flag as null Y/N') Colhdg('Flag' 'text' 'as null')
Override Field(#S_231BF2) Desc('Flag as null Y/N') Colhdg('Flag' 'number' 'as null')
Override Field(#S_231BF3) Desc('Flag as null Y/N') Colhdg('Flag' 'Binary' 'as null')
*
Group_By Name(#S_GRPINS) Fields((#S_231BKY *L3 *P2) (#S_231BV1 *L5 *P2) (#S_231BF1 *L6 *P2) (#S_231BV2 *L8 *P2) (#S_231BF2 *L9 *P2) (#S_231BV3 *L11 *P2) (#S_231BF3 *L12 *P2))
Group_By Name(#S_GRPCHG) Fields((#S_231BKY *L3 *P2 *NC) (#S_231BV1 *L5 *P2) (#S_231BF1 *L6 *P2) (#S_231BV2 *L8 *P2) (#S_231BF2 *L9 *P2) (#S_231BV3 *L11 *P2) (#S_231BF3 *L12 *P2))
Group_By Name(#S_GRPDEL) Fields((#S_231BKY *L3 *P2) (#S_231BV1 *L5 *P2) (#S_231BF1 *L6 *P2) (#S_231BV2 *L8 *P2) (#S_231BF2 *L9 *P2) (#S_231BV3 *L11 *P2) (#S_231BF3 *L12 *P2))
*
*
* Lists
*
Def_List Name(#S_LSTBRW) Fields(#S_231OPT (#S_231BKY *NC) #S_231BV1 #S_231BF1 #S_231BV2 #S_231BF2 #S_231BV3 #S_231BF3)
*
*
* 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 A Y 0 Y 0 Y)
Execute Subroutine(ADD_DATA) With_Parms(B B N 11 N 11 N)
Execute Subroutine(ADD_DATA) With_Parms(C C N 12 N 12 Y)
Execute Subroutine(ADD_DATA) With_Parms(D D N 13 Y 13 N)
Execute Subroutine(ADD_DATA) With_Parms(E E N 14 Y 14 Y)
*
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(S231PFB)
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(S231PFB)
Endroutine
*
*
Subroutine Name(SBR_CHANGE)
Request Fields(#S_GRPCHG) Identify(*DESC) Menu_Key(*YES *RETURN)
Update Fields(#S_GRPCHG) In_File(S231PFB) With_Key(#S_231BKY)
Endroutine
*
*
Subroutine Name(SBR_DELETE)
Fetch Fields(#S_GRPCHG) From_File(S231PFB) With_Key(#S_231BKY)
Display Fields(#S_GRPDEL) Identify(*DESC) Menu_Key(*YES *RETURN)
Delete From_File(S231PFB) With_Key(#S_231BKY)
Endroutine
*
*
* Subroutine ADD_DATA
* Adds test data to the file if required
*
Subroutine Name(ADD_DATA) Parms(#S_231BKY #S_231BV1 #S_231BF1 #S_231BV2 #S_231BF2 #S_231BV3 #S_231BF3)
Check_For In_File(S231PFB) With_Key(#S_231BKY)
If_Status Is_Not(*EQUALKEY)
Insert Fields(#S_GRPINS) To_File(S231PFB)
Endif
Endroutine
* =======================================================
* Process ........: SET_231
* Function .......: SET231B
* 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 S231PFB
* and the DDS for S231PFB (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)
*
* Group and field definitions
*
Define Field(#S_231REQ) Type(*CHAR) Length(075) Input_Atr(LC)
Override Field(#S_231BKY) Length(010) Desc('Key - NOT null capable') Colhdg('Key Field' 'NOT null' 'capable')
Override Field(#S_231BV1) Length(010) Desc('Null capable text') Colhdg('Null' 'Capable' 'Text')
Override Field(#S_231BV2) Desc('Null capable number') Colhdg('Null' 'Capable' 'Number')
Override Field(#S_231BV3) Desc('Null capable binary number') Colhdg('Null' 'Capable' 'Binary')
Override Field(#S_231BF1) Desc('Flag as null Y/N') Colhdg('Flag' 'text' 'as null')
Override Field(#S_231BF2) Desc('Flag as null Y/N') Colhdg('Flag' 'number' 'as null')
Override Field(#S_231BF3) Desc('Flag as null Y/N') Colhdg('Flag' 'Binary' 'as null')
*
Group_By Name(#S_GRPINS) Fields((#S_231BKY *L3 *P2) (#S_231BV1 *L5 *P2) (#S_231BF1 *L6 *P2) (#S_231BV2 *L8 *P2) (#S_231BF2 *L9 *P2) (#S_231BV3 *L11 *P2) (#S_231BF3 *L12 *P2))
Group_By Name(#S_GRPCHG) Fields((#S_231BKY *L3 *P2 *NC) (#S_231BV1 *L5 *P2) (#S_231BF1 *L6 *P2) (#S_231BV2 *L8 *P2) (#S_231BF2 *L9 *P2) (#S_231BV3 *L11 *P2) (#S_231BF3 *L12 *P2))
Group_By Name(#S_GRPDEL) Fields((#S_231BKY *L3 *P2) (#S_231BV1 *L5 *P2) (#S_231BF1 *L6 *P2) (#S_231BV2 *L8 *P2) (#S_231BF2 *L9 *P2) (#S_231BV3 *L11 *P2) (#S_231BF3 *L12 *P2))
*
*
* Lists
*
Def_List Name(#S_LSTBRW) Fields(#S_231OPT (#S_231BKY *NC) #S_231BV1 #S_231BF1 #S_231BV2 #S_231BF2 #S_231BV3 #S_231BF3)
*
*
* 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 A Y 0 Y 0 Y)
Execute Subroutine(ADD_DATA) With_Parms(B B N 11 N 11 N)
Execute Subroutine(ADD_DATA) With_Parms(C C N 12 N 12 Y)
Execute Subroutine(ADD_DATA) With_Parms(D D N 13 Y 13 N)
Execute Subroutine(ADD_DATA) With_Parms(E E N 14 Y 14 Y)
*
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(S231PFB)
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(S231PFB)
Endroutine
*
*
Subroutine Name(SBR_CHANGE)
Request Fields(#S_GRPCHG) Identify(*DESC) Menu_Key(*YES *RETURN)
Update Fields(#S_GRPCHG) In_File(S231PFB) With_Key(#S_231BKY)
Endroutine
*
*
Subroutine Name(SBR_DELETE)
Fetch Fields(#S_GRPCHG) From_File(S231PFB) With_Key(#S_231BKY)
Display Fields(#S_GRPDEL) Identify(*DESC) Menu_Key(*YES *RETURN)
Delete From_File(S231PFB) With_Key(#S_231BKY)
Endroutine
*
*
* Subroutine ADD_DATA
* Adds test data to the file if required
*
Subroutine Name(ADD_DATA) Parms(#S_231BKY #S_231BV1 #S_231BF1 #S_231BV2 #S_231BF2 #S_231BV3 #S_231BF3)
Check_For In_File(S231PFB) With_Key(#S_231BKY)
If_Status Is_Not(*EQUALKEY)
Insert Fields(#S_GRPINS) To_File(S231PFB)
Endif
Endroutine