23. Sample 4GL Application : Employee Application : Descriptions Frame
 
Share this page                  
Descriptions Frame
The Descriptions frame lets users view the information held in the position_description field and import the information from or export it to an ASCII file on disk.
The form for the Descriptions frame is shown in the following figure:
The position_code, position_title, last_updated_at, and last_updated_by fields are read-only fields passed to the form from the Positions frame. The position_description field is a table field "tbl" containing the contents of the position_description field. The changes made to this field are passed back to the Positions Frame. However, this does not change the field in the database. From the Positions Frame, you can select Save to update the field in the database.
Menu Operations
The Descriptions frame provides the following menu operations:
Menu Item
Function
WriteToFile
Writes the current contents of the description field to the file specified in the FileName field.
ReadFromFile
Reads the contents of the specified file to the descriptions field on the form. This does not change the field in the database.
EditFile
Invokes the system editor to edit the specified file.
DeleteFile
Deletes the specified file.
Clear
Clears all data from the screen
Help
Displays information about this frame
End
Returns to the previous frame
The 4GL Source Code
The following is the 4GL source code for the Descriptions frame:

/*
** Frame: descriptions
** Form: samp_descriptions
** Source File: descriptions.osq
**
** Description
**
** Allows the user to import information from an ascii file on 
** disk to fill the tbl tablefield, to export information 
** from the tbl tablefield to an ascii file on disk, to delete 
** an ascii file on disk and to invoke the systems editor to 
** edit information stored in an ascii file on disk.
**
** Note, this frame will not save the data to the database. Once
** the user exits from this frame, the user will be returned to 
** the positions frame and the position_description field on this
** frame will be returned to the positions frame, from whence it
** can be saved to the database.
**
** On entry to this frame, the simple variable 
** position_description is unpacked into a tablefield of width 80 
** and maximum length of 23 rows.
**
** On exit from this frame, the tablefield tbl is packed into the
** variable position_description and returned to the calling 
** frame using byref.
**
** The file access functions will return a status of 0 for 
** success and -1 for failure. No error will be returned to ABF. 
**
** From the positions frame, call descriptions frame, passing 
** values from all columns in the current row of positions.iitf 
** table field to corresponding simple fields in descriptions 
** form.
**
** A status = 0 is returned if no change is made to the
** position_description field, a status = 1 is returned 
** otherwise.
*/
 
initialize (position_description = varchar(1900) not null ) =
declare

/* working variables */

  file_no = integer not null,   /* Holds handle for file 
                                ** manipulation */
  status = integer not null,    /* Holds 4gl statement status no */
  char1 = char(1) not null,     /* Holds answer to yes/no prompts */
  one_row = char(80) not null,  /* Holds each row while reading 
                                ** in from file */
  row_count = integer not null, /* Counter for number of rows 
                                ** read from ascii file */
  ncount = integer not null,    /* Holds the length of the position
                                ** description field */
  system_param = varchar(80),   /* Holds the parameter string 
                                ** passed to invoke the editor */
  i = integer not null,         /* General purpose integer */
  changed = integer not null,   /* Tracks if user make changes to
                                ** data */
  row_state = integer not null, /* Holds table field row state */
    
begin
  set_forms frs (activate(keys) = 1, activate(menuitem) = 1,
      validate(keys) = 1, validate(menuitem) = 1);
  
  changed = 0;

  /* load the tablefield from simple variable */

  ncount = length(ifnull(position_description,''));

  while ncount > 0 do

    loadtable tbl (description = left(position_description,80));

    ncount = length(position_description) - 80;

    position_description = right (position_description, ncount);

  endwhile;  
end;
 
'WriteToFile' (explanation = 
'Write Job Description information to file') =
Begin

  /* Check if the file exists, by opening a file in read mode. 
  If the file does not exist, a status of -1 will return.*/

  status = callproc openfile (filename = :filename, filetype =
      'text', filemode = 'read', handle = byref(file_no));
  
  /* status = 0, implies that the file was opened successfully,
  so we want to warn users that they might be overwriting valuable
  information, and give the user the option of continuing or aborting
  the transaction */
 
  if (status = 0 ) then

    /* We had to open the file in read mode to check that
    it exists. We must close the file now since we have 
    successfully opened it */

    status = callproc closefile (handle = file_no,
      disposition = 'keep');

    char1 = CALLPROC confirm (
     question = ifnull(filename,'')
       + ' already exists, and will be overwritten',
     no = 'Cancel the "WriteToFile" operation' +
      ' \ and prevent file from being overwritten.',
     yes = 'Continue and overwrite this file.'
     );
      IF (char1 = 'n') THEN
     RESUME;
   ENDIF;
  endif;
 
  status = callproc openfile (filename = :filename, filetype =
    'text', filemode = 'create', handle = byref(file_no));
 

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */
    message 'File ' + ifnull(filename,'') + 
     ' cannot be created' 
    with style=popup;
    resume;
  endif;
 
  /* write data from the tablefield tbl to file,*/

  unloadtable tbl (one_row = description)
  begin

    if (tbl._state = 4) then 
        endloop;
    endif;

    status = callproc writefile (handle = file_no,
        one_row);

    if status != 0 then 
        endloop; 
    endif;

  end;

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */

    message 'Unable to write to file ' + ifnull(filename,'')
    with style=popup;
    resume;
  endif;
 
  /* Close the file. This will flush the info to disk */
  
  status = callproc closefile (handle = file_no,
      disposition = 'keep');

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */
    message 'File ' + ifnull(filename,'') + ' cannot be closed'
    with style=popup;
    resume;
  endif;

