1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Program: SETUP.INT ! System : INTOUCH ! Author : Daniel James Swain ! Date : 30-NOV-1992 ! Purpose: Maintain structure information. ! Create/update structure files. ! Define fields ! Create data files ! Show definitions, structures !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 900 setup_version$ = 'SETUP V3.1' fieldname_row = 3 classification_row = 4 description_row = 5 data_type_row = 6 first_position_row = 7 length_row = 7 occurs_row = 7 semantics_row = 8 prompt_text_row = 11 report_heading_row = 12 print_mask_row = 13 screen_mask_row = 14 help_text_row = 15 access_rules_row = 16 validation_rules_row = 17 full_procedure_menu = 1 no_definition_file_menu = 2 augmented_definition_file_menu = 3 1000 initialize_routine open_classification_structure do initialize_structure ask_structure_name if _exit or _back then exit do if new_structure? then process_structure if _error then repeat do if _exit then exit do if _back then repeat do end if ask_and_perform_procedure close structure def close structure str if _back then repeat do end do set margin save_margin 9999 print at 24,1, erase:; stop 12000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N I T I A L I Z E R O U T I N E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! initialize variables ! ! Expected: ! ! Locals: ! ! Results: ! finished_entry_key$ ! key terminator that indicates user has finished with input ! database_engine_list$ ! list of data base engines ! key_duplicates$ key duplicate clauses ! key_field$ key field names ! rms_max_keys maximum RMS keys allowed ! new_def_size size of new(current) dictionary files ! valid_data_types$ list of valid data types ! valid_fieldname_characters$ ! list of valid field name characters ! foreign_database_engines$ ! database engines where we don't do the definitions ! save_margin margin setting when started ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine initialize_routine frame off new_def_size = 512 ask margin save_margin rms_max_keys = 10 dim key_field$(rms_max_keys), key_duplicates$(rms_max_keys) database_engine_list$ = 'RMS,RDB,DBMS,USER11,POISE,FASTFILE,S1032,' + & 'INGRES,DBASE3,ADABAS,ORACLE' foreign_database_engines$ = 'RDB,DBMS,INGRES,ADABAS,ORACLE' valid_data_types$ = 'CH,FL,IN,IU,DS,C3,ZN,EB,ZE,RO,RS,AS,' & + 'AP,QS,GF,PF,PZ,UN' valid_fieldname_characters$ = & 'characters "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$_"' valid_last_char_fieldname_characters$ = & 'characters "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$%_"' finished_entry_key$ = 'DO, PF4' help_structure$ = 'tti_run:setup_help.dat' help_initialize define_database_engine_menu define_procedure_menu define_datatype_menu end routine 12075 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D E F I N E D A T A B A S E E N G I N E M E N U !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! define the menu for database engine question ! ! Expected: ! database_engine_list$ ! list of database engines ! ! Locals: ! ! Results: ! database_engine_menu$ ! database engine menu ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine define_database_engine_menu database_engine_menu$ = '%at 7, 25, %title "Database Engine", ' + & '%size 15,' + database_engine_list$ + ', %bar, exit' end routine 12087 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D E F I N E P R O C E D U R E M E N U !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! define the menus for the procedure questions ! ! Expected: ! augmented_definition_file_menu ! menu if using an augmented definition ! no_definition_file_menu ! index for the menu if no definition file ! full_procedure_menu ! index for the full procedure menu ! ! Locals: ! ! Results: ! procedure_menu$ procedure menu array ! ! Routine is longer than 22 lines to build the 3 menu variations ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine define_procedure_menu dim procedure_menu$(3) procedure_menu$(full_procedure_menu) = & '%at 14, 25, %title "Setup Procedure", ' + & '"Define fields" = define, ' + & '"Show" = {' + & '%title "Show Option", ' + & '"Brief field display" = show_definition_brief, ' + & '"Full field display" = show_definition_full, ' + & '"Structure" = show_structure}, ' + & '"Modify structure" = {' + & '"General information" = general, ' + & '"Security information" = security},' + & '%bar,' + & '"Create data file" = create, ' + & 'exit' procedure_menu$(no_definition_file_menu) = & '%at 16, 25, %title "Setup Procedure", ' + & '"Show structure" = show_structure, ' + & '"Modify structure" = {' + & '"General information" = general, ' + & '"Security information" = security},' + & '%bar,exit' procedure_menu$(augmented_definition_file_menu) = & '%at 15, 25, %title "Setup Procedure", ' + & '"Define fields" = define, ' + & '"Show" = {' + & '%title "Show Option", ' + & '"Brief field display" = show_definition_brief, ' + & '"Full field display" = show_definition_full, ' + & '"Structure" = show_structure}, ' + & '"Modify structure" = {' + & '"General information" = general, ' + & '"Security information" = security},' + & '%bar,exit' end routine 12093 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D E F I N E D A T A T Y P E M E N U !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! define the input menu for the data type questions ! ! Expected: ! ! Locals: ! ! Results: ! data_type_menu$ data type menu ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine define_datatype_menu data_type_menu$ = '%at 5, 25, %title "Data Type", %size 10, ' + & '"CH..Character"=ch, ' + & '"FL..Floating point"=fl, ' + & '"IN..Integer (signed)"=in, ' + & '"IU..Integer (unsigned)"=iu, ' + & '"DS..Date stamp"=ds, ' + & '"C3..Packed decimal"=c3, ' +& '"ZN..Zoned numeric"=zn, ' + & '"EB..EBCDIC"=eb, ' + & '"ZE..Zoned EBCDIC"=ze, ' + & '"RO..Right overpunch"=ro, ' + & '"RS..Right sign separate"=rs, ' + & '"AC..ASCII counted string"=as, ' + & '"AP..Pointer to ASCII counted"=ap, ' + & '"QS..Quadword (signed)"=qs, ' + & '"GF..G-Float"=gf, ' + & '"PF..Packed-Float"=pf, ' + & '"PZ..Packed-zipcode"=pz, ' + & '"UN..Undefined"=un' + & ', %bar, exit' end routine 12100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! O P E N C L A S S I F I C A T I O N S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! open the file that contains definitions of known data fields ! ! Expected: ! tti_classification logical that has an override classification filename ! ! Locals: ! ! Results: ! classification_file_present? ! true if I found the classification file ! class structure is open ! classification_file$ ! name of the classification file ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine open_classification_structure classification_file_present? = false ask system, logical 'tti_classification' : value classification_file$ if classification_file$ = '' then & classification_file$ = 'tti_run:classification.def' when exception in open structure class : name 'tti_run:define', & datafile classification_file$ use end when if _error then exit routine end if classification_file_present? = true end routine 12200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N I T I A L I Z E S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! paint the screen needed for processing the structure file ! ! Expected: ! setup_version$ setup version ! ! Locals: ! z$ screen title ! ! Results: ! screen width is set to 80 ! the screen background is painted !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine initialize_structure clear set margin 80 z$ = space$(80) cset z$ = 'Set Up INTOUCH 4GL Data Structures' lset fill '' : z$ = setup_version$ print at 1, 1, bold, reverse : z$ print at 3, 1 : 'Structure name :' print at 4, 1 : 'Database engine:' print at 5, 1 : 'Dataset :' print at 6, 1 : 'Data dictionary:' z$ = 'EXIT = Exit ' + & '\ = Back HELP = Help' print at 24, 1, bold, reverse : z$; end routine 13000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K S T R U C T U R E N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the user for the structure filename ! ! Expected: ! ! Locals: ! reply$ user's response ! ! Results: ! raw_strucure_name$ structure name as entered ! action$ next routine to execute ! structure_name$ structure name with extension ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_structure_name do input_structure_name if _exit or _back then action$ = 'finished' exit routine end if if finished_entry? then cant_finish repeat do end if raw_structure_name$ = reply$ parse_filename$ = reply$ default_extension$ = 'STR' parse_filespec structure_name$ = parse_filename$ print at 3, 19, erase, bold : structure_name$ check_structure_file if _error then close structure str repeat do ! invalid format (not str file) end if end do end routine 13100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T S T R U C T U R E N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask the structure name question ! ! Expected: ! ! Locals: ! default_extension$ default extension for this file ! parse_filename$ filename entered ! validation$ validation rules ! length input length ! prompt$ prompt text ! ! Results: ! reply$ user's response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_structure_name prompt$ = 'Structure name' length = 64 validation$ = 'required' uc_response? = true help$ = 'structure_name' input_response end routine 14000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C H E C K S T R U C T U R E F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! see if the structure file exists ! if it does, then read it and set up the structure info ! otherwise set up some default structure info ! ! Expected: ! raw_structure_name$ ! structure name as entered ! filename$ filename without extension from parse_filename ! directory$ directory if any from parse_filename ! device$ device name if any from parse_filename ! ! Locals: ! ! Results: ! data_delete_access$ ! data file delete security level ! data_write_access$ ! data file write security level ! data_update_access$ ! data file update security level ! data_read_access$ ! data file read security level ! def_delete_access$ ! data dictionary delete security level ! def_write_access$ ! data dictionary write security level ! def_update_access$ ! data dictionary update security level ! def_read_access$ ! data dictionary read security level ! database_engine$ record system ! datafile_name$ data file name ! dictionary_name$ data dictionary name ! str_security$ structure security level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine check_structure_file do z$ = findfile$(structure_name$, 1) if z$ = '' then initialize_for_new_structure exit do end if open structure str : name 'tti_run:structure', & datafile structure_name$ new_structure? = false extract_structure_file if _error then exit routine close structure str print at 4, 19, bold, erase : database_engine$ print at 5, 19, bold, erase : datafile_name$ print at 6, 19, bold, erase : dictionary_name$ end do end routine 14100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N I T I A L I Z E F O R N E W S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set up defaults for a new structure file ! ! Expected: ! raw_structure_name$ ! structure name as entered ! filename$ filename without extension from parse_filename ! directory$ directory if any from parse_filename ! device$ device name if any from parse_filename ! ! Locals: ! ! Results: ! data_delete_access$ ! data file delete security level ! data_write_access$ ! data file write security level ! data_update_access$ ! data file update security level ! data_read_access$ ! data file read security level ! def_delete_access$ ! data dictionary delete security level ! def_write_access$ ! data dictionary write security level ! def_update_access$ ! data dictionary update security level ! def_read_access$ ! data dictionary read security level ! database_engine$ record system ! datafile_name$ data file name ! dictionary_name$ data dictionary name ! str_security$ structure security level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine initialize_for_new_structure message raw_structure_name$; ' is a new data structure' new_structure? = true database_engine$ = 'RMS' z1$ = device$ + directory$ + filename$ datafile_name$ = z1$ structure_edit_level$ = '031' structure_security$ = 'N' data_read_access$ = 'N' data_update_access$ = 'N' data_write_access$ = 'N' data_delete_access$ = 'N' def_read_access$ = 'N' def_update_access$ = 'N' def_write_access$ = 'N' def_delete_access$ = 'N' end routine 14200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! E X T R A C T S T R U C T U R E F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! extract the structure file and setup the variables with the data ! ! Expected: ! structure file has been opened ! ! Locals: ! ! Results: ! raw_dictionary_name$ ! data dictionaryname for default ! data_delete_access$ ! data file delete security level ! data_write_access$ ! data file write security level ! data_update_access$ ! data file update security level ! data_read_access$ ! data file read security level ! def_delete_access$ ! data dictionary delete security level ! def_write_access$ ! data dictionary write security level ! def_update_access$ ! data dictionary update security level ! def_read_access$ ! data dictionary read security level ! database_engine$ record system ! datafile_name$ data file name ! dictionary_name$ data dictionary name ! str_security$ structure security level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine extract_structure_file extract structure str z$ = str(rectype) select case z$ case 'STR' structure_edit_level$ = str(str_edit_level) structure_security$ = str(str_security) case 'DAT' datafile_name$ = str(file_name) database_engine$ = str(rms) data_read_access$ = str(read_security) data_update_access$ = str(update_security) data_write_access$ = str(write_security) data_delete_access$ = str(delete_security) case 'DEF' setup_dictionary_variables case else message error : 'Structure file has an invalid format' exit routine end select end extract end routine 14300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P D I C T I O N A R Y V A R I A B L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! define the variable setup for the data dictionary ! ! Expected: ! str record is current ! ! Locals: ! ! Results: ! def_delete_access$ ! data dictionary delete security level ! def_write_access$ ! data dictionary write security level ! def_update_access$ ! data dictionary update security level ! def_read_access$ ! data dictionary read security level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_dictionary_variables dictionary_name$ = str(file_name) if dictionary_name$ = '' then dictionary_name$ = 'none' raw_dictionary_name$ = dictionary_name$ if dictionary_name$[1:4] = 'AUG>' then & augmented_dictionary? = true def_read_access$ = str(read_security) def_update_access$ = str(update_security) def_write_access$ = str(write_security) def_delete_access$ = str(delete_security) end routine 15000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R O C E S S S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask all of the questions needed to set up a structure file. ! if the structure file already exists, update it. ! otherwise, create a new one ! ! Expected: ! ! Locals: ! ! Results: ! structure file is updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine process_structure action$ = 'ask_database_engine' do until action$ = 'finished' dispatch action$ loop if _exit or _back then close structure def ! might be open but the wrong name exit routine end if update_structure close structure def ! might be open but the wrong name end routine 16000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K D A T A B A S E E N G I N E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the user for the record system ! ! Expected: ! database_engine$ default record system ! ! Locals: ! validation$ validation rules ! length input length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! database_engine$ record system ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_database_engine do z = match(database_engine_list$, database_engine$) set window : typeahead repeat$(chr$(14), z - 1) help_topic$ = 'database_engine' line input menu database_engine_menu$ : reply$ if _exit or _back then action$ = 'finished' exit routine end if if _help then gosub help repeat do end if if match(finished_entry_key$, _terminator) > 0 then action$ = 'finished' exit routine end if end do database_engine$ = reply$ print at 4, 19, erase, bold : database_engine$ action$ = 'ask_datafile_name' if new_structure? then setup_default_dictionary_name end routine 16100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P D E F A U L T D I C T I O N A R Y N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! since this is a new structure, make up the default dictionary ! file name. ! ! Expected: ! database_engine$ database engine ! ! Locals: ! ! Results: ! raw_dictionary_name$ ! name of the dictionary file ! dictionary_name$ name of the dictionary file ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_default_dictionary_name select case database_engine$ case 'INGRES', 'RDB', 'DBMS', 'ADABAS', 'ORACLE' dictionary_name$ = 'none' case else : dictionary_name$ = device$ + directory$ + filename$ end select raw_dictionary_name$ = dictionary_name$ end routine 17000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K D A T A F I L E N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the user for the datafile filename ! ! Expected: ! datafile_name$ default datafile name with extension ! ! Locals: ! ! Results: ! raw_datafile_name$ ! datafile name as entered ! action$ next routine to execute ! datafile_name$ datafile name with extension ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_datafile_name do input_datafile_name if _exit then action$ = 'finished' exit routine end if if _back then print at 4, 19, erase : '' action$ = 'ask_database_engine' exit routine end if if finished_entry? then cant_finish repeat do end if end do parse_data_filename print at 5, 19, erase, bold : datafile_name$ action$ = 'ask_dictionary_name' end routine 17100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T D A T A F I L E N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask the datafile question ! ! Expected: ! ! Locals: ! default_extension$ default extension for this file ! parse_filename$ filename entered ! validation$ validation rules ! length input length ! prompt$ prompt text ! ! Results: ! reply$ response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_datafile_name setup_data_set_message setup_data_set_help prompt$ = 'Dataset' default$ = datafile_name$ length = 64 validation$ = 'required' uc_response? = true input_response end routine 17200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P D A T A S E T M E S S A G E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set up an engine specific message to be displayed ! ! Expected: ! database_engine$ name of the data base engine for this structure ! ! Locals: ! ! Results: ! response_message$ message to be displayed ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_data_set_message select case database_engine$ case 'RMS' response_message$ = 'Enter the name of the data file' case 'RDB' response_message$ = 'Format: table_name IN rdb_database' case 'DBMS' response_message$ = 'Format: recordname IN [subschema_name FOR] root_file' case 'ORACLE' response_message$ = 'Enter the table name to be set up' case 'ADABAS' response_message$ = 'Format: file_number IN database_number' case 'INGRES' response_message$ = 'Enter the name of the table' case else response_message$ = 'Enter the name of the data file' end select end routine 17300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P D A T A S E T H E L P !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set up a database engine specific help topic ! ! Expected: ! database_engine$ data base engine ! ! Locals: ! ! Results: ! help$ help topic name ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_data_set_help select case database_engine$ case 'RMS' help$ = 'rms_dataset' case 'RDB' help$ = 'rdb_dataset' case 'DBMS' help$ = 'dbms_dataset' case 'ORACLE' help$ = 'oracle_dataset' case 'ADABAS' help$ = 'adabas_dataset' case 'INGRES' help$ = 'ingres_dataset' case else help$ = 'dataset' end select end routine 17400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E D A T A F I L E N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! break each component of the filespec into its components ! apply a default extension if required. ! ! Expected: ! database_engine$ database engine for this structure ! reply$ user's response ! ! Locals: ! parse_filename$ filename with default extension if one was required ! default_extension$ default extension for this data file ! ! Results: ! datafile_name$ filename with default extension if one was required ! raw_datafile_name$ data filename as entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_data_filename raw_datafile_name$ = reply$ parse_filename$ = reply$ select case database_engine$ case 'INGRES', 'RDB', 'DBMS', 'ADABAS', 'ORACLE' default_extension$ = '' case else : default_extension$ = 'DAT' end select parse_filespec datafile_name$ = parse_filename$ end routine 18000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K D I C T I O N A R Y N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the user for the data dictionary filename ! ! Expected: ! dictionary_name$ default dictionary name with extension ! ! Locals: ! default_extension$ default extension for this file ! parse_filename$ filename entered ! validation$ validation rules ! length input length ! prompt$ prompt text ! ! Results: ! augmented_dictionary? ! true if this is an augmented dictionary ! raw_structure_name$ ! dictionary name as entered ! action$ next routine to execute ! dictionary_name$ dictionary name with extension ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_dictionary_name do input_dictionary_name if _exit then action$ = 'finished' exit routine end if if _back then print at 5, 19, erase : '' action$ = 'ask_datafile_name' exit routine end if if finished_entry? then cant_finish repeat do end if augmented_dictionary? = false validate_dictionary_name if _error then repeat do end do raw_dictionary_name$ = reply$ parse_filename$ = reply$ parse_filespec dictionary_name$ = parse_filename$ print at 6, 19, erase, bold : dictionary_name$ action$ = 'finished' end routine 18100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T D I C T I O N A R Y N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask for the dictionary name ! ! Expected: ! ! Locals: ! default_extension$ default extension for this file ! parse_filename$ filename entered ! validation$ validation rules ! length input length ! prompt$ prompt text ! ! Results: ! reply$ dictionary name entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_dictionary_name prompt$ = 'Data dictionary' default$ = dictionary_name$ length = 64 validation$ = 'required' uc_response? = true help$ = 'data_dictionary' input_response end routine 18200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E D I C T I O N A R Y N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! validate the dictionary name entered. ! also setup some variables based upon the database engine ! ! Expected: ! database_engine$ database engine for this structure ! ! Locals: ! ! Results: ! augmented_dictionary? ! true if this is an augmented dictionary ! default_extension$ default extension for the def file ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_dictionary_name select case database_engine$ case 'INGRES', 'RDB', 'DBMS', 'ADABAS', 'ORACLE' default_extension$ = '' if reply$[1:4] = 'AUG>' then default_extension$ = 'DEF' augmented_dictionary? = true end if case else if reply$[1:4] = 'AUG>' then message error : 'Definitions for this database engine cannot ';& 'be augmented' exit routine end if default_extension$ = 'DEF' end select end routine 19000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! U P D A T E S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! now we need to create/update the structure file ! reopen the structure file ! ! Expected: ! new_structure? true if this is a new structure file ! ! Locals: ! ! Results: ! structure file is set up ! structure file is closed !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine update_structure if new_structure? then create_new_structure_file if _error then exit routine add_structure_records else open structure str : name 'tti_run:structure', & datafile structure_name$, access outin update_structure_records end if close structure str end routine 19100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E N E W S T R U C T U R E F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! have VMS create a new structure file. ! open the newly created structure ! ! Expected: ! structure_name$ name of the structure file to create ! ! Locals: ! pass_successful flag indicating success/failure of create command ! ! Results: ! structure file is created and opened ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_new_structure_file message 'Creating structure: '; structure_name$; '...' pass 'create/fdl=tti_run:structure ' + structure_name$ ask system, pass : success pass_successful if not pass_successful then message error : 'Creation of '; structure_name$; ' failed' message error delay : 'Systext: '; systext$ exit routine end if message '' open structure str : name 'tti_run:structure', & datafile structure_name$, access outin end routine 19150 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A D D S T R U C T U R E R E C O R D S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! add the data records to the new structure file ! ! Expected: ! structure_security$ ! security level for this structure ! structure_edit_level$ ! structure edit level constant ! ! Locals: ! ! Results: ! the three structure records are added ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine add_structure_records add structure str str(rectype) = 'STR' str(str_edit_level) = structure_edit_level$ str(str_security) = structure_security$ end add add structure str str(whole_rec) = '' str(rectype) = 'DAT' update_dat_record end add add structure str str(whole_rec) = '' str(rectype) = 'DEF' update_def_record end add end routine 19200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! U P D A T E S T R U C T U R E R E C O R D S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! update the structure file records with the new information ! ! Expected: ! str record is current ! ! Locals: ! ! Results: ! str record is updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine update_structure_records extract structure str z$ = str(rectype) select case z$ case 'STR' case 'DEF' : update_def_record case 'DAT' : update_dat_record case else message error : 'Invalid structure file format' end select end extract end routine 19300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! U P D A T E D A T R E C O R D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! store the new data into the fields for the DAT structure record ! ! Expected: ! str record is current ! data_delete_access$ ! delete security level ! data_write_access$ ! write security level ! data_update_access$ ! update security level ! data_read_access$ ! read security level ! datafile_name$ name of the data file ! ! Locals: ! ! Results: ! str record is updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine update_dat_record str(file_name) = datafile_name$ str(rms) = database_engine$ str(read_security) = data_read_access$ str(update_security) = data_update_access$ str(write_security) = data_write_access$ str(delete_security) = data_delete_access$ end routine 19400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! U P D A T E D E F R E C O R D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! store the new data into the fields for the DEF structure record ! ! Expected: ! str record is current ! def_delete_access$ ! delete security level ! def_write_access$ ! write security level ! def_update_access$ ! update security level ! def_read_access$ ! read security level ! deffile_name$ name of the def file ! ! Locals: ! ! Results: ! str record is updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine update_def_record str(file_name) = dictionary_name$ str(read_security) = def_read_access$ str(update_security) = def_update_access$ str(write_security) = def_write_access$ str(delete_security) = def_delete_access$ end routine 19500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K A N D P E R F O R M P R O C E D U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the user which procedure to perform ! execute the procedure specified ! repeat until the user wants to quit ! ! Expected: ! finished_entry_key$ ! terminator for finished entry key ! database_engine$ database engine of the structure ! ! Locals: ! procedure$ procedure to execute ! structure_screen$ image of the structure window is updated ! if needed. ! Results: ! the procedures are executed !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_and_perform_procedure ask window : current structure_screen$ do ask_procedure if match(finished_entry_key$, _terminator) > 0 then set exit on if _exit or _back then exit do select case procedure$ case 'DEFINE' : do_definition case 'CREATE' : dispatch 'create_' + database_engine$ case 'SHOW_DEFINITION_BRIEF' : do_show_definition case 'SHOW_DEFINITION_FULL' : do_show_definition case 'GENERAL' process_structure ask window : current structure_screen$ case 'SHOW_STRUCTURE' : do_show_structure case 'SECURITY' : do_security end select set window : current structure_screen$ loop end routine 19900 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K P R O C E D U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the user for the procedure to perform ! ! Expected: ! augmented_definition_file_menu ! menu if using an augmented definition ! no_definition_file_menu ! index for the menu if no definition file ! full_procedure_menu ! index for the full procedure menu ! procedure_menu$ array of procedure question menus ! special$ special data dictionary prefix ! database_engine$ database engine for this structure ! foreign_database_engines$ ! list of foreign database engines ! procedure_menu$ menu to use for input ! ! Locals: ! menu_index index to menu array ! ! Results: ! procedure$ procedure selected ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_procedure do select_procedure_menu_index help_topic$ = 'procedure' line input menu procedure_menu$(menu_index) : reply$ if _exit or _back then exit routine if _help then gosub help repeat do end if end do procedure$ = reply$ end routine 19950 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E L E C T P R O C E D U R E M E N U I N D E X !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! based on the database engine and the dictionary filename ! choose the index for the proper procedure menu. ! ! Rules are: ! if database engine is in the list of foreign database ! then menu cannot have define/create/show definition commands ! ! if the database engine is foreign but the dictionary ! is augmented then they can have define/show definitions ! ! if the dictionary is in CDD/Plus then cannot ! define/create/show definitions ! ! if no dictionary then cannot define/create/show definitions ! ! Expected: ! dictionary_name$ name of the dictionary file ! augmented_definition_file_menu ! menu index for augmented dictionaries ! augmented_dictionary ! true if this is an augmented dictionary ! no_definition_file_menu ! index for the menu without define/create/show def ! full_procedure_menu ! index for the full procedure menu ! database_engine$ database engine for this structure ! foreign_database_engines$ ! list of foreign database engines ! ! Locals: ! ! Results: ! menu_index index selected ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine select_procedure_menu_index z = match(foreign_database_engines$, database_engine$) if z = 0 then menu_index = full_procedure_menu else if ucase$(dictionary_name$) = 'NONE' then menu_index = no_definition_file_menu else menu_index = augmented_definition_file_menu end if end if if augmented_dictionary? then & menu_index = augmented_definition_file_menu if dictionary_name$[1:4] = 'CDD>' then & menu_index = no_definition_file_menu ! can't define cdd definitions - can't create either since I don't ! know the definitions at this point if dictionary_name$ = 'none' then & menu_index = no_definition_file_menu ! can't define or create if there is not a data dictionary end routine 20000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D O D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create/modify/delete field definitions ! ! Expected: ! ! Locals: ! ok_to_create_dictionary ! flag indicating it is ok to create the dictionary file ! structure_screen$ saved screen image ! action$ next routine to execute ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_definition ok_to_create_dictionary? = true open_dictionary_file if _error then exit routine paint_definition_background calculate_last_position action$ = 'ask_fieldname' do until action$ = 'finished' dispatch action$ loop end routine 20200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A I N T D E F I N I T I O N B A C K G R O U N D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! paint the background for the definition screen ! ! Expected: ! validation_rules_row ! row for validation rules ! access_rules_row row for access rules ! help_text_row row for help text ! screen_mask_row row for screen mask ! print_mask_row row for print mask ! report_heading_row row for report heading ! prompt_text_row row for prompt text ! semantics_row row for semantics ! first_position_row row for first position ! data_type_row row for data type ! description_row row for description ! classification_row row for classification ! fieldname_row row for fieldname ! structure_name$ name of the structure file ! ! Locals: ! ! Results: ! definition_screen$ saved screen image ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine paint_definition_background clear z$ = space$(80) cset z$ = 'Definitions for ' + structure_name$ lset fill '' : z$ = setup_version$ print at 1, 1, bold, reverse : z$ print at fieldname_row, 1 : 'Fieldname :' print at classification_row, 1 : 'Classification :' print at description_row, 1 : 'Description :' print at data_type_row, 1 : 'Data type :' print at first_position_row, 1 : & 'First position : length: Occurs:'; print at semantics_row, 1 : 'Semantics :' print at prompt_text_row, 1 : 'Prompt text :' print at report_heading_row, 1 : 'Report heading :' print at print_mask_row, 1 : 'Print mask :' print at screen_mask_row, 1 : 'Screen mask :' print at help_text_row, 1 : 'Help text :' print at access_rules_row, 1 : 'Access rules :' print at validation_rules_row, 1 : 'Validation rules:' lset z$ = 'EXIT = Exit' rset fill '' : z$ = '\ = Back HELP = Help' print at 24, 1, bold, reverse : z$; ask window : current definition_screen$ end routine 21000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K F I E L D N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the field name ! ! Expected: ! fieldname_row row for fieldname ! ! Locals: ! delete_field? flag true if field is to be deleted ! uc_response? upper case flag ! validation$ validation rules ! length field length ! prompt$ prompt text ! response_message$ message for input ! ! Results: ! def_fieldname$ field name entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_fieldname do input_fieldname if _exit or _back then action$ = 'finished' exit routine end if if finished_entry? then cant_finish repeat do end if def_fieldname$ = reply$ delete_field? = false validate_fieldname if _error then repeat do check_fieldname if delete_field? then delete_the_field action$ = 'finished_with_field' exit routine end if end do print at fieldname_row, 20, bold, erase : def_fieldname$ action$ = 'ask_classification' end routine 21025 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T F I E L D N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask for the fieldname ! ! Expected: ! ! Locals: ! delete_field? flag true if field is to be deleted ! uc_response? upper case flag ! validation$ validation rules ! length field length ! prompt$ prompt text ! response_message$ message for input ! ! Results: ! reply$ field name entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_fieldname response_message$ = 'Enter -fieldname to delete a field' prompt$ = 'Field name' length = def_name_length + 1 validation$ = 'required' uc_response? = true help$ = 'fieldname' input_response reply$ = reply$[1:1] + change$(mid$(reply$, 2), ' -', '_') end routine 21050 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E F I E L D N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make sure that the field name meets the naming standards ! ! Expected: ! valid_last_char_fieldname_characters$ ! validation rule for the last character of a field name ! valid_fieldname_characters$ ! validation rule for the middle characters of a field name ! def_name_length length of the name field ! def_fieldname$ field name entered ! ! Locals: ! ! Results: ! delete_field? true if field is to be deleted ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_fieldname if def_fieldname$[1:1] = '-' then def_fieldname$[1:1] = '' delete_field? = true else if len(def_fieldname$) > def_name_length then message error : 'Field name can only be '; & def_name_length; ' characters' exit routine end if end if if not valid(def_fieldname$[1:1], 'letters') then message error : 'Field names must begin with a letter' exit routine end if z = len(def_fieldname$) if not valid(def_fieldname$[2:z-1], valid_fieldname_characters$) then message error : 'Invalid field name: '; def_fieldname$ exit routine end if if not valid(def_fieldname$[z:z], valid_last_char_fieldname_characters$) then message error : 'Invalid field name: '; def_fieldname$ exit routine end if end routine 21100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C H E C K F I E L D N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! see if the field exists. ! if not then tell the user it is a new field and exit ! otherwise set up the default answers ! ! Expected: ! def_fieldname$ name of the field entered ! def_name_field$ name of the name field ! ! Locals: ! ! Results: ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_access_rules$ access rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_field_length$ field length ! def_first_position$ ! starting position of field ! def_data_type$ data type ! def_description$ description ! def_new_field? flag indicating new/old field ! def_classification$ ! classification set to none ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine check_fieldname def_new_field? = false set structure def, field #def_name_field$ : key def_fieldname$ if _extracted = 0 then message def_fieldname$; ' is a new field' def_new_field? = true initialize_new_field exit routine end if setup_existing_field display_field end routine 21200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N I T I A L I Z E N E W F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! this is a new field so blank the variables ! ! Expected: ! ! Locals: ! ! Results: ! following variables are blanked out ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_access_rules$ access rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_field_length$ field length ! def_first_position$ ! starting position of field ! def_data_type$ data type ! def_description$ description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine initialize_new_field def_description$ = '' def_data_type$ = '' def_first_position$ = '' def_field_length$ = '' def_semantics$ = '' def_prompt_text$ = '' def_report_heading$ = '' def_print_mask$ = '' def_screen_mask$ = '' def_help_text$ = '' def_access_rules$ = '' def_occurrence$ = '1' def_validation_rules$ = '' def_classification$ = 'none' end routine 21700 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P E X I S T I N G F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! field already exists in the data dictionary ! set up the variables ! ! Expected: ! def_new_field? true if this is a new field being setup from the classification ! def record is current ! Locals: ! ! Results: ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_access_rules$ access rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_field_length$ field length ! def_first_position$ ! starting position of field ! def_data_type$ data type ! def_description$ description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_existing_field def_description$ = def(desc) def_data_type$ = def(dtype) def_first_position$ = str$(def(first)) ! remove leading zeros def_field_length$ = str$(def(len)) build_semantic_string def_prompt_text$ = def(prompt) def_report_heading$ = def(heading) def_print_mask$ = def(prmask) def_screen_mask$ = def(scmask) def_help_text$ = def(help) build_access_rules def_occurrence$ = '1' def_validation_rules$ = '' def_classification$ = '' if def_has_all_fields? then z = def(occurrence) if z = 0 then z = 1 def_occurrence$ = str$(z) def_validation_rules$ = def(validation) def_classification$ = def(classification) end if change_blank_fields_to_none end routine 21800 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D S E M A N T I C S T R I N G !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make a single string up from all of the attibute fields ! ! Expected: ! def structure is current ! ! Locals: ! z$ temp semantic string ! ! Results: ! def_semantics$ semantic string ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_semantic_string z$ = '' if def(num) = 'Y' then z$ = z$ + ', NUM' if def(scale) <> 0 then z$ = z$ + ':' + str$(def(scale)) if def(date) = 'Y' then z$ = z$ + ', DATE:' + def(df) !if def(eb) = 'Y' then z$ = z$ + ', EB' !if def(ls) = 'Y' then z$ = z$ + ', LS' if def(rj) = 'Y' then z$ = z$ + ', RJ' if def(zf) = 'Y' then z$ = z$ + ', ZF' if def(zs) = 'Y' then z$ = z$ + ', ZS' if def(uc) = 'Y' then z$ = z$ + ', UC' !if def(cp) = 'Y' then z$ = z$ + ', CP' if def_has_all_fields? then if def(fulltime) <> '' then z$ = z$ + ', FULLTIME' if augmented_dictionary? and trim$(def(dbfld)) <> '' then & z$ = z$ + ', DBFLD:' + trim$(def(dbfld)) if def(application) <> '' then z$ = z$ + ', application:' + & def(application) end if if z$ = '' then z$ = ', none' z$ = mid$(z$, 3%) def_semantics$ = z$ end routine 21900 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D A C C E S S R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! build up the access rules from the individual pieces ! ! Expected: ! def record is current ! ! Locals: ! ! Results: ! def_access_rules$ access rules ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_access_rules if def(read) = 'N' and def(write) = 'N' then def_access_rules$ = 'NORMAL' else def_access_rules$ = 'READ:' + def(read) + ', WRITE: ' + def(write) end if end routine 21910 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D I S P L A Y E X I S T I N G F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! definition_screen$ saved screen image ! fieldname_row row to print on ! description_row row to print on ! data_type_row row to print on ! first_position_row row to print on ! length_row row to print on ! occurs_row row to print on ! semantics_row row to print on ! prompt_text_row row to print on ! report_heading_row row to print on ! print_mask_row row to print on ! screen_mask_row row to print on ! help_text_row row for help text ! access_rules_row row for access rules ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_access_rules$ access rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_field_length$ field length ! def_first_position$ ! starting position of field ! def_data_type$ data type ! def_description$ description ! ! Locals: ! ! Results: ! screen is painted with background and new data ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine display_field set window : current definition_screen$ print at fieldname_row, 20, bold : def_fieldname$ print at classification_row, 20, bold : def_classification$ print at description_row, 20, bold : def_description$ print at data_type_row, 20, bold : def_data_type$ print at first_position_row, 20, bold : def_first_position$ print at length_row, 37, bold : def_field_length$ print at occurs_row, 54, bold : def_occurrence$ display_semantics print at prompt_text_row, 20, bold : def_prompt_text$ print at report_heading_row, 20, bold : def_report_heading$ print at print_mask_row, 20, bold : def_print_mask$ print at screen_mask_row, 20, bold : def_screen_mask$ print at help_text_row, 20, bold : def_help_text$[1:61] print at access_rules_row, 20, bold : def_access_rules$ display_validation_rules end routine 21950 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D E L E T E T H E F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! the user wants to delete the field. ask if he is sure. ! if he is then delete the field. ! ! Expected: ! def_fieldname$ name of the field ! def_new_field? true if the field name didn't exist ! def record is current ! ! Locals: ! ! Results: ! field is deleted if the user wants that ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine delete_the_field if def_new_field? then message error : "Field "; def_fieldname$; " not found" exit routine end if prompt$ = 'Sure delete this field (Y/N)' help$ = 'sure_delete' input_response_yn if _exit or _back or reply$ = 'N' then message delay : "Field "; def_fieldname$; ' saved' set error on exit routine end if delete structure def message delay : 'Field '; def_fieldname$; ' deleted' end routine 22000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K C L A S S I F I C A T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! this is a new field. ask the user for the classification. ! if one is entered, then validate it and then set up the ! contents as the default answers ! if one isn't entered then set up a new field with mostly ! blank defaults ! ! Expected: ! classification_row row for classification ! ! Locals: ! ! Results: ! action$ next routine to execute ! def_classification$ ! classification entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_classification setup_classification_default do input_classification if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'finished_with_field' exit routine end if if finished_entry? then cant_finish repeat do end if validate_classification if _error then repeat do end do def_classification$ = reply$ print at classification_row, 20, erase, bold : def_classification$ use_classification action$ = 'ask_description' end routine 22050 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P C L A S S I F I C A T I O N D E F A U L T !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! if an new field is being defined and there is a classification ! file, check to see if the field name is one of the classifications ! if so, use the fieldname as the default classification. ! ! Expected: ! def_fieldname$ field name entered ! classification_file_present? ! true if there is a classification file ! def_new_field? true if this is a new field ! ! Locals: ! ! Results: ! def_classification$ ! classification set to field name if appropriate ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_classification_default if not def_new_field? then exit routine ! just leave as is if not classification_file_present? then exit routine set structure class, field name : key def_fieldname$ if _extracted = 0 then exit routine def_classification$ = def_fieldname$ end routine 22100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T C L A S S I F I C A T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually input the classification for this field ! ! Expected: ! def_classification$ ! default classification ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ default answer ! length input length ! prompt$ prompt text ! ! Results: ! reply$ user's response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_classification prompt$ = 'Classification' length = 32 default$ = def_classification$ validation$ = '' uc_response? = true help$ = 'classification' input_response reply$ = reply$[1:1] + change$(mid$(reply$, 2), ' -', '_') end routine 22200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E C L A S S I F I C A T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make sure the classification entered is valid. It must ! exist in the classifications dictionary ! Expected: ! classification_file_present? ! flag is true if we have a classification file ! reply$ classification entered ! ! Locals: ! ! Results: ! _error true if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_classification if reply$ = '' then reply$ = 'none' if reply$ = 'none' then exit routine if not classification_file_present? then if def_new_field? then message error : 'No classification file set up' exit routine end if if def_classification$ <> reply$ then message error : "Can't change classification - "; & 'No classification file set up' exit routine end if ! can't change classification if no classification file exit routine end if set structure class, field name : key reply$ if _extracted = 0 then message error : reply$; ' Is not a valid classification' exit routine end if end routine 22250 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! U S E C L A S S I F I C A T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! now that I have the classification, do some thing with it ! ! Expected: ! def record current if field is being changed ! def_classification$ ! classification entered ! def_new_field? true if a new field ! ! Locals: ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine use_classification if def_new_field? then if def_classification$ = 'none' then setup_new_field else setup_field_from_classification end if else if def_classification$ = 'none' then exit routine if def_has_all_fields? then & if def_classification$ = def(classification) then exit routine setup_field_from_classification end if display_field end routine 22300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P N E W F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set up the defaults for a new field ! ! Expected: ! augmented_dictionary? ! true if an augmented data dictionary ! def_fieldname$ fieldname entered ! ! Locals: ! ! Results: ! def_classification$ ! no classification entered ! def_occurrence$ number of occurrences ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_access_rules$ access rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_field_length$ field length ! def_first_position$ ! starting position of field ! def_data_type$ data type ! def_description$ description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_new_field message def_fieldname$; ' is a new field' if pattern(def_fieldname$, '{AEIOU}') = 0 then z1$ = def_fieldname$ ! no case change if no vowels else z$ = lcase$(change$(def_fieldname$, '_$%', ' ')) z1$ = ucase$(z$[1:1]) + mid$(z$, 2) ! uppercase 1st char only end if def_description$ = z1$ def_classification$ = 'none' def_data_type$ = 'CH' if augmented_dictionary? then def_first_position$ = 'none' def_field_length$ = 'none' else def_first_position$ = str$(def_next_pos) def_field_length$ = '' end if def_semantics$ = 'UC' def_prompt_text$ = def_description$ setup_default_heading def_print_mask$ = 'none' def_screen_mask$ = 'none' def_help_text$ = 'none' def_access_rules$ = 'NORMAL' def_occurrence$ = '1' def_validation_rules$ = 'none' end routine 22400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P D E F A U L T H E A D I N G !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make a default heading from the field name ! ! Expected: ! def_fieldname$ fieldname entered ! ! Locals: ! ! Results: ! def_report_heading$ ! report heading ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_default_heading if pattern(def_fieldname$, '{AEIOU}') = 0 then def_report_heading$ = def_fieldname$ exit routine end if ! no case change if no vowels z$ = lcase$(change$(def_fieldname$, '_', ' ')) z = elements(z$, ' ') z1$ = '' for z1 = 1 to z z2$ = element$(z$, z1, ' ') z1$ = z1$ + ucase$(z2$[1:1]) + mid$(z2$, 2) + ' ' next z1 def_report_heading$ = trim$(z1$) end routine 22500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P F I E L D F R O M C L A S S I F I C A T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! the classification record has the definition for the field. ! use the class file data to set up the defaults for this field. ! ! This routine is used for both new fields and existing fields if ! the classification has changed ! ! Expected: ! def_new_field? true if this is a new field being setup from the classification ! class record is current ! ! Locals: ! ! Results: ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_access_rules$ access rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_field_length$ field length ! def_first_position$ ! starting position of field ! def_data_type$ data type ! def_description$ description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_field_from_classification if def_description$ = '' then def_description$ = class(desc) def_data_type$ = class(dtype) if def_new_field? then def_first_position$ = str$(def_next_pos) def_field_length$ = str$(class(len)) build_class_semantic_string if def_prompt_text$ = '' then def_prompt_text$ = class(prompt) if def_report_heading$ = '' then def_report_heading$ = class(heading) def_print_mask$ = class(prmask) def_screen_mask$ = class(scmask) if def_help_text$ = '' then def_help_text$ = class(help) build_class_access_rules if def_has_all_fields? then z = class(occurrence) if z = 0 then z = 1 def_occurrence$ = str$(z) def_validation_rules$ = class(validation) end if apply_new_field_defaults_to_blank_class_data change_blank_fields_to_none end routine 22700 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D S E M A N T I C S T R I N G !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make a single string up from all of the attibute fields ! ! Expected: ! def structure is current ! ! Locals: ! z$ temp semantic string ! ! Results: ! def_semantics$ semantic string ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_class_semantic_string z$ = '' if class(num) = 'Y' then z$ = z$ + ', NUM' if class(scale) <> 0 then z$ = z$ + ':' + class(scale) if class(date) = 'Y' then z$ = z$ + ', DATE:' + class(df) if class(eb) = 'Y' then z$ = z$ + ', EB' if class(ls) = 'Y' then z$ = z$ + ', LS' if class(rj) = 'Y' then z$ = z$ + ', RJ' if class(zf) = 'Y' then z$ = z$ + ', ZF' if class(zs) = 'Y' then z$ = z$ + ', ZS' if class(uc) = 'Y' then z$ = z$ + ', UC' if class(cp) = 'Y' then z$ = z$ + ', CP' if def_has_all_fields? then if class(fulltime) <> '' then z$ = z$ + ', FULLTIME' if augmented_dictionary? and class(dbfld) <> '' then & z$ = z$ + ', DBFLD:' + class(dbfld) if class(application) <> '' then z$ = z$ + ', Application: ' + & class(application) end if z$ = mid$(z$, 3%) def_semantics$ = z$ end routine 22800 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D A C C E S S R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! build up the access rules from the individual pieces ! ! Expected: ! def record is current ! ! Locals: ! ! Results: ! def_access_rules$ access rules ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_class_access_rules if class(read) = 'N' and class(write) = 'N' then def_access_rules$ = 'NORMAL' else def_access_rules$ = 'READ:' + class(read) + & ', WRITE: ' + class(write) end if end routine 22900 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A P P L Y N E W F I E L D D E F A U L T S T O B L A N K C L A S S D A T A !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! if any of the classification data is blank, then apply the ! new field rules to them (such as description, prompt text etc) ! ! Expected: ! augmented_dictionary? ! true if an augmented data dictionary ! def_fieldname$ fieldname entered ! ! Locals: ! ! Results: ! def_access_rules$ access rules ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_semantics$ field semantics ! def_data_type$ data type ! def_description$ description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine apply_new_field_defaults_to_blank_class_data if pattern(def_fieldname$, '{AEIOU}') = 0 then z1$ = def_fieldname$ ! no case change if no vowels else z$ = lcase$(change$(def_fieldname$, '_', ' ')) z1$ = ucase$(z$[1:1]) + mid$(z$, 2) ! uppercase 1st char only end if if def_description$ = '' then def_description$ = z1$ if def_data_type$ = '' then def_data_type$ = 'CH' if def_prompt_text$ = '' then def_prompt_text$ = def_description$ if def_report_heading$ <> '' then exit routine if pattern(def_fieldname$, '{AEIOU}') = 0 then def_report_heading$ = def_fieldname$ exit routine end if z$ = lcase$(change$(def_fieldname$, '_', ' ')) z = elements(z$, ' ') z1$ = '' for z1 = 1 to z z2$ = element$(z$, z1, ' ') z1$ = z1$ + ucase$(z2$[1:1]) + mid$(z2$, 2) + ' ' next z1 def_report_heading$ = trim$(z1$) end routine 22950 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C H A N G E B L A N K F I E L D S T O N O N E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! change blank fields to the word none (or normal) ! ! Expected: ! def_classification$ ! classification ! def_access_rules$ access rules ! def_semantics$ semantics string ! def_validation_rules$ ! validation rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! ! Locals: ! ! Results: ! def_classification$ ! set to none if blank ! def_access_rules$ access rules ! def_semantics$ semantics string ! def_validation_rules$ ! validation rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine change_blank_fields_to_none if def_prompt_text$ = '' then def_prompt_text$ = 'none' if def_report_heading$ = '' then def_report_heading$ = 'none' if def_print_mask$ = '' then def_print_mask$ = 'none' if def_screen_mask$ = '' then def_screen_mask$ = 'none' if def_help_text$ = '' then def_help_text$ = 'none' if def_validation_rules$ = '' then def_validation_rules$ = 'none' if def_semantics$ = '' then def_semantics$ = 'none' if def_access_rules$ = '' then def_access_rules$ = 'NORMAL' if def_classification$ = '' then def_classification$ = 'none' end routine 23000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K D E S C R I P T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the description of the field ! ! Expected: ! prompt_text_row row for prompt text ! description_row row for description ! def_description$ default description ! def_desc_length length of the description field ! ! Locals: ! reply$ user's response ! finished_entry true if finished entry key pressed ! ! Results: ! action$ next routine to execute ! def_description$ new description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_description input_description if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_classification' exit routine end if if finished_entry? then process_field exit routine end if def_description$ = reply$ if def_description$ = '' then def_description$ = 'none' print at description_row, 20, bold, erase : def_description$ if def_new_field? and reply$ <> 'none' then def_prompt_text$ = def_description$ print at prompt_text_row, 20, bold, erase : def_prompt_text$ end if action$ = 'ask_data_type' end routine 23100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T D E S C R I P T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask the description question ! ! Expected: ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! reply$ user's response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_description prompt$ = 'Description' length = def_desc_length default$ = def_description$ validation$ = '' uc_response? = false help$ = 'description' input_response end routine 23500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K D A T A T Y P E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the data type of the field ! ! Expected: ! data_type_row row for data type ! valid_data_types$ menu of data types ! def_data_type$ default description ! ! Locals: ! ! Results: ! action$ next routine to execute ! def_data_type$ new data type ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_data_type do z = match(valid_data_types$, def_data_type$) set window : typeahead repeat$(chr$(14), z - 1) help_topic$ = 'data_type' line input menu data_type_menu$ : reply$ if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_description' exit routine end if if _help then gosub help repeat do end if if match(finished_entry_key$, _terminator) > 0 then process_field exit routine end if end do def_data_type$ = reply$ print at data_type_row, 20, bold, erase : def_data_type$ action$ = 'ask_first_position' end routine 24000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K F I R S T P O S I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the starting position of the field ! ! Expected: ! first_position_row row for first position ! def_first_position$ ! default answer ! def_first_length ! length of the field ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_first_position$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_first_position do input_first_position if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_data_type' exit routine end if if finished_entry? then process_field exit routine end if validate_first_position if _error then repeat do end do def_first_position$ = reply$ clear area first_position_row, 20, first_position_row, 20 + def_first_length - 1 print at first_position_row, 20, bold : def_first_position$ action$ = 'ask_field_length' end routine 24100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T F I R S T P O S I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask for the first position ! ! Expected: ! def_first_position$ ! default value ! def_first_length length of response ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! _reply$ first position entered !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_first_position prompt$ = 'First position' length = def_first_length default$ = def_first_position$ if augmented_dictionary? then validation$ = 'required' else validation$ = 'required; integer' end if uc_response? = true help$ = 'first_position' input_response end routine 24200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E F I R S T P O S I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make sure that the response is valid ! if not augmented then already checked for integer ! augmented allows none to be entered ! ! Expected: ! reply$ first position entered ! ! Locals: ! ! Results: ! _error true if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_first_position if reply$ = 'none' then exit routine if augmented_dictionary? and not valid(reply$, 'integer') then message error : "First position must be a positive number: "; & reply$ end if if val(reply$) < 1 then message error : 'First position must be greater than 0: '; & reply$ end if end routine 25000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K F I E L D L E N G T H !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the length of the field ! ! Expected: ! def_field_length$ default answer ! def_length_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_field_length$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_field_length do input_field_length if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_first_position' exit routine end if if finished_entry? then process_field exit routine end if validate_field_length if _error then repeat do end do def_field_length$ = reply$ display_field_length action$ = 'ask_occurrence' end routine 25100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T F I E L D L E N G T H !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask for the first position ! ! Expected: ! def_data_type$ data type ! def_first_position$ ! default value ! def_first_length length of response ! ! Locals: ! response_message$ message to display during input ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! _reply$ first position entered !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_field_length select case def_data_type$ case 'QS' response_message$ = 'Quadwords are 8 bytes long' case 'FL' response_message$ = 'Supported floating-point lengths are: 4, 8' case 'GF' response_message$ = 'G-floats are 8 bytes long' case 'IN', 'IU' response_message$ = & 'Supported integer lengths are: 1, 2, 3, or 4' case else response_message$ = & 'Enter "P end_position" to use an ending position' end select prompt$ = 'Field length' length = def_length_length default$ = def_field_length$ validation$ = 'required' uc_response? = true help$ = 'field_length' input_response end routine 25200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E F I E L D L E N G T H !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make sure that the response is valid ! ! Expected: ! reply$ first position entered ! ! Locals: ! field_length field length as a number ! ! Results: ! _error true if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_field_length if reply$ = 'none' and augmented_dictionary? = true then exit routine validate_length_numeric if _error then exit routine field_length = val(reply$) select case def_data_type$ case 'QS' if field_length <> 8 then & message error : 'Quadwords must be 8 bytes long' case 'FL' if field_length <> 4 and field_length <> 8 then & message error : & 'floating-point numbers must be either 4 or 8 bytes long' case 'GF' if field_length <> 8 then & message error : 'G-floats must be 8 bytes long' case 'IN', 'IU' if field_length < 1 or field_length > 4 then & message error : & 'integers must be either 1, 2, 3 or 4 bytes long' case else end select end routine 25300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E L E N G T H N U M E R I C !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make sure the field length response is numeric. Also change ! ending position to length if necessary ! ! Expected: ! def_first_position$ ! first position of the field ! reply$ length response ! ! Locals: ! z$ then ending position if the 1st char was "P" ! ! Results: ! _error if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_length_numeric if reply$[1:1] = 'P' then z$ = mid$(reply$, 2) if not valid(z$, 'integer') then message error : "Ending position must be a positive integer"; & reply$ exit routine end if if val(z$) < real(0) then message error : 'Ending position must be a positive number: '; & reply$ exit routine end if reply$ = str$(val(z$) - val(def_first_position$) + 1) exit routine end if if not valid(reply$, 'integer') then message error : "Field length must be a positive number: "; & reply$ exit routine end if if val(reply$) < real(0) then message error : 'Field length must be a positive number: '; & reply$ end if end routine 25400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D I S P L A Y F I E L D L E N G T H !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! display the field length ! ! Expected: ! length_row row for field length ! def_field_length$ field length entered ! ! Locals: ! ! Results: ! value is displayed ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine display_field_length clear area length_row, 37, length_row, 37 + def_length_length - 1 print at length_row, 37, bold : def_field_length$ end routine 26000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K O C C U R R E N C E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the number of occurrences for this field ! ! Expected: ! occurs_row row for number of occurrences ! def_occurrence$ default answer ! def_occurrence_length input length ! ! Locals: ! reply$ number of occurrences entered ! ! Results: ! action$ next routine to execute ! def_occurrence$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_occurrence do input_occurrences if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_field_length' exit routine end if if finished_entry? then process_field exit routine end if if val(reply$) < 1 then message error : 'Occurrences must be greater than 1' repeat do end if if val(reply$) > 1 and not def_has_all_fields? then message error : 'Occurrences greater than 1 not supported '; & 'for this dictionary' repeat do end if end do def_occurrence$ = reply$ print at occurs_row, 54, bold, erase : def_occurrence$ action$ = 'ask_semantics' end routine 26100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T O C C U R R E N C E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actuall ask the occurrences question ! ! Expected: ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! reply$ users response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_occurrences prompt$ = 'Number of occurrences' length = def_occurrence_length default$ = def_occurrence$ validation$ = 'required;integer' uc_response? = false help$ = 'occurrence' input_response end routine 27000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K S E M A N T I C S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the semantics ! ! Expected: ! def_semantics$ default answer ! def_semantic_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_semantics$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_semantics do ask_semantics_question if _exit then action$ = 'finished' exit routine end if if _back then display_semantics action$ = 'ask_occurrence' exit routine end if if _help then gosub help repeat do end if if finished_entry? then process_field exit routine end if validate_semantics if _error then repeat do end do def_semantics$ = reply$ display_semantics build_default_numeric_print_mask action$ = 'ask_prompt_text' end routine 27100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K S E M A N T I C S Q U E S T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask the semantics question ! ! Expected: ! semantics_row row for semantics ! augmented_dictionary? ! true if this is an augmented dictionary ! def_semantics$ default answer ! def_semantic_length input length ! ! Locals: ! default$ input default ! length field length ! ! Results: ! reply$ semantic string entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_semantics_question z$ = 'Choices: num, num:scale, date, uc, zf, zs' if def_has_all_fields? then & z$ = z$ + & ', fulltime, application:name' if augmented_dictionary? then & z$ = z$ + ', dbfld:name' z$ = z$ + ', none' help_topic$ = 'semantics' clear area semantics_row, 20, semantics_row + 2, 80 message z$ line input area semantics_row, 20, semantics_row + 2, 80, & default def_semantics$, length def_semantic_length : reply$ message '' reply$ = ucase$(reply$) if reply$ = 'NONE' then reply$ = 'none' end routine 27200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E S E M A N T I C S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! validate the semantics string entered ! ! Expected: ! reply$ semantic string entered ! ! Locals: ! semantics_error? local error flag ! semantic$ one semantic ! semantic current semantic being processed ! nbr_semantics number of semantics in string ! ! Results: ! _error true if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_semantics if reply$ = '' then reply$ = 'none' exit routine end if if reply$ = 'none' then exit routine semantics_error? = false nbr_semantics = elements(reply$) for semantic = 1 to nbr_semantics validate_one_semantic next semantic if semantics_error? then set error on exit routine end if z = item(reply$, 'NUM') if z = 0 then exit routine z = match(reply$, 'RJ') if z = 0 then reply$ = reply$ + ', RJ' end routine 27250 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E O N E S E M A N T I C !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! validate a single semantic from the list ! ! Expected: ! reply$ list of semantics entered ! semantic current semantic to process ! ! Locals: ! ! Results: ! semantics_error? error flag ! semantic$ one semantic ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_one_semantic semantic$ = element$(reply$, semantic) select case semantic$ case 'NUM' case 'UC' case 'RJ' case 'ZF' case 'ZS' case 'FULLTIME' if not def_has_all_fields? then & message error : 'This data dictionary does not support FULLTIME' case else validate_other_semantics end select if _error then semantics_error? = true ! since I gosub _error gets ! turned off. so keep own end routine 27300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E O T H E R S E M A N T I C S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! some semantics are made up of two pieces. check these. ! semantic is not valid if the scale is not an integer or ! if the semantic is not known ! ! Expected: ! semantic$ one semantic from input string ! ! Locals: ! z1$ 2nd part of the semantic ! z$ 1st part of semantic separated by : ! ! Results: ! _error true if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_other_semantics z$ = element$(semantic$, 1, ':') z1$ = element$(semantic$, 2, ':') select case z$ case 'DATE' select case z1$ case 'YMD' case 'MDY' case '' case else message error : 'Illegal date format: '; semantic$ end select case 'NUM' if not valid(z1$, 'integer') then & message error : 'Illegal scale value: '; semantic$ case 'DBFLD' if not augmented_dictionary? then & message error : 'This data dictionary does not support DBFLD' case 'APPLICATION' if not def_has_all_fields? then & message error : 'This data dictionary does not support APPLICATIONS' case else : message error : 'Invalid semantic: '; semantic$ end select end routine 27400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D D E F A U L T N U M E R I C P R I N T M A S K !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! build a default print mask if the semantics indicate a numeric ! field with a scale. Only do this on new fields or if the ! print mask is blank. ! If I build a mask, I will display it. ! ! Expected: ! print_mask_row row for print mask ! def_semantics$ semantics string entered ! def_new_field? true if this is a new field ! def_print_mask$ existing print mask ! ! Locals: ! ! Results: ! def_print_mask$ new print mask ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_default_numeric_print_mask if def_print_mask$ <> 'none' and not def_new_field? then exit routine z1 = item(def_semantics$, 'NUM:') if z1 = 0 then exit routine z$ = element$(def_semantics$, z1) z1$ = element$(z$, 2, ':') z1$ = element$(z1$, 1, ' ') z1$ = change$(z1$, ',', '') scale = val(z1$) digits = val(def_field_length$) z = digits - scale mask$ = '' do if z <= 3 then exit do mask$ = ',###' + mask$ z = z - 3 loop mask$ = repeat$('#', z) + mask$ mask$ = mask$ + '.' + repeat$('#', scale) def_print_mask$ = mask$ print at print_mask_row, 20, bold, erase : def_print_mask$ end routine 27500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D I S P L A Y S E M A N T I C S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! clear the semantics area and display the value ! ! Expected: ! def_semantics$ semantics string to displaye ! semantics_row row to print on ! ! Locals: ! ! Results: ! semantics string is displayed ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine display_semantics clear area semantics_row, 20, semantics_row+2, 80 z$ = wrap$(def_semantics$, 1, 61) for z = 1 to pieces(z$) print at semantics_row - 1 + z, 20, bold : piece$(z$, z) next z end routine 28000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K P R O M P T T E X T !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the prompt text for the field ! ! Expected: ! prompt_text_row row for prompt text ! def_prompt_text$ ! default answer ! def_prompt_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_prompt_text$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_prompt_text prompt$ = 'Prompt text' length = def_prompt_length default$ = def_prompt_text$ validation$ = '' uc_response? = false help$ = 'prompt_text' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_semantics' exit routine end if if finished_entry? then process_field exit routine end if def_prompt_text$ = reply$ if def_prompt_text$ = '' then def_prompt_text$ = 'none' print at prompt_text_row, 20, bold, erase : def_prompt_text$ action$ = 'ask_report_heading' end routine 29000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R E P O R T H E A D I N G !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the heading of the field ! ! Expected: ! report_heading_row row for report heading ! def_report_heading$ default answer ! def_heading_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_report_heading$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_report_heading prompt$ = 'Report heading' length = def_heading_length default$ = def_report_heading$ validation$ = '' uc_response? = false help$ = 'report_heading' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_prompt_text' exit routine end if if finished_entry? then process_field exit routine end if def_report_heading$ = reply$ if def_report_heading$ = '' then def_report_heading$ = 'none' print at report_heading_row, 20, bold, erase : def_report_heading$ action$ = 'ask_print_mask' end routine 30000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K P R I N T M A S K !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the print mask of the field ! ! Expected: ! print_mask_row row for print mask ! def_print_mask$ default answer ! def_print_mask_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_print_mask$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_print_mask prompt$ = 'Print mask' length = def_print_mask_length default$ = def_print_mask$ validation$ = '' uc_response? = false help$ = 'print_mask' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_report_heading' exit routine end if if finished_entry? then process_field exit routine end if validate_mask def_print_mask$ = reply$ if def_print_mask$ = '' then def_print_mask$ = 'none' print at print_mask_row, 20, bold, erase : def_print_mask$ action$ = 'ask_screen_mask' end routine 31000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K S C R E E N M A S K !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the screen mask of the field ! ! Expected: ! screen_mask_row row for screen mask ! def_screen_mask$ default answer ! def_screen_mask_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_screen_mask$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_screen_mask prompt$ = 'Screen mask' length = def_screen_mask_length default$ = def_screen_mask$ validation$ = '' uc_response? = false help$ = 'screen_mask' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_print_mask' exit routine end if if finished_entry? then process_field exit routine end if validate_mask def_screen_mask$ = reply$ if def_screen_mask$ = '' then def_screen_mask$ = 'none' print at screen_mask_row, 20, bold, erase : def_screen_mask$ action$ = 'ask_help_text' end routine 31100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E M A S K !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! fix up the mask by inserting ~ ! ! Expected: ! reply$ mask entered ! ! Locals: ! in_a_field? flag - true if in a field ! z$ temp mask ! ! Results: ! reply$ fixed up mask ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_mask if reply$ = '' or reply$ = 'none' then exit routine z1$ = '' in_a_field? = false for z = 1 to len(reply$) z$ = reply$[z:z] select case z$ case "0", "%", "#", "$", "*", '@' in_a_field? = true case "~" z = z + 1 z$ = z$ + reply$[z:z] case ",", "." case else if in_a_field? then z$ = "~" + z$ end select z1$ = z1$ + z$ next z if right$(z1$, 2) = "~-" then ! trailing "-" support z1$=left(z1$, len(z1$)-2) + "-" end if if not valid(z1$, 'printmask') then message error : 'Printmask: '; reply$; ' is not a valid mask' exit routine end if reply$ = z1$ end routine 32000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K H E L P T E X T !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the help text for the field ! ! Expected: ! help_text_row row for help text ! def_help_text$ default answer ! def_help_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_help_text$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_help_text prompt$ = 'Help text' length = def_help_length default$ = def_help_text$ validation$ = '' uc_response? = false help$ = 'help_text' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_screen_mask' exit routine end if if finished_entry? then process_field exit routine end if def_help_text$ = reply$ if def_help_text$ = '' then def_help_text$ = 'none' print at help_text_row, 20, bold, erase : def_help_text$[1:61] action$ = 'ask_access_rules' end routine 33000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K A C C E S S R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the access rules for the field ! ! Expected: ! access_rules_row row for access rules ! def_access_rules$ default answer ! def_access_length input length ! ! Locals: ! ! Results: ! action$ next routine to execute ! def_access_rules$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_access_rules do input_access_rules if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_help_text' exit routine end if if finished_entry? then process_field exit routine end if validate_access_rules if _error then repeat do end do def_access_rules$ = reply$ print at access_rules_row, 20, bold, erase : def_access_rules$ action$ = 'ask_validation_rules' end routine 33050 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T A C C E S S R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask the access rules question ! ! Expected: ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! reply$ access rules entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_access_rules response_message$ = 'Rules are: read:x, write:y' prompt$ = 'Access rules' length = def_access_length default$ = def_access_rules$ validation$ = 'required' uc_response? = false help$ = 'access_rules' input_response end routine 33100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E A C C E S S R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! check the format of the access rules entered. If not correct ! then give an error ! ! Expected: ! reply$ rules entered ! ! Locals: ! ! Results: ! _error is true if a problem ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_access_rules if reply$ = 'NORMAL' then exit routine z = pos(reply$, 'READ:') z1 = pos(reply$, 'WRITE:') if z = 0 and z1 = 0 then message error : 'Illegal Access rule: '; reply$ exit routine end if z = elements(reply$) if z < 1 or z > 2 then message error : 'Invalid Access rule format: '; reply$ exit routine end if for z1 = 1 to z z$ = element$(reply$, z) z1$ = element$(z$, 2, ':') if not valid(z1$, 'letter') then message error : 'Invalid Access rule value: '; z$ end if next z1 end routine 34000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K V A L I D A T I O N R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the validation rules for this field ! ! Expected: ! def_validation_rules$ default answer ! def_validation_length input length ! ! Locals: ! uc_response? upper case flag ! validation$ validation rules ! default$ input default ! length field length ! prompt$ prompt text ! ! Results: ! action$ next routine to execute ! def_validation_rules$ new field value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_validation_rules do input_validation_rules if _exit then action$ = 'finished' exit routine end if if _back then display_validation_rules action$ = 'ask_access_rules' exit routine end if if finished_entry? then process_field exit routine end if validate_validation_rules if _error then repeat do end do def_validation_rules$ = reply$ if def_validation_rules$ = '' then def_validation_rules$ = 'none' display_validation_rules process_field end routine 34050 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T V A L I D A T I O N R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask for the validation rules ! ! Expected: ! def_validation_length ! length of input ! validation_rules_row ! row to input on ! ! Locals: ! def_validation_rules$ ! default answer ! help_topic$ help topic ! ! Results: ! reply$ answer ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_validation_rules do clear area validation_rules_row, 20, validation_rules_row + 1, 80 help_topic$ = 'validation_rules' line input area validation_rules_row, 20, & validation_rules_row + 2, 80, default def_validation_rules$, & length def_validation_length : reply$ if _help then gosub help repeat do end if end do end routine 34100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! V A L I D A T E V A L I D A T I O N R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! check to make sure that the validation rules are ok. ! do a valid statement within an exception handler. if an error ! occurs and the extype is -4021 then the rules were illegal ! ! Expected: ! def_has_all_fields? true if definition file is large enough to hold new fields ! ! Locals: ! ! Results: ! _error true if a problem ! reply$ rules entered ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine validate_validation_rules if reply$ = 'NONE' then reply$ = 'none' if reply$ = '' or reply$ = 'none' then exit routine if not def_has_all_fields? then message error : "This data dictionary does not support "; & 'validation rules' exit routine end if if not valid(reply$, 'vrules') then message error : 'Validation rules are invalid' end if end routine 34200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D I S P L A Y V A L I D A T I O N R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print the validation rules wrapped to the correct margins ! ! Expected: ! validation_rules_row ! row to start validation rules on ! def_validation_rules$ ! validation rules ! ! Locals: ! z$ wrapped validation rules ! ! Results: ! rules are printed ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine display_validation_rules clear area validation_rules_row, 20, validation_rules_row+2, 80 z$ = wrap$(def_validation_rules$, 1, 61) for z = 1 to pieces(z$) print at validation_rules_row - 1 + z, 20, bold : piece$(z$, z) next z end routine 35000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R O C E S S F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! add a new field definition or update an existing definition ! ! Expected: ! def_field_length$ field length entered ! def_new_field? flag indicating a new field ! ! Locals: ! ! Results: ! field definition is added/updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine process_field if def_field_length$ = '' then message error : 'Field length is required' action$ = 'ask_field_length' exit routine end if change_fields_from_none_to_blank if def_new_field? then store_field_definition !message delay : 'Field '; def_fieldname$; ' has been defined' else update_field_definition !message delay : 'Field '; def_fieldname$; ' has been updated' end if action$ = 'finished_with_field' end routine 35050 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C H A N G E F I E L D S F R O M N O N E T O B L A N K !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! def_classification$ ! classification ! def_validation_rules$ ! validation rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_field_length$ field length ! def_first_position$ ! first position ! def_description$ description ! ! Locals: ! ! Results: ! def_classification$ ! classification ! def_validation_rules$ ! validation rules ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_field_length$ field length ! def_first_position$ ! first position ! def_description$ description ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine change_fields_from_none_to_blank if def_description$ = 'none' then def_description$ = '' if def_first_position$ = 'none' then def_first_position$ = '0' if def_field_length$ = 'none' then def_field_length$ = '0' if def_prompt_text$ = 'none' then def_prompt_text$ = '' if def_report_heading$ = 'none' then def_report_heading$ = '' if def_print_mask$ = 'none' then def_print_mask$ = '' if def_screen_mask$ = 'none' then def_screen_mask$ = '' if def_help_text$ = 'none' then def_help_text$ = '' if def_validation_rules$ = 'none' then def_validation_rules$ = '' if def_classification$ = 'none' then def_classification$ = '' end routine 35100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S T O R E F I E L D D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! add a record to the data dictionary for the new field ! ! Expected: ! def_fieldname$ field name ! def_has_all_fields? size of new data dictionarys ! ! Locals: ! ! Results: ! def record is written ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine store_field_definition add structure def if def_has_all_fields? then def(all) = '' def(old_name) = '*' def(name) = def_fieldname$ else def(small_all) = '' def(old_name) = def_fieldname$ end if update_field_definition end add end routine 35200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! U P D A T E F I E L D D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! store the updateable fields ! ! Expected: ! def_validation_rules$ ! validation rules ! def_occurrence$ number of occurrences ! def_help_text$ help text ! def_screen_mask$ screen mask ! def_print_mask$ print mask ! def_report_heading$ ! report heading ! def_prompt_text$ prompt text ! def_data_type$ data type ! def_field_length$ field length ! def_first_position$ ! first_position ! def_description$ description ! ! Locals: ! ! Results: ! def record is updated ! def_next_pos next starting position ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine update_field_definition def(desc) = def_description$ def(first) = def_first_position$ def(len) = def_field_length$ def(dtype) = def_data_type$ parse_semantics_string parse_access_rules def(prompt) = def_prompt_text$ def(heading) = def_report_heading$ def(prmask) = def_print_mask$ def(scmask) = def_screen_mask$ def(help) = def_help_text$ if def_has_all_fields? then def(occurrence) = def_occurrence$ nbr_occurs = def(occurrence) def(validation) = def_validation_rules$ def(classification) = def_classification$ else nbr_occurs = 1 end if def_next_pos = def(first) + (def(len) * nbr_occurs) end routine 35300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E S E M A N T I C S S T R I N G !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! parse the semantics string and setup the individual ! definition fields ! ! Expected: ! def_semantics$ semantic string ! ! Locals: ! ! Results: ! def fields are updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_semantics_string set_default_semantics if def_semantics$ = 'none' then exit routine z = elements(def_semantics$) for z1 = 1 to z z$ = element$(def_semantics$, z1) select case ucase$(z$)[1:2] case "NU" def(num) = "Y" def(rj) = "Y" if elements(z$, ':') = 2 then def(scale) = element$(z$, 2, ':') case "DA" def(date) = "Y" def(df) = 'YMD' if elements(z$, ':') = 2 then def(df) = element$(z$, 2, ':') !case "LS" : def(ls) = "Y" !case "RS" : def(rs) = "Y" case "RJ" : def(rj) = "Y" case "ZF" : def(zf) = "Y" case "ZS" : def(zs) = "Y" case "UC" : def(uc) = "Y" case "DB" : def(dbfld) = element$(z$, 2, ":") case "FU" : def(fulltime) = 'S' case "AP" : def(application) = element$(z$, 2, ":") end select next z1 end routine 35400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T D E F A U L T S E M A N T I C S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set the semantics fields to their default values ! ! Expected: ! ! Locals: ! ! Results: ! def fields are updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine set_default_semantics def(num) = "N" def(rj) = "N" def(scale) = "0" def(date) = "N" def(df) = 'YMD' def(cp) = "N" def(eb) = "N" def(ls) = "N" def(rs) = "N" def(zf) = "N" def(zs) = "N" def(uc) = "N" if def_has_all_fields? then def(dbfld) = "" def(fulltime) = "" def(application) = "" end if end routine 35500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E A C C E S S R U L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! parse the access rule string and load the def structure ! ! Expected: ! def_access_rules$ access rules ! ! Locals: ! ! Results: ! def record is updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_access_rules if def_access_rules$ = 'NORMAL' then def(read) = 'N' def(write) = 'N' exit routine end if def(read) = '' def(write) = '' for z = 1 to elements(def_access_rules$) z$ = element$(def_access_rules$, z) z1$ = element$(z$, 1, ':') z2$ = element$(z$, 2, ':') def(#z1$) = z2$ next z end routine 36000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! F I N I S H E D W I T H F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! repaint the screen ! ! Expected: ! definition_screen$ definition screen background ! ! Locals: ! ! Results: ! action$ next routine to execute ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine finished_with_field set window : current definition_screen$ action$ = 'ask_fieldname' end routine 40000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E R M S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! rms_max_keys maximum keys allowed ! ! Locals: ! ok_to_create_dictionary ! flag indicating the dictionary file must exist ! ! Results: ! rms_keys current number of keys defined set to 0 ! key_duplicates$ array of key duplicate clauses is blanked ! key_field$ array of key field names is blanked ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_rms display_create_screen ok_to_create_dictionary? = false open_dictionary_file if _error then exit routine calculate_last_position recordsize$ = str$(int(def_last_pos * 1.25)) for z = 1 to rms_max_keys key_field$(z) = '' key_duplicates$(z) = '' next z rms_keys = 0 action$ = 'ask_rms_file_organization' do until action$ = 'finished' dispatch action$ loop if _exit or _back then exit routine create_rms_files end routine 41000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R M S F I L E O R G A N I Z A T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! get the file organization for this data file ! ! Expected: ! ! Locals: ! z$ menu for use when inputting the organization ! ! Results: ! action$ next routine to execute ! file_org$ file organization ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_rms_file_organization do z$ = '%at 18, 25, %title "RMS File Organization", ' + & '"Indexed" = indexed, "Sequential" = sequential' help_topic$ = 'file_organization' line input menu z$ : reply$ if _exit or _back then action$ = 'finished' exit routine end if if _help then gosub help repeat do end if if match(finished_entry_key$, _terminator) > 0 then cant_finish repeat do end if end do file_org$ = reply$ print at 3, 21, bold, erase : file_org$ paint_rms_screen action$ = 'ask_rms_recordsize' end routine 41100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A I N T R M S S C R E E N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print the rest of the RMS create screen once I know what ! file organization the user wants ! ! Expected: ! file_org$ file organization ! ! Locals: ! ! Results: ! screen is painted ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine paint_rms_screen if file_org$ = 'SEQUENTIAL' then clear area 5, 1, 21, 80 exit routine end if tab_pos = 18 print at 5, 1 : 'Primary key'; tab(tab_pos); ':' print at 6, 1 : 'Key 2'; tab(tab_pos); ':' print at 7, 1 : 'Key 3'; tab(tab_pos); ':' print at 8, 1 : 'Key 4'; tab(tab_pos); ':' print at 9, 1 : 'Key 5'; tab(tab_pos); ':' print at 10, 1 : 'Key 6'; tab(tab_pos); ':' print at 11, 1 : 'Key 7'; tab(tab_pos); ':' print at 12, 1 : 'Key 8'; tab(tab_pos); ':' print at 13, 1 : 'Key 9'; tab(tab_pos); ':' print at 14, 1 : 'Key 10'; tab(tab_pos); ':' end routine 41200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R M S R E C O R D S I Z E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the recordsize for this file. Default it to 125% of the ! actual recordsize ! ! Expected: ! file_org$ file organization ! recordsize$ default record size ! ! Locals: ! ! Results: ! recordsize$ new record size ! action$ next routine to execute ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_rms_recordsize input_recordsize if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_rms_file_organization' exit routine end if print at 4, 21, bold, erase : format$(val(recordsize$), '#####') if file_org$ = 'SEQUENTIAL' then action$ = 'ask_create_proceed' else action$ = 'ask_rms_keys' end if end routine 41300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R M S K E Y S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for key information until either all possible keys have ! been asked or the user enters a blank key field ! ! Expected: ! rms_max_keys maximum number of keys allowed ! rms_keys number of keys defined so far ! ! Locals: ! key_field$ array of field names ! rms_action$ next routine to execute ! rms_cur_key key being processed ! ! Results: ! action$ next routine to execute upon completion of this routine ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_rms_keys build_rms_key_field_menu do rms_cur_key = rms_keys + 1 rms_action$ = 'ask_rms_key_field' do until rms_action$ = 'finished' dispatch rms_action$ loop if _exit then action$ = 'finished' exit routine end if if _back then rms_keys = rms_keys - 1 clear area 5 + rms_keys, 21, 5 + rms_keys, 80 if rms_keys < 0 then rms_keys = 0 set exit on action$ = 'ask_rms_recordsize' exit routine end if repeat do end if if rms_keys = rms_max_keys or key_field$(rms_cur_key) = '' then action$ = 'ask_create_proceed' exit routine end if rms_keys = rms_keys + 1 loop end routine 41350 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D R M S K E Y F I E L D M E N U !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make a menu of the field names. Put them in order by their ! starting position since keys tend to be at the beginning of ! a record. ! ! Expected: ! def_name_field$ name of the name field ! ! Locals: ! ! Results: ! fieldname_list$ list of field names ! field_menu$ menu without the title ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_rms_key_field_menu message 'Building field name menu...' fieldname_list$ = '' field_menu$ = '%at 6, 25, %size 14, ' extract structure def sort by def(first) sort descending by def(len) sort by def(#def_name_field$) end extract for each def fieldname_list$ = fieldname_list$ + def(#def_name_field$) + ', ' next def field_menu$ = field_menu$ + fieldname_list$ + '%bar, exit' message '' end routine 41400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R M S K E Y F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the key fields ! ! Expected: ! def_name_length length of the name field ! rms_cur_key key number being entered ! ! Locals: ! uc_response? upper case flag ! length input length ! validation$ validation rules ! prompt$ prompt text ! ! Results: ! key_field$ array of field names is loaded with field name entered ! rms_action$ next routine to execute ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_rms_key_field do input_rms_key_fieldname if _exit or _back then rms_action$ = 'finished' exit routine end if do if reply$ = '' then exit do set structure def, field #def_name_field$ : key reply$ if def(len) > 256 then message error : 'RMS keys cannot exceed 256 characters - '; & reply$; ' length: '; def(len) repeat do end if end do key_field$(rms_cur_key) = reply$ if reply$ = '' then rms_action$ = 'finished' exit routine end if end do print at 5 + rms_keys, 21, bold, erase : reply$ rms_action$ = 'ask_rms_key_duplicate' end routine 41450 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T R M S K E Y F I E L D N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for a field name for the key ! ! Expected: ! ! Locals: ! field_name_menu$ menu of field names ! response_message$ message to display during input ! uc_response? upper case flag ! length input length ! validation$ validation rules ! prompt$ prompt text ! ! Results: ! reply$ response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_rms_key_fieldname do set_input_values_by_key if key_field$(rms_cur_key) <> '' then z = match(fieldname_list$, key_field$(rms_cur_key)) if z = 0 then z = 1 if rms_cur_key > 1 then z = z + 1 ! skip all done line else z = 1 ! first field end if set window : typeahead repeat$(chr$(14), z - 1) help_topic$ = 'key_fieldname' line input menu field_name_menu$ : reply$ if _exit or _back then exit routine if _help then gosub help repeat do end if end do end routine 41475 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T I N P U T V A L U E S B Y K E Y !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! setup variables based upon the key number to be input ! ! Expected: ! field_menu$ field menu without title ! rms_cur_key key to input ! ! Locals: ! field_name_menu$ field menu with title ! ! Results: ! validation$ validation rules ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine set_input_values_by_key if rms_cur_key = 1 then field_name_menu$ = field_menu$ + ',%title "Primary Key Field Name"' validation$ = 'required' else field_name_menu$ = '"All keys defined"="", ' + & field_menu$ + ',%title "Key ' + & format$(rms_cur_key, '##') + ' Field Name"' validation$ = '' end if end routine 41600 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R M S K E Y D U P L I C A T E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! find out if duplicates will be allowed for this key ! ! Expected: ! key_field$ key field name ! rms_cur_key key being processed ! ! Locals: ! ! Results: ! key_duplicates$ array of duplicate responses is updated ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_rms_key_duplicate do input_rms_key_duplicate if _exit then rms_action$ = 'finished' exit routine end if if _back then rms_action$ = 'ask_rms_key_field' exit routine end if if finished_entry? then cant_finish repeat do end if end do reply$ = ucase$(reply$[1:1]) key_duplicates$(rms_cur_key) = reply$ print at 5 + rms_keys, 21, bold, erase : & key_field$(rms_cur_key); if reply$ = 'Y' then print bold : ', DUPLICATES' else print end if rms_action$ = 'finished' end routine 41700 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T R M S K E Y D U P L I C A T E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually ask the duplicates question ! ! Expected: ! ! Locals: ! uc_response? upper case flag ! length input length ! validation$ validation rules ! prompt$ prompt text ! ! Results: ! reply$ response ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_rms_key_duplicate prompt$ = 'Allow duplicates (Y/N)' length = 4 default$ = key_duplicates$(rms_cur_key) if default$ = '' then default$ = 'Y' if rms_cur_key = 1 then default$ = 'N' end if validation$ = 'required; yes/no' help$ = 'duplicates' input_response end routine 42000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E R M S F I L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create an fdl file and then use the VMS command create/fdl ! to create the data file ! ! Expected: ! datafile_name$ name of the data file ! structure_name$ name of the structure file ! ! Locals: ! fdl_file$ fdl file name (structure name + .fdl) ! z1$ structure file extension ! z$ structure name translated from logical if necessary ! fdl_ch channel number of the fdl file ! ! Results: ! fdl file is created ! data file is created ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_rms_files fdl_ch = _channel ask system, logical structure_name$ : value z$ if z$ = '' then z$ = structure_name$ z = elements(z$, '.') z1$ = element$(z$, z, '.') z = pos(z$, '.' + z1$) fdl_file$ = left$(z$, z) + 'FDL' open #fdl_ch : name fdl_file$, access output set #fdl_ch : margin 132 build_rms_fdl_file close #fdl_ch message 'Creating '; datafile_name$; '...' pass 'create/fdl=' + fdl_file$ + ' ' + datafile_name$ ask system, pass : success pass_successful if not pass_successful then message error : 'Creation of '; datafile_name$; ' failed' message error delay : 'Systext: '; systext$ exit routine end if message delay : datafile_name$; ' has been created' end routine 42100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B U I L D R M S F D L F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! write the data to the fdl file ! ! Expected: ! ! Locals: ! ! Results: ! fdl file is built ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine build_rms_fdl_file print_fdl_file_info if file_org$ = 'SEQUENTIAL' then exit routine print_fdl_area_info print_fdl_key_info end routine 42200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T F D L F I L E I N F O !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! write the file and record portion of the fdl file ! ! Expected: ! recordsize$ record size ! file_org$ file organization ! datafile_name$ name of the data file ! ! Locals: ! ! Results: ! this portion of the fdl file is written ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_fdl_file_info print #fdl_ch : "FILE" print #fdl_ch : " BEST_TRY_CONTIGUOUS Yes" print #fdl_ch : " ALLOCATION 150" print #fdl_ch : " NAME "; & '"'; datafile_name$; '"' print #fdl_ch : " ORGANIZATION "; file_org$ print #fdl_ch : print #fdl_ch : "RECORD" print #fdl_ch : " BLOCK_SPAN yes" print #fdl_ch : " CARRIAGE_CONTROL carriage_return" print #fdl_ch : " FORMAT fixed" print #fdl_ch : " SIZE "; recordsize$ end routine 42300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T F D L A R E A I N F O !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! write the area portion of the fdl file for an indexed file ! ! Expected: ! rms_keys number of keys defined ! fdl_ch channel for the fdl file ! recordsize$ record size ! ! Locals: ! z1% record size as a integer ! z current key being processed ! bucket_size$ bucket size to use ! z% calculated bucketsize ! ! Results: ! area information is written to the fdl file ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_fdl_area_info z1% = val(recordsize$) z% = 8 + (z1% / 512) * 2 bucket_size$ = str$(min(z%, 63)) print #fdl_ch : print #fdl_ch : "AREA 0" print #fdl_ch : " ALLOCATION 100" print #fdl_ch : " BEST_TRY_CONTIGUOUS yes" print #fdl_ch : " BUCKET_SIZE "; bucket_size$ print #fdl_ch : " EXTENSION 90" print #fdl_ch : for z = 1 to rms_keys print #fdl_ch : "AREA ";str$(z) print #fdl_ch : " ALLOCATION 10" print #fdl_ch : " BEST_TRY_CONTIGUOUS yes" print #fdl_ch : " BUCKET_SIZE 8" print #fdl_ch : " EXTENSION 9" print #fdl_ch : next z end routine 42400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T F D L K E Y I N F O !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print the fdl data to define the keys ! ! Expected: ! key_field$ key field names ! key_duplicates$ array of answers to the duplicates question ! rms_keys number of keys to define ! ! Locals: ! key_dtype$ data type of key field in FDL format ! key_pos$ starting position of key field ! key_len$ length of key field ! rms_key_nbr key number to define in RMS FDL format ! rms_cur_key current key being processed ! ! Results: ! keys info is written to the fdl file ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_fdl_key_info for rms_cur_key = 1 to rms_keys setup_key_data rms_key_nbr = rms_cur_key - 1 print #fdl_ch : "KEY "; rms_key_nbr print #fdl_ch : " CHANGES "; print #fdl_ch : " "; key_changes$ print #fdl_ch : " DATA_AREA "; rms_key_nbr z$ = 'no' if key_duplicates$(rms_cur_key) = 'Y' then z$ = 'yes' print #fdl_ch : " DUPLICATES "; z$ print #fdl_ch : " INDEX_AREA "; rms_cur_key print #fdl_ch : " LEVEL1_INDEX_AREA "; rms_cur_key print #fdl_ch : " NAME "; & '"' + key_field$(rms_cur_key) + '"' print #fdl_ch : " SEG0_LENGTH "; & str$(val(key_len$)) print #fdl_ch : " SEG0_POSITION "; key_pos$ print #fdl_ch : " TYPE "; key_dtype$ if rms_cur_key > 1 then print #fdl_ch : " NULL_KEY yes" end if print #fdl_ch : next rms_cur_key end routine 42500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P K E Y D A T A !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! get the information that I have into the proper VMS RMS key ! format ! ! Expected: ! rms_cur_key current key being processed ! key_field$ array of key field names ! def_name_field$ name of the key field ! ! Locals: ! z length of numeric fields ! z$ data type of the field ! ! Results: ! key_changes$ answer to changes question ! key_len$ length of the key ! key_dtype$ data type for the key ! key_pos$ starting position of the key ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_key_data set structure def, field #def_name_field$ : key key_field$(rms_cur_key) key_pos$ = str$(def(first) - 1) z$ = def(dtype) select case z$ !** PF looks like a string of bytes as far as key values go ** case 'CH', 'UN', 'C3', 'ZN', 'EB', 'ZE', 'RO', & 'AC', 'AP', 'RS', 'PF', 'PZ' key_dtype$ = 'string' key_len$ = def(len) case 'IN', 'IU', 'FL', 'QS', 'GF' setup_numeric_key case 'DS' z = def(len) select case z case 2 key_dtype$ = 'bin2' key_len$ = '2' case 3 key_dtype$ = 'string' key_len$ = '3' case 8 key_dtype$ = 'bin8' key_len$ = '8' end select end select key_changes$ = 'yes' if rms_cur_key = 1 then key_changes$ = 'no' end routine 42600 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P N U M E R I C K E Y !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! setup key information based upon the length of a numeric field ! ! Expected: ! def record is current ! ! Locals: ! z length of the field ! ! Results: ! key_len$ length of the key ! key_dtype$ data type of the key ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_numeric_key z = def(len) select case z case 1, 2 key_dtype$ = 'bin2' key_len$ = '2' case 3, 4 key_dtype$ = 'bin4' key_len$ = '4' case 8 key_dtype$ = 'bin8' key_len$ = '8' end select end routine 46000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create a dbase III datafile. The recordsize must be exactly ! the length of the fields, so just display the record size ! and ask the proceed question ! ! Expected: ! ! Locals: ! ok_to_create_dictionary ! flag indicating the dictionary file must exist ! def_last_pos calculated last position in the dictionary ! ! Results: ! data file is created ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3 display_create_screen ok_to_create_dictionary? = false open_dictionary_file if _error then exit routine calculate_last_position print at 3, 14, bold : format$(def_last_pos, '#####') ask_create_proceed if _exit or _back then exit routine create_dbase3_files end routine 46100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 F I L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! ! Locals: ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_files dbase3_record$ = '' create_dbase3_header create_dbase3_fields create_dbase3_data_file end routine 46200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 H E A D E R !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! build up the constant portion of the header record string. ! A dbase III header record is a variable length string based ! upon the number of fields. Here we are building a ! 32 byte string that contains the field count and the record size ! ! Expected: ! dbase3_record$ header string (empty) ! def_number_fields number of fields defined (from calculate_last_position) ! ! Locals: ! recsize$ record size as an integer (word) string ! z% record size + 1 (for the delete flag) ! hsize$ header size as a integer (word) string ! hdr_size size of the actual dbase III header record ! ! Results: ! dbase3_record$ header string with the constant portion filled in ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_header hdr_size = (def_number_fields * 32) + 33 ! fields*32 + header + eofield hsize$ = convert$(hdr_size, 2) z% = def_last_pos + 1 recsize$ = convert$(z%, 2) dbase3_record$ = chr$(3) + & ! format (no MEMO fields) repeat$(chr$(0), 3) + & ! date of last update. repeat$(chr$(0), 4) + & ! last active record. hsize$ + & ! size of header. recsize$ + & ! recordsize repeat$(chr$(0), 3) + & ! reserved repeat$(chr$(0), 13) + & ! multiuser DBASE reserved repeat$(chr$(0), 4) ! reserved (20?) end routine 46300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 F I E L D S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! add a field definition for each field to the string created ! in the header record section ! The field definition consists of the field name, data type, ! field length and scale ! ! field names are padded to 11 characters with nulls ! ! Expected: ! dbase3_record$ header record string ! def_name_field$ name of the field name field ! ! Locals: ! scale scale of the field. negative scales are not allowed ! dbase3_field_string$ ! temporary string with definition of one field ! ! Results: ! dbase3_record$ header record string is added to with the field definitions ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_fields extract structure def, field first : key '0' to '99999' create_dbase3_setup_field_data dbase3_field_string$ = & rpad$(def(#def_name_field$), 11, chr$(0))[1:11] scale = def(scale) if scale < 0 then scale = 0 dbase3_field_string$ = & dbase3_field_string$ + & ! field name dbase3_dtype$ + & ! datatype repeat$(chr$(0), 4) + & ! fda in ram (not usefull here) chr$(dbase3_field_length) + & ! len of field chr$(scale) + & ! scale repeat$(chr$(0), 14) ! reserrved. put in nulls dbase3_record$ = dbase3_record$ + dbase3_field_string$ end extract end routine 46400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 S E T U P F I E L D D A T A !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set up the field characteristics that are different in the ! dbase3 than INTOUCH. ! ! Expected: ! def record is current ! ! Locals: ! ! Results: ! dbase3_field_length field length ! dbase3_dtype$ data type ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_setup_field_data dbase3_dtype$ = "C" dbase3_field_length = def(len) if def(num) = "Y" then create_dbase3_numeric_field if def(date) = "Y" & and def(df) = "YMD" & and dbase3_field_length = 8 then dbase3_dtype$ = "D" end routine 46500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 N U M E R I C F I E L D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! setup the data type for a numeric field. For an integer, ! change the length size they are stored as a string of characters ! ! Expected: ! dbase3_field_length field length ! def record is current ! ! Locals: ! z$ 1st two characters of the INTOUCH data type ! ! Results: ! dbase3_field_length modified if the field is an integer ! dbase3_dtype$ data type ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_numeric_field dbase3_dtype$ = "N" z$ = left$(def(dtype), 2) if z$ = "IN" & or z$ = "IU" then select case dbase3_field_length case 1 dbase3_field_length = 3 case 2 dbase3_field_length = 5 case else dbase3_field_length = 10 end select end if end routine 46600 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 D A T A F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create the dbase III data file. create a temporary fdl file ! to use to create the data file. Then write the header string ! to the data file. ! ! Expected: ! dbase3_record$ header string ! datafile_name$ name of the data file ! ! Locals: ! z$ 512 byte string ! dbase3_record$ append a chr$(13) and chr$(26) to header string ! to indicate end of field definitions and end ! of header info ! data_ch channel for the data file ! pass_successful flag indicating success of the pass to create the data file ! dbase3_fdl$ name of the fdl file ! ! Results: ! data file is created ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_data_file message 'Creating '; datafile_name$; '...' create_dbase3_fdl pass 'create/fdl=' + dbase3_fdl$ + ' ' + datafile_name$ ask system, pass : success pass_successful if not pass_successful then message error : 'Creation of '; datafile_name$; ' failed' message error delay : 'Systext: '; systext$ exit routine end if data_ch = _channel open #data_ch : name datafile_name$, access outin dbase3_record$ = dbase3_record$ + chr$(13) + chr$(26) z$ = space$(512) for z = 1 to len(dbase3_record$) step 512 lset z$ = dbase3_record$[z:z + 511] print #data_ch : z$ next z close #data_ch kill dbase3_fdl$ message delay : datafile_name$; ' has been created' end routine 46700 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D B A S E 3 F D L !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create an fdl file to make the dbase3 file ! ! Expected: ! ! Locals: ! fdl_ch channel for the fdl file ! ! Results: ! fdl file is created ! dbase3_fdl$ name of the fdl file ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dbase3_fdl fdl_ch = _channel open #fdl_ch : name 'sys$scratch:dbase3_fdl', & access output, unique ask #fdl_ch : name dbase3_fdl$ print #fdl_ch : "FILE" print #fdl_ch : " ALLOCATION 3" print #fdl_ch : " BEST_TRY_CONTIGUOUS yes" print #fdl_ch : ' NAME "'; & datafile_name$; '"' print #fdl_ch : " ORGANIZATION sequential" print #fdl_ch : "" print #fdl_ch : "RECORD" print #fdl_ch : " BLOCK_SPAN yes" print #fdl_ch : " CARRIAGE_CONTROL carriage_return" print #fdl_ch : " FORMAT fixed" print #fdl_ch : " SIZE 512" close #fdl_ch end routine 49000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E F A S T F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create the data file for a fastfile structure. ! create a tmp fdl file to create the relative file structure ! write a first record with 0 as the number of records and ! the record size as the first 4 bytes. ! The record size written to the header record is one higher ! than the recordsize entered by the user ! ! Expected: ! ! Locals: ! ok_to_create_dictionary ! flag indicating the dictionary file must exist ! def_last_pos last position in file ! recordsize$ default record size ! ! Results: ! the data file is created ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_fastfile display_create_screen ok_to_create_dictionary? = false open_dictionary_file if _error then exit routine calculate_last_position recordsize$ = str$(int(def_last_pos * 1.25)) action$ = 'ask_fastfile_recordsize' do until action$ = 'finished' dispatch action$ loop if _exit or _back then exit routine create_fastfile_files end routine 49100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K F A S T F I L E R E C O R D S I Z E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the recordsize ! ! Expected: ! recordsize$ default record size ! ! Locals: ! ! Results: ! recordsize$ new record size ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_fastfile_recordsize input_recordsize if _exit or _back then action$ = 'finished' exit routine end if print at 3, 14, bold, erase : format$(val(recordsize$), '#####') action$ = 'ask_create_proceed' end routine 49200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E F A S T F I L E F I L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually create the fdl and data files ! ! Expected: ! datafile_name$ name of the data file ! ! Locals: ! fastfile_fdl$ name of the fdl file created ! int_recsize% record size (1 greater than recordsize entered) ! z$ the header record to be written ! data_ch channel number of the data file ! pass_successful flag indicating the success/failure of the create/fdl statement ! fastfile_fdl$ name of the fdl file ! ! Results: ! data file is created ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_fastfile_files message 'Creating '; datafile_name$; '...' create_fastfile_fdl pass 'create/fdl=' + fastfile_fdl$ + ' ' + datafile_name$ ask system, pass : success pass_successful if not pass_successful then message error : 'Creation of '; datafile_name$; ' failed' message error delay : 'Systext: '; systext$ exit routine end if data_ch = _channel open #data_ch : name datafile_name$, access outin z$ = convert$(0%) + convert$(int_recsize%) + repeat$(chr$(0), 8183) print #data_ch : z$ close #data_ch kill fastfile_fdl$ message delay : datafile_name$; ' has been created' end routine 49300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E F A S T F I L E F D L !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create an fdl file to create the fastfile datafile ! ! Expected: ! recordsize$ the record size entered ! ! Locals: ! extsize% extension size ! ! Results: ! fdl_ch channel for the fdl file ! int_recsize% the actual recordsize to be stored into the header record ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_fastfile_fdl int_recsize% = val(recordsize$) + 1 extsize% = (50 * int_recsize%) / 512 + 1 if extsize% < 16 then extsize% = 16 fdl_ch = _channel open #fdl_ch : name 'sys$scratch:fastfile_fdl', & access output, unique ask #fdl_ch : name fastfile_fdl$ print #fdl_ch : "FILE" print #fdl_ch : " ALLOCATION 102" print #fdl_ch : " BEST_TRY_CONTIGUOUS yes" print #fdl_ch : " BUCKET_SIZE 16" print #fdl_ch : " EXTENSION "; & str$(extsize%) print #fdl_ch : " MAX_RECORD_NUMBER 2147483647" print #fdl_ch : ' NAME "'; & datafile_name$; '"' print #fdl_ch : " ORGANIZATION relative" print #fdl_ch : "" print #fdl_ch : "RECORD" print #fdl_ch : " BLOCK_SPAN yes" print #fdl_ch : " CARRIAGE_CONTROL carriage_return" print #fdl_ch : " FORMAT fixed" print #fdl_ch : " SIZE 8191" close #fdl_ch end routine 49900 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D I S P L A Y C R E A T E S C R E E N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! display the create screen frame ! ! Expected: ! datafile_name$ name of the datafile ! database_engine$ database engine for this datafile ! ! Locals: ! ! Results: ! screen background is displayed !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine display_create_screen clear z$ = space$(80) cset z$ = 'Creating ' + database_engine$ + ' data file: ' + & datafile_name$ lset fill '' : z$ = setup_version$ print at 1, 1, bold, reverse : z$ select case database_engine$ case 'RMS' print at 3, 1 : 'File organization:' print at 4, 1 : 'Recordsize :' case 'DBASE3' print at 3, 1 : 'Recordsize:' case 'FASTFILE' print at 3, 1 : 'Recordsize:' end select z$ = 'EXIT = Exit ' + & '\ = Back HELP = Help' print at 24, 1, bold, reverse : z$; end routine 49945 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T R E C O R D S I Z E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! get the recordsize ! ! Expected: ! recordsize$ default recordsize ! ! Locals: ! uc_response? uppercase flag ! validation$ validation rules ! default$ default answer ! length input length ! prompt$ prompt text ! response_message$ message to be displayed during input ! ! Results: ! recordsize$ new recordsize ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_recordsize do response_message$ = & 'Actual record size in bytes: ' + str$(def_last_pos) prompt$ = 'Record size' length = 5 default$ = recordsize$ validation$ = 'required; integer; allow 1 to 99999' uc_response? = false help$ = 'recordsize' input_response if _exit or _back then exit routine end if if finished_entry? then cant_finish repeat do end if end do recordsize$ = reply$ end routine 49975 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D E T E R M I N E L A S T A C T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! find out where to go back to based upon the database engine ! ! Expected: ! file_org$ file organization if an rms database engine ! database_engine$ database engine for this structure ! ! Locals: ! ! Results: ! action$ next routine to execute ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine determine_last_action select case database_engine$ case 'RMS' if file_org$ = 'SEQUENTIAL' then action$ = 'ask_rms_recordsize' else clear area 5 + rms_keys, 21, 5 + rms_keys, 80 action$ = 'ask_rms_keys' end if case 'FASTFILE' : action$ = 'ask_fastfile_recordsize' case 'DBASE3' : action$ = 'finished' end select end routine 49990 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K C R E A T E P R O C E E D !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! make sure they really want to create this file ! ! Expected: ! ! Locals: ! prompt$ prompt for this input ! ! Results: ! action$ next routine to execute ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_create_proceed do prompt$ = 'Proceed with file creation (Y/N)' help$ = 'create_proceed' input_response_yn if _exit then action$ = 'finished' exit routine end if if _back or reply$ = 'N' then determine_last_action exit routine end if if finished_entry? then cant_finish repeat do end if end do action$ = 'finished' end routine 50000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D O S H O W D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! show the defintion records ! ! Expected: ! ! Locals: ! ok_to_create_dictionary ! flag indicating the dictionary file must exist ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_show_definition get_brief_full ok_to_create_dictionary? = false open_dictionary_file if _error then exit routine extract_and_sort_definition if _extracted = 0 then message delay : 'No field definitions exist' exit routine end if show_ch = _channel z$ = 'sys$scratch:setup_show_definition' open #show_ch : name z$, access output, unique ask #show_ch : name show_report_name$ print_show_definition close #show_ch if _extracted = 0 then message delay : 'No field definitions exist' exit routine end if u_scr_width% = 132 u_str$ = show_report_name$ prnt_ask_option end routine 50100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! G E T B R I E F F U L L !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! find out if the user wants a full or brief display ! ! Expected: ! ! Locals: ! ! Results: ! full_display? true if the user wants a full display ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine get_brief_full full_display? = false if element$(procedure$, 3, '_') = 'FULL' then full_display? = true end routine 52000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! E X T R A C T A N D S O R T D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! read all of the records in the data dictionary ! sort them by ! 1. first position ! 2. descending by length (almost always puts redefinitions is proper order) ! 3. field name ! ! Locals: ! ! Results: ! ! ! ++DJS++ 08-DEC-1992 not using since this takes time and isn't ! in the order that INTOUCH will return ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine extract_and_sort_definition message 'Extracting field definitions...' extract structure def sort by def(first) sort descending by def(len) sort by def(#def_name_field$) end extract end routine 53000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T S H O W D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! ! Locals: ! page_counter page counter ! line_counter lines printed on current page ! lines_per_page lines on a full page ! lines_per_field lines it takes to print a field ! ! Results: ! definition report is printed ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_show_definition message 'Building defintion list...' page_counter = 0 lines_per_page = 58 line_counter = lines_per_page + 1 if full_display? then lines_per_field = 8 else lines_per_field = 3 end if for each def setup_existing_field if full_display? then print_full_list else print_brief_list end if print #show_ch : line_counter = line_counter + 1 next def message '' end routine 53100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S E T U P S H O W V A R I A B L E S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! set up those fields that can't just be printed from the ! def record ! ! Expected: ! def record is current ! ! Locals: ! def_semantics$ semantics string returned by build_semantic_string ! ! Results: ! def_semantics$ ! semantics string ! def_prompt_text$ ! prompt text ! def_last_position$ ! last position for field ! def_occurrence$ ! number of occurrences ! def_field_length$ ! field length (formatted) ! def_first_position$ ! first position (formatted) ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine setup_show_variables if def(first) = 0 then def_first_position$ = 'none' else def_first_position$ = format$(def(first), '#####') end if if def(len) = 0 then def_field_length$ = 'none' else def_field_length$ = format$(def(len), '#####') end if if def_has_all_fields? then z = def(occurrence) else z = 1 end if if z = 0 then z = 1 def_occurrence$ = format$(z, '#####') def_prompt_text$ = def(prompt) if def(prompt) = '' then def_prompt_text$ = 'none' build_semantic_string def_semantics$ = def_semantics$ end routine 54000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T F U L L L I S T !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print all data from the def record ! ! Expected: ! ! Locals: ! ! Results: ! data is printed for one def record ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_full_list print_brief_list print_full_definition end routine 54100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T B R I E F L I S T !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print the short definition ! ! Expected: ! ! Locals: ! ! Results: ! data is printed for one def record ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_brief_list print_definition_detail end routine 55000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T D E F I N I T I O N D E T A I L !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print the first two lines of the report. These are common ! between the brief and full lists ! ! Expected: ! def_semantics$ ! semantics as a string ! def_last_position$ ! last position used ! def_occurrence$ ! number of occurrences ! def_field_length$ ! length of field ! def_first_position$ ! first position ! def_name_field$ naem of the name field ! def record is current ! lines_per_page number of lines on page ! lines_per_field lines required to print field ! line_counter lines printed on page so far ! ! Locals: ! ! Results: ! brief lines are printed ! line_counter new line counter value ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_definition_detail if line_counter + lines_per_field > lines_per_page then & print_definition_heading z1 = def(first) + (val(def_occurrence$) * def(len)) - 1 def_last_position$ = format$(z1, '#####') print #show_ch : def(#def_name_field$); & tab(34); def_description$; & tab(65); format$(def_first_position$, '>####'); & tab(73); format$(def_field_length$, '>####'); & tab(80); format$(def_occurrence$, '>####'); & tab(87); def_last_position$; & tab(94); def_data_type$; & tab(101); def_print_mask$ print #show_ch : tab(7); 'Semantics : '; if def_semantics$ <> 'none' then & def_semantics$ = ucase$(def_semantics$) print #show_ch : def_semantics$ line_counter = line_counter + 2 end routine 56000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T F U L L D E F I N I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! print the rest of the definition data for a full definition ! ! Expected: ! def_has_all_fields? true if all fields are available ! def record is current ! ! Locals: ! ! Results: ! rest of report data is printed ! line_counter new number of lines printed on page ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_full_definition print #show_ch : tab(7); 'Prompt text: '; def_prompt_text$ print #show_ch : tab(7); 'Heading : '; def_report_heading$ print #show_ch : tab(7); 'Help : '; def_help_text$ print #show_ch : tab(7); 'Screen mask: '; def_screen_mask$ print #show_ch : tab(7); 'Validations: '; def_validation_rules$ line_counter = line_counter + 5 end routine 57000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T D E F I N I T I O N H E A D I N G !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! Print the report heading ! ! Expected: ! page_counter current page count ! ! Locals: ! ! Results: ! line_counter set to 4 ! page_counter incremented by one ! Routine is longer than 22 lines to make print statements ! look neater ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_definition_heading page_counter = page_counter + 1 z$ = space$(131) cset z$ = 'Definitions for: ' + actual_dictionary_name$ lset fill '' : z$ = date$(days(date$), 3) rset fill '' : z$ = 'Page: ' + format$(page_counter, '###') print #show_ch : chr$(12); z$; chr$(0) print #show_ch : chr$(0) print #show_ch : 'Field Name'; & tab(34); 'Description'; & tab(65); 'First'; & tab(72); 'Length'; & tab(80); 'Occurs'; & tab(88); 'Last'; & tab(94); 'Dtype'; & tab(101); 'Print Mask'; chr$(0) print #show_ch : repeat$('-', 32); & tab(34); repeat$('-', 30); & tab(65); '-----'; & tab(72); '------'; & tab(80); '------'; & tab(87); '-----'; & tab(94); '-----'; & tab(101); repeat$('-', 30); & chr$(0) line_counter = 4 end routine 60000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D O S H O W S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! create a show structure list ! ! Expected: ! ! Locals: ! u_scr_width% width of the report ! show_report_name$ report filename ! show_ch channel to write to ! ! Results: ! report is created and shown to the user ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_show_structure show_ch = _channel z$ = 'sys$scratch:setup_show_structure' open #show_ch : name z$, access output, unique ask #show_ch : name show_report_name$ print_show_structure close #show_ch u_scr_width% = 80 u_str$ = show_report_name$ prnt_ask_option end routine 61000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R I N T S H O W S T R U C T U R E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! actually print the page that contains the info ! ! Expected: ! data_delete_access$ data file delete access setting ! data_update_access$ data file update security setting ! data_write_access$ data file write access setting ! data_read_access$ data file read access setting ! structure_security$ ! structure security level ! dictionary_name$ name of the data dictionary ! database_engine$ name of the database engine ! datafile_name$ name of the data file ! structure_name$ name of the structure ! ! Locals: ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_show_structure z$ = space$(80) cset z$ = 'Structure: ' + structure_name$ lset fill '' : z$ = date$(days(date$), 3) rset fill '' : z$ = 'Page: 1' print #show_ch : chr$(12); z$; chr$(0) print #show_ch : chr$(0) print #show_ch : 'Structure name : '; structure_name$ print #show_ch : 'Dataset : '; datafile_name$ print #show_ch : 'Record system : '; database_engine$ print #show_ch : 'Data dictionary: '; dictionary_name$ print #show_ch : 'Access levels : '; & "SECURITY:"; structure_security$; & ", READ:"; data_read_access$; ", WRITE:"; data_write_access$; & ", UPDATE:"; data_update_access$; ", DELETE:"; data_delete_access$ end routine 70000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D O S E C U R I T Y !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! ! Locals: ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_security initialize_security open structure str : name 'tti_run:structure', & datafile structure_name$, access outin action$ = 'ask_structure_security' do until action$ = 'finished' dispatch action$ loop if _exit or _back then exit routine update_structure_records close structure str end routine 71000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N I T I A L I Z E S E C U R I T Y !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! paint the screen background for the security prompts ! ! Expected: ! ! Locals: ! ! Results: ! screen background is painted ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine initialize_security clear z$ = space$(80) cset z$ = 'Structure Security and Access Levels' lset fill '' : z$ = setup_version$ print at 1, 1, bold, reverse : z$ print at 3, 1 : 'Structure security level: '; print bold : structure_security$ print at 4, 1 : 'Read access level : '; print bold : data_read_access$ print at 5, 1 : 'Update access level : '; print bold : data_update_access$ print at 6, 1 : 'Write access level : '; print bold : data_write_access$ print at 7, 1 : 'Delete access level : '; print bold : data_delete_access$ z$ = 'EXIT = Exit ' + & '\ = Back HELP = Help' print at 24, 1, bold, reverse : z$; end routine 72000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K S T R U C T U R E S E C U R I T Y !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the structure security level ! ! Expected: ! ! Locals: ! uc_response? uppercase the response ! validation$ validation rules ! default$ default value ! length input length ! prompt$ prompt text for input ! response_message$ message to display at input time ! ! Results: ! structure_security$ ! security level entered ! action$ next routine to execute ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_structure_security response_message$ = 'Security levels are A to Z' prompt$ = 'Structure security level' length = 1 default$ = structure_security$ validation$ = 'required; allow A to Z' uc_response? = true help$ = 'structure_security' input_response if _exit or _back then action$ = 'finished' exit routine end if if finished_entry? then action$ = 'finished' exit routine end if structure_security$ = reply$ print at 3, 28, erase, bold : structure_security$ action$ = 'ask_read_access' end routine 73000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K R E A D A C C E S S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the read access level ! ! Expected: ! data_read_access$ old read access level ! ! Locals: ! uc_response? uppercase the response ! validation$ validation rules ! default$ default value ! length input length ! prompt$ prompt text for input ! response_message$ message to display at input time ! ! Results: ! data_read_access$ new read access level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_read_access response_message$ = 'Read access levels are A to Z' prompt$ = 'Read access level' length = 1 default$ = data_read_access$ validation$ = 'required; allow A to Z' uc_response? = true help$ = 'read_access' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_structure_security' exit routine end if if finished_entry? then action$ = 'finished' exit routine end if data_read_access$ = reply$ print at 4, 28, erase, bold : data_read_access$ action$ = 'ask_update_access' end routine 74000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K U P D A T E A C C E S S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the update access level ! ! Expected: ! data_update_access$ ! update access level ! ! Locals: ! uc_response? uppercase the response ! validation$ validation rules ! default$ default value ! length input length ! prompt$ prompt text for input ! response_message$ message to display at input time ! ! Results: ! data_update_access$ ! new update access level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_update_access response_message$ = 'Update access levels are A to Z' prompt$ = 'Update access level' length = 1 default$ = data_update_access$ validation$ = 'required; allow A to Z' uc_response? = true help$ = 'update_access' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_structure_security' exit routine end if if finished_entry? then action$ = 'finished' exit routine end if data_update_access$ = reply$ print at 5, 28, erase, bold : data_update_access$ action$ = 'ask_write_access' end routine 75000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K W R I T E A C C E S S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the write access level ! ! Expected: ! data_write_access$ old write access level ! ! Locals: ! uc_response? uppercase the response ! validation$ validation rules ! default$ default value ! length input length ! prompt$ prompt text for input ! response_message$ message to display at input time ! ! Results: ! data_write_access$ new write access level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_write_access response_message$ = 'Write access levels are A to Z' prompt$ = 'Write access level' length = 1 default$ = data_write_access$ validation$ = 'required; allow A to Z' uc_response? = true help$ = 'write_access' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_structure_security' exit routine end if if finished_entry? then action$ = 'finished' exit routine end if data_write_access$ = reply$ print at 6, 28, erase, bold : data_write_access$ action$ = 'ask_delete_access' end routine 76000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K D E L E T E A C C E S S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask for the delete access level ! ! Expected: ! data_delete_access$ ! old delete access level ! ! Locals: ! uc_response? uppercase the response ! validation$ validation rules ! default$ default value ! length input length ! prompt$ prompt text for input ! response_message$ message to display at input time ! ! Results: ! data_delete_access$ ! new delete access level ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_delete_access response_message$ = 'Delete access levels are A to Z' prompt$ = 'Delete access level' length = 1 default$ = data_delete_access$ validation$ = 'required; allow A to Z' uc_response? = true help$ = 'delete_access' input_response if _exit then action$ = 'finished' exit routine end if if _back then action$ = 'ask_structure_security' exit routine end if if finished_entry? then action$ = 'finished' exit routine end if data_delete_access$ = reply$ print at 7, 28, erase, bold : data_delete_access$ action$ = 'finished' end routine 80000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E F I L E S P E C !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! break out the pieces of the filename. ! append the default extension if none was entered ! ! Expected: ! default_extension$ default extension ! parse_filename$ file spec entered ! ! Locals: ! ! Results: ! extension$ extension entered or default ! filename$ filename entered ! directory$ directory entered ! device$ device entered ! special$ special prefix (AUG>, CDD>) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_filespec special$ = '' device$ = '' directory$ = '' filename$ = '' extension$ = '' parse_filename$ = trim$(parse_filename$) parse_logical if logical_found? then exit routine parse_special parse_device parse_directory parse_filename end routine 80100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E L O G I C A L !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! check to see if the filespec is a logical ! a file spec ending in a ":" is assumed to be a logical ! ! Expected: ! parse_filename$ file spec passed in ! ! Locals: ! ! Results: ! filename$ logical if found ! logical_found? flag indicating whether or not a logical was found ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_logical logical_found? = false if right$(parse_filename$, 1) <> ':' then exit routine filename$ = parse_filename$ logical_found? = true end routine 80200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E S P E C I A L !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! parse out any special prefixes (i.e. AUG>) ! ! Expected: ! parse_filename$ filename passed in ! ! Locals: ! ! Results: ! special$ special prefix ! special_end end of the special prefix if any ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_special special_end = pos(parse_filename$, '>', 1) if special_end <> 0 then special$ = parse_filename$[1:special_end] end routine 80300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E D E V I C E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! parse out the device if any ! ! Expected: ! special_end end of any special prefix ! parse_filename$ filename passed in ! ! Locals: ! ! Results: ! device$ device name if any ! device_end end of the device portion of file spec ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_device device_start = special_end + 1 device_end = pos(parse_filename$, ':', device_start) if device_end <> 0 then & device$ = parse_filename$[device_start:device_end] end routine 80400 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E D I R E C T O R Y !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! parse_filename$ filename passed in ! device_end end of device spec ! ! Locals: ! ! Results: ! directory$ directory spec if any ! directory_start start of possible directory spec ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_directory directory_start = device_end + 1 directory_end = pos(parse_filename$, ']', directory_start) if directory_end > 0 then directory$ = parse_filename$[directory_start:directory_end] else directory_end = directory_start - 1 end if end routine 80500 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P A R S E F I L E N A M E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! get the filename and the extension ! ! Expected: ! default_extension$ default extension ! parse_filename$ filename passed in ! directory_end end of the directory spec ! ! Locals: ! ! Results: ! filename$ filename ! extension$ extension in filespec ! filename_end end of the filename ! filename_start start of the filename ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine parse_filename filename_start = directory_end + 1 filename_end = pos(parse_filename$, '.', filename_start) if filename_end = 0 then filename_end = len(parse_filename$) + 1 if default_extension$ <> '' and & parse_filename$[filename_start:filename_end-1] <> 'none' then parse_filename$ = parse_filename$ + '.' + default_extension$ extension$ = default_extension$ end if else extension$ = mid$(parse_filename$, filename_end+1) end if filename$ = parse_filename$[filename_start:filename_end-1] end routine 81000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! O P E N D I C T I O N A R Y F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! see if the data dictionary exists ! if it doesn't then create it ! open the file and determine which name field this one uses ! set up the length of the name field ! ! Expected: ! ok_to_create_dictionary ! true if it is ok to create the dictionary file ! dictionary_name$ name of the data dictionary ! ! Locals: ! actual_dictionary_name$ ! acutal defintion name (without aug>) ! ! Results: ! def_has_all_fields? flag is true if all fields are present ! data dictionary is open ! def_name_length length of the name field ! def_name_field$ name of the name field ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine open_dictionary_file ask structure def : id z$ if len(z$) > 0 then exit routine ! structure is already open if augmented_dictionary? then actual_dictionary_name$ = mid$(dictionary_name$, 5) else actual_dictionary_name$ = dictionary_name$ end if z$ = findfile$(actual_dictionary_name$) if z$ = '' then if ok_to_create_dictionary? then create_dictionary_file else message error : 'Data dictionary: '; actual_dictionary_name$; & ' does not exist' end if if _error then exit routine end if open structure def : name 'tti_run:define', access outin, & datafile actual_dictionary_name$ process_def_file end routine 81100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C R E A T E D I C T I O N A R Y F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! The data dictionary doesn't exist, so create one ! ! Expected: ! actual_dictionary_name$ ! name of the dictionary file ! ! Locals: ! systext$ error message text ! pass_successful true if create succeeded ! ! Results: ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine create_dictionary_file message 'Creating data dictionary...' pass 'create/fdl=tti_run:define ' + actual_dictionary_name$ ask system, pass : success pass_successful if not pass_successful then message error: 'Creation of '; actual_dictionary_name$; & ' failed' message error: 'Systext: '; systext$ exit routine end if message '' end routine 81200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P R O C E S S D E F F I L E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! now that the file is open, get information about it ! ! Expected: ! def structure is open ! augmented_dictionary? ! true if this will be an augmented dictionary ! ! Locals: ! ! Results: ! def_name_length length of name field ! def_has_all_fields? true if this is a data dictionary with all fields (512 byte records) ! def_name_field$ name of the name field ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine process_def_file ask structure def : recordsize z if z = new_def_size then def_name_field$ = 'name' def_has_all_fields? = true else def_name_field$ = 'old_name' def_has_all_fields? = false end if if augmented_dictionary? and not def_has_all_fields? then message error : 'Cannot augment old style data dictionaries' exit routine end if ask structure def, field #def_name_field$ : length def_name_length if database_engine$ = 'DBASE3' then def_name_length = 11 get_field_lengths end routine 81300 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! G E T F I E L D L E N G T H S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ask the def structure for the lengths of the fields. Some I ! will just hard code since they are longer than the room ! available on one line ! ! Expected: ! def structure is open ! ! Locals: ! ! Results: ! def_occurrence_length ! length of number of occurrences ! def_validation_length ! length of validation rules ! def_access_length length of access rules ! def_help_length length of help text ! def_screen_mask_length ! length of screen mask ! def_print_mask_length ! length of print mask ! def_heading_length length of heading ! def_prompt_length length of prompt text ! def_semantic_length ! length of the semantics string ! def_data_type_length ! length of data type ! def_length_length length of field length ! def_first_length length of starting position ! def_desc_length description length ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine get_field_lengths ask structure def, field desc : length def_desc_length ask structure def, field first : length def_first_length ask structure def, field len : length def_length_length ask structure def, field dtype : length def_data_type_length def_semantic_length = 100 ask structure def, field prompt : length def_prompt_length ask structure def, field heading : length def_heading_length ask structure def, field prmask : length def_print_mask_length ask structure def, field scmask : length def_screen_mask_length def_help_length = 61 def_access_length = 17 if def_has_all_fields? then ask structure def, field validation : length def_validation_length ask structure def, field occurrence : length def_occurrence_length end if end routine 82000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C A L C U L A T E L A S T P O S I T I O N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! find out what is the length of the fields defined so far ! ! Expected: ! def structure is open ! ! Locals: ! last_length length of the field that is currently last in file ! last_pos highest starting position so far ! ! Results: ! def_number_fields count of the fields defined ! def_next_pos starting position of the next field to be defined ! def_last_pos ending position of last field defined ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine calculate_last_position last_pos = 0 last_length = 0 last_occurs = 0 extract structure def if def(first) > last_pos then last_pos = def(first) last_length = def(len) if def_has_all_fields? then last_occurs = def(occurrence) if last_occurs = 0 then last_occurs = 1 else last_occurs = 1 end if end if end extract def_last_pos = last_pos + (last_length * last_occurs) - 1 if def_last_pos < 0 then def_last_pos = 0 def_next_pos = def_last_pos + 1 def_number_fields = _extracted end routine 99600 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T R E S P O N S E Y N !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! Ask a yes or no question. ! ! Expected: ! ! Locals: ! ! Results: ! reply$ = yes or no answer. ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_response_yn length = 4 validation$ = 'required;yes/no' default$ = 'No' input_response reply$ = ucase$(reply$[1:1]) end routine 99700 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T R E S P O N S E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! Ask the expected prompt. ! Allows, through various flags (see do_ask_checks), you to ! automatically check for stuff. Because these flags are ! automatically reset, you don't need to worry about them ! unless you WANT it to check for something. ! Routine is over 22 lines. ! ! Expected: ! help$ help topic ! default$ default response ! uc_response? upper case flag ! length max input length ! prompt$ prompt text ! validation$ validation rules ! response_message$ message to display ! ! Locals: ! ! Results: ! finished_entry? flag signifying entry is finished ! reply$ = user's reply ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_response init_ask_vars clear area 21, 1, 21, 80 do if ask_message$ <> '' then message ask_message$ line input prompt ask_prompt$, default ask_default$, & length ask_length, at 21, 1 : reply$ clear area 21, 1, 21, 80 if _exit or _back then exit do if _help then if tmp_help_topic$ = '' then message error : 'No help is available' else help_topic$ = tmp_help_topic$ gosub help end if repeat do end if if not valid(reply$, ask_validation$, true) then repeat do end do reply$ = trim$(reply$) if ask_uc_response? then reply$ = ucase$(reply$) if reply$ = 'NONE' then reply$ = 'none' ! don't want this uppercased if match (finished_entry_key$, _terminator) > 0 then & finished_entry? = true end routine 99750 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N I T A S K V A R S !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! initialize the variables that ask uses. Reset the variables ! that the programmer passed so that they don't get used next time ! ! Expected: ! response_message$ message to display ! help$ help topic ! default$ default response ! uc_response? upper case flag ! length max input length ! prompt$ prompt text ! validation$ validation rules ! ! Locals: ! ! Results: ! finished_entry? flag signifying entry is finished ! ask_message$ message to display ! tmp_help_topic$ help topic ! ask_default$ default response ! ask_uc_response? upper case flag ! ask_length max input length ! ask_prompt$ prompt text ! ask_validation$ validations rules ! reply$ user's response is blanked ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine init_ask_vars reply$ = "" ask_validation$ = validation$ validation$ = '' ask_prompt$ = prompt$ if pos(ask_prompt$, '?') = 0 then ask_prompt$ = ask_prompt$ + '? ' prompt$ = '' ask_length = length length = 0 ask_uc_response? = uc_response? uc_response? = false ask_default$ = default$ default$ = '' tmp_help_topic$ = help$ help$ = '' ask_message$ = response_message$ response_message$ = '' finished_entry? = false end routine 99800 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C A N T F I N I S H !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! Tell them that they can't just FINISH from this prompt. ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine cant_finish message error : 'Keystrokes '; finished_entry_key$; & ' have no meaning during this prompt' end routine 99900 %include 'tti_run:help.inc' 99910 %include 'tti_run:print_option.inc'