end; /* End of WriteToFile */

'ReadFromFile' (explanation = 
'Read Job Description information from file') =
begin
 
  /* Open file in read mode */

  status = callproc OpenFile (filename = filename, filetype =
  'text', filemode = 'read', handle = byref(file_no));

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */
    message 'Unable to open file ' + ifnull(filename,'') 
    with style=popup;
    resume;
  endif;

  /* The tablefield tbl will hold 80x23 character rows. 
  The variable one_row is 80 char in length and is used 
  to hold one row of data, which is inserted into the tablefield
  tbl */
 
  /* initialize the variables */

  row_count = 0;

  /* By reading in data from a file, the user is changing data,
  use the variable changed to record that fact */

  changed = 1;

  /* Clear the tablefield */
  clear field tbl;

  while status = 0 and row_count < 23 do

    status = callproc ReadFile (  handle = file_no, 
    byref(one_row));
  
    if status != 0 then
      endloop;
    endif;

    loadtable tbl (description = one_row);

    row_count = row_count + 1;

  endwhile;
 
  /* close the file */

  status = callproc closefile (handle = file_no,
      disposition = 'keep');

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */
    message 'Unable to close file ' + ifnull(filename,'') 
    with style=popup;
    resume;
  endif;

end;
 
'EditFile' 
(Explanation = 'Invoke the system editor to edit file') =
begin

  /* Invoke the system editor */

  system_param = '$ING_EDIT ' + ifnull(filename,'');
  call system :system_param;

end;

'DeleteFile' 
(Explanation = 'Delete an ascii text file ') =
begin
  
  char1 = CALLPROC confirm (
 question = 'Are you sure you wish to delete ' + 
      ifnull(filename,''),
 no = 'Cancel the "DeleteFile" operation' ,
 yes = 'Continue and delete this file.'
 );

  IF (char1 = 'n') THEN
     RESUME;
 ENDIF;
 
  /* A file can only be deleted when it is being closed. In 
  order to close a file, it must be open, so first we open it */

  status = callproc OpenFile (filename = filename, filetype =
  'text', filemode = 'read', handle = byref(file_no));

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */
    message 'File ' + ifnull(filename,'') + 
       ' does not exists or is not accessible'
    with style = popup;
    resume;
  endif;
 
  /* close the file */

  status = callproc closefile (handle = file_no,
      disposition = 'delete');

  if status != 0 then
    /* ABF will not issue an error message to the user, so
    the code must issue the message */
    message 'Unable to delete file ' + ifnull(filename,'') 
    with style=popup;
    resume;
  endif;
end;

'Clear' (validate = 0, activate = 0,
explanation = 'Clear Description') =
begin
  /* User is changing the contents of the field */ 
  changed = 1;

  clear field tbl;
end;
 
'Help' (validate = 0, activate = 0,
explanation = 'Display help for this frame'),
key frskey1 (validate = 0, activate = 0) =
begin
  helpfile 'descriptions frame'
  '/m/corgi/supp60/employee/descriptions.hlp';
end;
 
'End' (validate = 0, activate = 0, 
explanation = 'Return to previous frame'),
key frskey3 (validate = 0, activate = 0) =
Begin
  /* Check if any change has been made to the position_description
  field. This could happen if the user tabs to the field (which
  will be ascertained using the _state variable ) or if the field 
  is filled using the ReadFromFile function, in which case 
  changed will be 1 */

    position_description = '';
    unloadtable tbl (row_state = _state)
    begin
        
        /* no need to include deleted rows */
      if (tbl._state = 4) then 
        endloop;
      endif; 

        /* Record the fact that data has changed */
      if (changed = 0 and row_state = 3) then
        changed = 1;
      endif;

      position_description = position_description +
              pad(tbl.description); 
    end;

    /* if the field has been changed, check that it has data,
    because this is a required field */
    if changed = 1 and position_description = '' then
      message 'description is a required field' with 
        style = popup;
      resume;
    endif;

      /* Return 1 if data has changed on this form,
      return 0 if no change has been made */
    return changed;

End;