~DEMO.BCK)0DEMO.BCKBACKUP/GROUP=0/NOCRC *.*; TTI_RUN:DEMO.BCK/SAVE/EXCLUDE=(*.INT_IMG,*.INT_IMG_AXP,MOVE_DEMO.COM,*COMPILE*.COM,*.EXE,*.EXE_AXP,*.LOG,*.LIS,*INDEX*.DAT,*.TMP,*.DIR) DAN @2V6.1 _GEEQUE:: _$1$DUA1: V6.1 ~*[INTOUCH_DEMO]AXP.DIR;1+,3(. /@ 4 -L+0123 KPWO 56NP]7Zh8}U^9GHJI:INT_DEMO_B_BASELINE_BASIC.LIS HY Y :INT_DEMO_B_BASELINE_BASIC.LOGY.Y:INT_DEMO_B_BASELINE_BASIC.OBJY"E6INT_DEMO_B_BASELINE_C.LIS7F(E,6INT_DEMO_B_BASELINE_C.LOGY Y 6INT_DEMO_B_BASELINE_C.OBJI8( ,E:INT_DEMO_B_BASELINE_COBOL.LIS~80E:INT_DEMO_B_BASELINE_COBOL.LOGt8 -E :INT_DEMO_B_BASELINE_COBOL.OBJ8"9E<INT_DEMO_B_BASELINE_FORTRAN.LIS8~E<INT_DEMO_B_BASELINE_FORTRAN.LOG8<UE<INT_DEMO_B_BASELINE_FORTRAN.OBJ290ER< INT_DEMO_B_IO_BASELINE_BASIC.LISY )Y'< INT_DEMO_B_IO_BASELINE_BASIC.LOGJ9! Y < INT_DEMO_B_IO_BASELINE_BASIC.OBJY E8INT_DEMO_B_IO_BASELINE_C.LISt9= E78INT_DEMO_B_IO_BASELINE_C.LOGT97E8INT_DEMO_B_IO_BASELINE_C.OBJz97 FC< INT_DEMO_B_IO_BASELINE_COBOL.LIS9 F(< INT_DEMO_B_IO_BASELINE_COBOL.LOG9 F/< INT_DEMO_B_IO_BASELINE_COBOL.OBJ9#F>"INT_DEMO_B_IO_BASELINE_FORTRAN.LISW:F>"INT_DEMO_B_IO_BASELINE_FORTRAN.LOG9F >"INT_DEMO_B_IO_BASELINE_FORTRAN.OBJR;@F$6INT_DEMO_B_READ_BASIC.LISY Y6INT_DEMO_B_READ_BASIC.LOG= 3Y 6INT_DEMO_B_READ_BASIC.OBJY FB6INT_DEMO_B_READ_COBOL.LIS=XG$6INT_DEMO_B_READ_COBOL.LOG=FK6INT_DEMO_B_READ_COBOL.OBJ>![G8INT_DEMO_B_READ_FORTRAN.LIS>vY8INT_DEMO_B_READ_FORTRAN.LOG>MI]G58INT_DEMO_B_READ_FORTRAN.OBJ^G>) }6INT_DEMO_B_REDIM_BASIC.LIS 4Y Y6INT_DEMO_B_REDIM_BASIC.LOG`G > 96INT_DEMO_B_REDIM_BASIC.OBJY oG-:INT_DEMO_B_SCREEN_IO_BASIC.LIS?{$GO:INT_DEMO_B_SCREEN_IO_BASIC.LOG? G :INT_DEMO_B_SCREEN_IO_BASIC.OBJ ?&G+6INT_DEMO_B_SCREEN_IO_C.LIS?j)Hk6INT_DEMO_B_SCREEN_IO_C.LOG?$H6INT_DEMO_B_SCREEN_IO_C.OBJ!? H(:INT_DEMO_B_SCREEN_IO_COBOL.LISD; H :INT_DEMO_B_SCREEN_IO_COBOL.LOGDa H:INT_DEMO_B_SCREEN_IO_COBOL.OBJD9 H4< INT_DEMO_B_SCREEN_IO_FORTRAN.LISD H4< INT_DEMO_B_SCREEN_IO_FORTRAN.LOGD H< INT_DEMO_B_SCREEN_IO_FORTRAN.OBJD H38INT_DEMO_B_UPDATE_BASIC.LISY Y 8INT_DEMO_B_UPDATE_BASIC.LOGDY 8INT_DEMO_B_UPDATE_BASIC.OBJY  -H8INT_DEMO_B_UPDATE_COBOL.LISD# H)8INT_DEMO_B_UPDATE_COBOL.LOGD, !H.8INT_DEMO_B_UPDATE_COBOL.OBJD$ H?6INT_DEMO_B_WRITE_BASIC.LISE= ;HI6INT_DEMO_B_WRITE_BASIC.LOGE- CH6INT_DEMO_B_WRITE_BASIC.OBJEL /H:6INT_DEMO_B_WRITE_COBOL.LISE@ H6INT_DEMO_B_WRITE_COBOL.LOGE@ 6H6INT_DEMO_B_WRITE_COBOL.OBJE$ @HM8INT_DEMO_B_WRITE_FORTRAN.LISE Hd8INT_DEMO_B_WRITE_FORTRAN.LOGE H&8INT_DEMO_B_WRITE_FORTRAN.OBJE_ 'H<!*[INTOUCH_DEMO]INTOUCH_DEMO.COM;13+,E./@ 4Gr-L+0123 KPWO56:&w7:&w8*^9GHJ@$! intouch_demo.COM - INTOUCH Demo Procedure ** distribution **.$! Copyright (c) 1994 Touch Technologies, Inc.$!?$! After displaying the copyright notice, the main INTOUCH Demo$! menu is started.$!$!$$ if f$getsyi("HW_MODEL") .gt. 1024$ then($ define/job/nolog vms_environment AXP$ else($ define/job/nolog vms_environment VAX$ endif$!$$ a=f$environment("PROCEDURE")G$ devdir = f$parse("''a'",,,"DEVICE",) + f$parse("''a'",,,"DIRECTORY",)$8$ rl = f$parse("rightslist","sys$system:rightslist.dat")$,$ define/process TTI_INT_DEMO 'devdir'/nolog$$ int_demo_privs = ""$E$ @tti_int_demo:int_demo_copyright "INTOUCH Demo" "''INT_DEMO_PRIVS'"1$ if int_demo_status .eqs. "ERROR" then goto done$=$ int_demo_menu :==$intouch_image tti_int_demo:int_demo/image$=$ write sys$output "Building INTOUCH 4GL demo environment..."$.$ backup tti_run:vendor.dat/ignore=interlock -/ sys$scratch:tti_vendor.tmp/new_version"$ purge sys$scratch:tti_vendor.tmp$/$ if f$mode() .eqs. "BATCH" then goto batch$!$ term = f$getdvi("tt:","devnam")$/$ wrap_flag = f$getdvi("sys$output", "tt_wrap")$ set terminal/wrap$ define/user sys$input 'term'#$ define/user/nolog rightslist 'rl'$ int_demo_menu$<$ if f$search("sys$scratch:tti_vendor.tmp") .nes. "" then -' delete sys$scratch:tti_vendor.tmp;*$ $ goto done$$ batch:#$ define/user sys$input sys$command#$ define/user/nolog rightslist 'rl'$ int_demo_menu $ goto done$$ other:$ int_demo_menu $ goto done$$ done:8$ if wrap_flag .eqs. "FALSE" then $set terminal/nowrap$ exit*[INTOUCH_DEMO]INT_DEMO.INT;49+, ?.N/@ 4PNN-L+0123 KPWOO56&nf7zڻh8G^9GHJ^I1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program : INT_DEMO.INT6 ! Package : INTOUCH DEMONSTRATION SYSTEM, ! Author : Daniel James Swain) ! Date : January 3, 1991C ! Purpose : Demonstrate a variety of INTOUCH featuresI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%2 ! M O D I F I C A T I O N H I S T O R YI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%A ! 05-OCT-94 NVA Modified to use pop-up menus from1 ! menu_routines.incG ! 18-OCT-94 JLS Report buffered I/Os on the screen I/O E ! benchmark. Report direct I/Os on allF ! the other benchmarks except for redim.E ! Use tti_run:menu_control file insteadF ! of tti_int_demo:int_demo_menu_control.I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%I100 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! D E C L A R A T I O N SI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ask margin z& if z <> 80 then set margin 80 the_width = 80" current_margin = the_width ask system : mode z$ if z$ = "BATCH" then  batch_mode = true end ifE ask system, symbol "int_demo_version" : value system_version$ today_yymmdd$ = date$! u_yymmdd$ = today_yymmdd$ gosub ymd_to_mdy! today_mmddyy$ = u_mmddyy$; ! Today's date in yyMMDD and MMDDyy formatsI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%9 ! M E N U R O U T I N E S V A R I A B L E SI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& system_name$ = "INTOUCH Demo"3 default_mcl$ = 'tti_int_demo:int_demo.mcl'6 system_title$ = "INTOUCH Demonstration System"% u_str$ = system_title$ menu_message$ = '' page_ctr = 0 selected_ctr = 0# start_print_time = 0$ report_title$ = ''$ report_title2$ = ''$ bottom_frame_text$ = ''' menu_no_finish = false> u_exit_text$ = ',"EXIT EXIT INTOUCH Demo"="EXIT"'/ system_copyright$ = "INTOUCH Demo " + &7 "Copyright (c) 1994 Touch Technologies, Inc."I200 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! I N I T I A L S E T U PI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% frame off2 open structure mc : name "tti_run:menu_control"D open structure proc : name "tti_int_demo:int_demo_procedure" declare structure operI1000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M A I N L O G I CI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%6 set structure mc, field menukey : key '111111' if _extracted = 0 then= message error : "Menu control record is not set up" halt end if action$ = "menu_build" do select case action$ case "exit" : exit do( case else : dispatch action$ end select loop  close all endJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! O P E N A L L F I L E SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%. ! open the rest of the data files here ! ! Expected: ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine open_all_files! action$ = "int_demo_init" end routineI10000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! D I S P A T C H R O U T I N E SI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! I N T D E M O I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! ! Expected: ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine int_demo_init form_feed$ = chr$(12)6 help_structure$ = "tti_int_demo:int_demo_help" gosub help_initializeP gosub help_open ! ++DJS++ 13-JAN-1993 help_init no longer opens the file max_languages = 100 dim benchmark_results$(max_languages, 5) dim benchmark_format$(5)! benchmark_format$(1) = ''( benchmark_format$(2) = '###,###'( benchmark_format$(3) = '###,###'' benchmark_format$(4) = '###.##') benchmark_format$(5) = '#,###.##'- dim baseline_language$(max_languages)- dim non_io_baseline(max_languages, 4)) dim io_baseline(max_languages, 4)! gosub establish_baselines+ action$ = "menu_display_first_menu" end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! E S T A B L I S H B A S E L I N E SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%G ! establish the performance baselines for the various languages# ! run the baseline programsD ! get the logicals created and save the values in the arrays ! ! Expected: ! ! Result :. ! baseline_language$() is loaded( ! io_baseline(,) is loaded, ! non_io_baseline(,) is loaded !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine establish_baselinesN ask window : typeahead z$ ! test to allow typeahead during before pass. pass '@tti_int_demo:int_demo_baseline'$ gosub setup_baseline_results end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 ! S E T U P B A S E L I N E R E S U L T SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%F ! results are in a file tti_int_demo:int_demo_baseline.results ! ! Expected: ! ! Result :. ! baseline_language$() is loaded( ! io_baseline(,) is loaded, ! non_io_baseline(,) is loaded !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& routine setup_baseline_results in_ch = _channelF open #in_ch : name 'sys$scratch:int_demo_baseline_results.tmp' baseline = 0 last_language$ = '' do when exception in# line input #in_ch : z1$ use end when# if _error then exit do z$ = element$(z1$, 1)( if z$ <> last_language$ then # baseline = baseline + 1- baseline_language$(baseline) = z$ last_language$ = z$ end if z$ = element$(z1$, 2) if z$ = 'IO' then  doing_io = true else doing_io = false end if  for i = 1 to 4% z$ = element$(z1$, i + 2) if doing_io thenB io_baseline(baseline, i) = val(element$(z$, 2, '=')) elseF non_io_baseline(baseline, i) = val(element$(z$, 2, '=')) end if next i loop close #in_ch9 kill 'sys$scratch:int_demo_baseline_results.tmp'  end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! O V E R V I E WJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H ! The user selected the overview option from the menu. Use the / ! help system to implement this option. ! ! Expected: ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine overview help_topic$ = 'overview' help_noprompt% = true gosub help help_noprompt% = falseK repaint_menu = false ! don't need to repaint since help put it back end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! F U N C T I O NJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! run a functionality example ! ! Expected:D ! proc(program_name) contains the name of the INTOUCH  ! program to run ! ! Result :' ! the program is executed !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine function gosub function_initE if proc(repaint) = "Y" then ask window : current cur_scrn$8 if proc(pre_execution_help_topic) <> '' then 6 help_topic$ = proc(pre_execution_help_topic) gosub display_text end if gosub ask_proceed& if _error then exit routine6 if proc(pre_execution_command) <> '' then &0 pass proc(pre_execution_command)3 pass "intouch/source " + proc(program_name)' if proc(repaint) = "Y" then  clear( set window : current cur_scrn$ end if9 if proc(post_execution_help_topic) <> '' then 7 help_topic$ = proc(post_execution_help_topic) gosub display_text delay end if set scroll 1, 24 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! F U N C T I O N I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%4 ! set up for the functionality demonstration) ! print the 2nd line of the frame" ! set the scrolling region ! ! Expected:= ! proc(desc) = description of the demonstration ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine function_init& clear area 2, 1, 22, the_width z$ = space$(the_width)# print at 2, 1, reverse : z$$ z$ = " " + proc(desc) + " " ) z = (the_width/2) - (len(z$) / 2)) print at 2, z, bold, reverse : z$ set scroll 3, 22 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B E N C H M A R KJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H ! perform the benchmark procedures. The procedure file contains> ! the languages to run in the field languages field. F ! proc(program_name) contains the program name fragment to run ! ! Expected:& ! proc record is current7 ! proc(name) is the name of the benchmark? ! proc(languages) is a list of languages in whichF ! this benchmark has been writtenF ! proc(program_name) is the program name fragement. ThisF ! appended with the lanuage form8 ! the program nameG ! proc(desc) is the description of the benchmark to print4 ! in the frame ! ! Result :F ! benchmark_results$() is loaded with the results of theE ! benchmark (buffered_ios, direct_ios, cputime) !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine benchmark gosub benchmark_init8 if proc(pre_execution_help_topic) <> '' then 6 help_topic$ = proc(pre_execution_help_topic) gosub display_text end if gosub ask_proceed& if _error then exit routine; print at 4, 1 : 'Languages used in this benchmark:'1 for language = 1 to languages_benchmarked! benchmark_language$ = &> ucase$(element$(benchmark_languages$, language))8 print at 5 + language, 3 : benchmark_language$ next language1 for language = 1 to languages_benchmarked% gosub benchmark_do_language& gosub benchmark_save_results' if _exit then exit routine% if _back then repeat for next language$ gosub benchmark_show_summary end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B E N C H M A R K I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%, ! initialize for the benchmark tests ! ! Expected:& ! proc record is current ! ! Result :G ! benchmark_languages = languages used for this benchmarkB ! benchmark_name$ = name of the test being performedM ! languages_benchmarked = number of languages used in benchmark3 ! benchmark_results$() is initialized0 ! benchmark_result$ is initialized; ! int_demo_frame_line2$ = report frame line 2 !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine benchmark_init z$ = space$(the_width)# print at 2, 1, reverse : z$$ z$ = " " + proc(desc) + " " ) z = (the_width/2) - (len(z$) / 2)) print at 2, z, bold, reverse : z$. benchmark_languages$ = proc(languages)$ benchmark_name$ = proc(desc)> languages_benchmarked = elements(benchmark_languages$)* for i = 1 to languages_benchmarked for i1 = 1 to 4* benchmark_results$(i, i1) = '' next i1 next i benchmark_result$ = ''@ int_demo_frame_line2$ = " " + proc(desc) + " Benchmark " end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%3 ! B E N C H M A R K D O L A N G U A G EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%> ! perform an actual benchmark in a particular language ! ! Expected:7 ! benchmark_languages$ = languages to use) ! language = language indexA ! proc(program_name) = program name fragment to run@ ! proc(pre_execution_command) = command to execute3 ! benchmark_name$ = name of benchmark ! ! Result :$ ! the benchmark is run !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine benchmark_do_language6 if proc(pre_execution_command) <> '' then &0 pass proc(pre_execution_command)'! clear area 2, 1, 22, the_width! z$ = space$(the_width)$! print at 2, 1, reverse : z$ benchmark_language$ = &> ucase$(element$(benchmark_languages$, language)) z$ = proc(program_name)4 if right$(z$, 1) <> '_' then z$ = z$ + '_'5 benchmark_program$ = z$ + benchmark_language$D! z$ = " " + benchmark_language$ + " " + benchmark_name$ + &! " Benchmark "*! z = (the_width/2) - (len(z$) / 2)*! print at 2, z, bold, reverse : z$ z = 5 + language% clear area z, 3, z, the_width= print at z, 3, bold : benchmark_language$; tab(11); &/ ' Benchmark is being executed'; set scroll 12, 22 print at 12, 1:;I pass "@tti_int_demo:int_demo_benchmark " + benchmark_program$ + &) " " + benchmark_language$' clear area 12, 1, 22, the_width set scroll 1, 24% clear area z, 3, z, the_width+ print at z, 3 : benchmark_language$ end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 ! B E N C H M A R K S A V E R E S U L T SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%K ! save the results of the benchmark into an array for later displayB ! result is stored as "bio=xxx,dio=xxx,cpu=xxx,elapsed=xxx ! ! Expected:F ! benchmark_language$ = language used for this benchmark= ! benchmark_result$ = results of this benchmarkD ! benchmark = current benchmark being executed (index)K ! benchmark_results$() = results of all benchmarks (formated) ! ! Result :L ! benchmark_results$() is loaded with the results of this test !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& routine benchmark_save_results= benchmark_results$(language, 1) = benchmark_language$) for baseline = 1 to max_languagesN if benchmark_language$ = baseline_language$(baseline) then exit for next baseline in_ch = _channelG open #in_ch : name 'sys$scratch:int_demo_benchmark_results.tmp' do when exception in1 line input #in_ch : benchmark_result$ use end when# if _error then exit do for i = 1 to 4/ z$ = element$(benchmark_result$, i)) z = val(element$(z$, 2, '='))' type$ = proc(baseline_type) select case type$: case 'IO' : z = z - io_baseline(baseline, i)B case 'NON_IO' : z = z - non_io_baseline(baseline, i) case else end select. ! subtract out the baseline countsL if z < 0 then z = 0 ! counts fluctuate by a few. make sure weE ! don't go negative on the display' if i = 3 then z = z / 100. i1 = i + 1P benchmark_results$(language, i1) = format$(z, benchmark_format$(i1)) next i end do close #in_ch9 kill 'sys$scratch:int_demo_benchmark_results.tmp' end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 ! B E N C H M A R K S H O W S U M M A R YJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%E ! show the results of all of the benchmarks run for this testI ! create a file and write the report to it. Use the print option; ! routine to allow the user to print where he wants ! ! Expected:. ! benchmark_results$() = results; ! languages_benchmarked = number of tests run& ! proc record is current7 ! proc(name) is the name of the benchmark ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& routine benchmark_show_summary gosub bss_init* for i = 1 to languages_benchmarked8 if line_counter > 56 then gosub bss_heading? !print #out_ch : tab(10); benchmark_results$(i, 1); &5 ! tab(31); benchmark_results$(i, 2); &5 ! tab(44); benchmark_results$(i, 3); &5 ! tab(55); benchmark_results$(i, 4); &2 ! tab(63); benchmark_results$(i, 5)< print #out_ch : tab(16); benchmark_results$(i, 1);0 if proc(name) = "B_SCREEN_IO" then > print #out_ch : tab(37); benchmark_results$(i, 2);1 elseif proc(name) <> "B_REDIM" then > print #out_ch : tab(37); benchmark_results$(i, 3); end if print #out_ch : &4 tab(48); benchmark_results$(i, 4); &1 tab(56); benchmark_results$(i, 5)O !+jls+ Report buffered I/O on screen, no I/O redim, direct I/O others) line_counter = line_counter + 1 next i' if post_execution_text then # gosub bss_print_text_file end if! gosub bss_report_finished end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B S S I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%L ! get the screen painted to show the summary report is being created8 ! make up the output file name and open the file ! ! Expected:8 ! proc(name) = name of procedure being runG ! proc(post_execution_help_topic) = text to print at end ! ! of report ! ! Result :9 ! benchmark_filename$ = name of file opened* ! out_ch = channel opened on; ! post_execution_text = true if text to print= ! line_counter set to 66 to force first heading ! page_counter = 0 !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine bss_init set scroll 1, 24 !gosub bss_report_frame, message "Creating summary report..."I print at 23, 54:; !++amr++ 04/25/91 out_ch = _channel9 benchmark_filename$ = 'sys$scratch:int_demo_' + &0 lcase$(proc(name)) + '_list.tmp'> open #out_ch : name benchmark_filename$, access output# post_execution_text = false: if proc(post_execution_help_topic) <> '' then &$ post_execution_text = true line_counter = 66 page_counter = 0 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! B S S P R I N T T E X T F I L EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%1 ! print the text at the end of the report, ! text is contained in the help file ! ! Expected:C ! proc(post_execution_help_topic) = help topic to use1 ! line_counter = current line count ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine bss_print_text_fileM set structure help, field topic : key proc(post_execution_help_topic) if _extracted = 0 then exit routine end if print #out_ch: print #out_ch:' line_counter = line_counter + 23 bss_text$ = wrap$(help(text), 1, the_width)% bss_lines = pieces(bss_text$)% for bss_line = 1 to bss_lines2 text_line$ = piece$(bss_text$, bss_line)9 if line_counter >= 56 then gosub bss_heading# print #out_ch: text_line$) line_counter = line_counter + 1 next bss_line  end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! B S S H E A D I N GJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%2 ! print the heading for th~DEMO.BCK ?L+[INTOUCH_DEMO]INT_DEMO.INT;49PN5>0e summary report ! ! Expected:& ! proc record is current7 ! proc(name) is the name of the benchmark> ! system_title$ = "INTOUCH Demonstration System" ! ! Result :# ! heading is printed 0 ! line_counter set to proper value+ ! page_counter is incremented !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine bss_heading' page_counter = page_counter + 1 z$ = system_title$) print #out_ch : chr$(12); chr$(0)< print #out_ch : 'Run on: '; date$(days(date$), 3); &> tab(40 - (len(z$)/2)); z$; tab(72); 'Page '; &5 format$(page_counter, '###'); chr$(0) print #out_ch : chr$(0): z$ = " " + benchmark_name$ + " Benchmark Summary "< print #out_ch : tab(40 - (len(z$) / 2)); z$; chr$(0) print #out_ch : chr$(0)J !print #out_ch : tab(53); 'CPU Time'; tab(63); ' Elapsed'; chr$(0)I !print #out_ch : tab(10); 'Language'; tab(25); 'Buffered I/Os'; &? ! tab(40); 'Direct I/Os'; tab(53); ' Seconds'; &- ! tab(63); ' Seconds'; chr$(0)P !print #out_ch : tab(10); repeat$('-', 12); tab(25); repeat$('-', 13); &G ! tab(40); repeat$('-', 11); tab(53); repeat$('-', 8); &2 ! tab(63); repeat$('-', 8); chr$(0)I print #out_ch : tab(46); 'CPU Time'; tab(56); ' Elapsed'; chr$(0)- print #out_ch : tab(16); 'Language'; . if proc(name) = "B_SCREEN_IO" then 3 print #out_ch : tab(31); 'Buffered I/Os';/ elseif proc(name) <> "B_REDIM" then 1 print #out_ch : tab(33); 'Direct I/Os'; end ifJ print #out_ch : tab(46); ' Seconds'; tab(56); ' Seconds'; chr$(0)3 print #out_ch : tab(16); repeat$('-', 12); . if proc(name) = "B_SCREEN_IO" then 4 print #out_ch : tab(31); repeat$('-', 13);/ elseif proc(name) <> "B_REDIM" then 4 print #out_ch : tab(33); repeat$('-', 11); end if print #out_ch : &+ tab(46); repeat$('-', 8); &1 tab(56); repeat$('-', 8); chr$(0)P !+jls+ Report buffered I/O on screen, no I/O on redim, direct I/O others line_counter = 8 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! B S S R E P O R T F I N I S H E DJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H ! report is finished. setup so that the print option routine can ! print the report ! ! Expected:< ! benchmark_filename$ = name of report created ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine bss_report_finished close #out_ch$ u_str$ = benchmark_filename$ u_scr_width% = the_width u_help$ = 'print_option'- u_dispatch$ = 'int_demo_report_frame' gosub prnt_ask_option end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! D I S P L A Y T E X TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%E ! display the text contained as a help topic in the help file ! ! Expected:3 ! help_topic$ = help topic to display ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine display_text do gosub dt_init+ if _extracted = 0 then exit do gosub dt_display) clear area 21, 1, 21, the_width end do end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D T I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 ! initialize for the display of the text ! ! Expected:3 ! help_topic$ = help topic to display ! ! Result :! ! screen is cleared# ! help record is read( ! line_counter is set to 3 !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine dt_init& clear area 3, 1, 22, the_width9 set structure help, field topic : key help_topic$. if _extracted = 0 then exit routine line_counter = 4 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! D T D I S P L A YJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! actually print the text ! ! Expected:1 ! help(text) is the text to display ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine dt_display2 dt_text$ = wrap$(help(text), 1, the_width)# dt_lines = pieces(dt_text$)# for dt_line = 1 to dt_lines0 text_line$ = piece$(dt_text$, dt_line)) line_counter = line_counter + 1H if (line_counter >= 20) or text_line$[1:1] = form_feed$ then delay) if _exit then exit routine* clear area 3, 1, 22, the_width line_counter = 4 end if1 if text_line$[1:1] <> form_feed$ then1 print at line_counter, 1 : text_line$ end if next dt_line  end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S O U R C EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%E ! make a report out of the source code for all programs for a ! particular language ! ! Expected:3 ! proc(languages) = language selected; ! proc(program) = name fragment to retrieve ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine source gosub source_init source_file = 0 do' source_file = source_file + 1; text_file$ = findfile$(source_file$, source_file), if text_file$ = '' then exit do gosub print_text_file line_counter = 66 loop$ gosub source_report_finished end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! S O U R C E I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%D ! get the screen painted to show the report is being created ! open the input file8 ! make up the output file name and open the file ! ! Expected:3 ! proc(languages) = language selected: ! proc(program_name) = program name fragment ! ! Result :D ! source_file$ = fragment of program names to retreive9 ! report_name$ = name of report file opened6 ! report_title$ = title to put on report !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine source_initM int_demo_frame_line2$ = ' Source Code List of ' + proc(languages) + &* ' Demonstration Programs '# gosub int_demo_report_frame. message "Creating source code list...") source_file$ = proc(program_name)2 report_file$ = 'sys$scratch:int_demo_' + &7 lcase$(proc(languages)) + '_source.tmp'- report_title$ = int_demo_frame_line2$ out_ch = _channel7 open #out_ch : name report_file$, access output page_counter = 0 line_counter = 66 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 ! S O U R C E R E P O R T F I N I S H E DJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H ! report is finished. setup so that the print option routine can ! print the report ! ! Expected:' ! out_ch = output channel& ! in_ch = input channel5 ! report_file$ = name of report created ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& routine source_report_finished close #out_ch u_str$ = report_file$ u_scr_width% = the_width u_help$ = 'print_option'- u_dispatch$ = 'int_demo_report_frame' gosub prnt_ask_option end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ! P R I N T T E X T F I L EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%* ! make a report out of a text file ! ! Expected:* ! text_file$ = file to print/ ! report_file$ = file to print to, ! report_title$ = heading line ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine print_text_file gosub ptf_init& if _error then exit routine do when exception in* line input #in_ch : text_line$ use end when# if _error then exit do9 if line_counter > 56 then gosub ptf_heading$ print #out_ch : text_line$) line_counter = line_counter + 1 loop! gosub ptf_report_finished end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P T F I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%@ ! open the input file, output file. initialize counters ! ! Expected:* ! text_file$ = file to print, ! out_ch = channel to print toA ! expects text file name to be logical:filename.ext ! ! Result :9 ! in_ch = channel source file is opened on !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ptf_init in_ch = _channel when exception in' open #in_ch : name text_file$ use end when if _error thenB message error : "Error opening text file: " + text_file$. message error : "Extext: " + extext$ exit routine end if end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! P T F H E A D I N GJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%* ! print the heading for the report ! ! Expected:4 ! page_counter = current page_counter1 ! report_title$ = second line title> ! system_title$ = "INTOUCH Demonstration System" ! ! Result :# ! heading is printed + ! page_counter is incremented# ! line_counter is set !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ptf_heading' page_counter = page_counter + 1 z$ = system_title$" print #out_ch : chr$(12); < print #out_ch : 'Run on: '; date$(days(date$), 3); &> tab(40 - (len(z$)/2)); z$; tab(72); 'Page '; &4 format$(page_counter, '##'); chr$(0)L print #out_ch : tab(40 - (len(report_title$) / 2)); report_title$; & chr$(0) print #out_ch : chr$(0) print #out_ch : chr$(0) line_counter = 4 end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! P T F R E P O R T F I N I S H E DJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H ! report is finished. setup so that the print option routine can ! print the report ! ! Expected:' ! out_ch = output channel& ! in_ch = input channel5 ! report_file$ = name of report created ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine ptf_report_finished close #in_ch end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%3 ! I N T D E M O R E P O R T F R A M EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%C ! print the screen since the report option screen clears it ! ! Expected:7 ! int_demo_frame_line2$ = line 2 of frameF ! system_title$ = "INTOUCH Demonstration System" ! ! Result :* ! lines 1, 2, 24 are painted !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine int_demo_report_frame clear6 set structure mc, field menukey : key "111111" u_str$ = system_title$2 gosub screen_frame  z$ = space$(the_width)# print at 2, 1, reverse : z$< z = (the_width/2) - (len(int_demo_frame_line2$) / 2)< print at 2, z, bold, reverse : int_demo_frame_line2$ end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K P R O C E E DJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%J ! find out if the user wants to proceed with the benchmark/example ! ! Expected: ! ! Result :D ! error is set on if the user doesn't want to continue !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask_proceed u_prompt$ = "Proceed" gosub askyn& clear area 3, 1, 22, the_width2 if _back or _exit or u_reply$ = 'N' then set error on exit routine end if end routineI80000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%7 ! P R O G R A M I N C L U D E M O D U L E SI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%I90000 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%? ! C O M M O N A N D U T I L I T Y R O U T I N E SI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'90001 %include "utility_routines.inc"$90002 %include "menu_routines.inc"+90004 %include "tti_run:print_option.inc"#90005 %include "tti_run:help.inc" 999999 end*[INTOUCH_DEMO]INT_DEMO.MCL;38+,yW. /@ 4J -L+0123 KPWO 56vE9h7:h8ɡ_9GHJ! INT_DEMO.MCL!-! Copyright (c) 1991 Touch Technologies, Inc.=!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! Level 1 menu=!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% $menu MAIN$heading Main Menu$title Procedures" $item overview9 $item menu benchmark Benchmark Procedures: $item menu function INTOUCH FunctionalityJ $item menu source Print Source Code for Demo Procedures$title Miscellaneous! $item system  $item mail$end=!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! Level 2 menu=!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$menu benchmark$heading Benchmark Procedures$title Performance Benchmarks% $item b_screen_io! $item b_write $item b_read" $item b_update! $item b_redim$end=!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! Level 2 menu=!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$menu function$heading INTOUCH Functionality$title INTOUCH Functionality5 $item menu data Data Base Access6 $item menu text Text Manipulation? $item menu vms Operating System Interface4 $item menu terminal Screen Handling $item f_date $item f_math���$end��=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��! Level 2 menu=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��� �$menu source��.�$heading Print Source Code for Demo Procedures���$title Languages!� $item intouch�� $item basic�!� $item fortran�� $item cobol�� $item vax_c����$end��=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��! Level 3 menu=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��� �$menu data���$heading Data Base Access����$title Data Base Access�$� $item db_sorting&� $item db_selecting&� $item db_searching���$end��=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��! Level 3 menu=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��� �$menu text���$heading Text Manipulation���$title Text Manipulation � $item f_scan#� $item f_element� � $item f_wrap���$end��=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��! Level 3 menu=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��� �$menu vms���#�$heading Operating System Interface���!�$title Operating System Interface�� $item f_ask�� $item f_set� � $item f_pass���$end��=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%��! Level 3 menu=�!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%����$menu terminal���$heading Screen Handling���$title Screen Handling%� $item f_print_attr�$� $item f_print_pos!� $item f_window��� �$title Input%� $item f_input_area����$title Creating Menus�)� $item f_input_menu_pop�*� $item
f_input_menu_main)� $item
f_input_menu_sub* $item f_input_menu_pull$end *[INTOUCH_DEMO]INT_DEMO_AXP.OLB;1+,6C./ 4-L+0123 KPWO56S7 cHP8M/`9GHJ,% Librarian A09-16N@!SP!;LHFOR20FOR5INT_DEMO_B_BASELINE_BASIC$MAININT_DEMO_B_BASELINE_CINT_DEMO_B_BASELINE_FORTRA$MAININT_DEMO_B_IO_BASELINE_BAS$MAININT_DEMO_B_IO_BASELINE_CINT_DEMO_B_READ_BASIC$MAIN?INT_DEMO_B_REDIM_BASIC$MAINMINT_DEMO_B_SCREEN_IO_BASIC$MAINSINT_DEMO_B_SCREEN_IO_CcINT_DEMO_B_SCREEN_IO_FORTRANgINT_DEMO_B_UPDATE_BASIC$MAININT_DEMO_B_WRITE_BASIC$MAINPROG1PROG2YPROG4PROG5yPROG6cINT_DEMO_B_SCREEN_IO_FORTRANgINT_DEMO_B_UPDATE_BASIC$MAININT_DEMO_B_WRITE_BASIC$MAININT_DEMO_B_WRITE_FORTRANPROG1PROG2PROG3YPROG4PROG5yPROG6)INT_DEMO_B_SCREEN_IO_CPROG6 ~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;1&| !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTU~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;1e*|UVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;1|~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;1\Y1S WWINT_DEMO_B_BASELINE_BASIC$MAIN 16-DEC-1994 16:12DEC BASIC V1.0-001  it$CODE$`$LINK$ $READ_ONLY$ $LITERAL$$ARRAY$DESC@JINT_DEMO_B_BASELINE_BASIC$MAINDBASIC$HANDLER DBASIC$INIT DBASIC$END =|t@#~^^cGG"0"TG@BHb@Zkc"4GPBXb@Zk4GcG]]#k40G< DBASIC$INIT44b# DBASIC$INIT48@< DBASIC$INIT4HGT DBASIC$END4Lb# DBASIC$END4P@T DBASIC$END =0;= 7DBASIC$HANDLER=;@ DBASIC$INIT DBASIC$END =|@INT_DEMO_B_BASELINE_BASICX X=H@?INT_DEMO_B_BASELINE_BASIC$MAINDEC BASIC V1.0-001` `=\TNI`C4-5DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_BASELINE_BASIC.BAS;1 = = +44=,$INT_DEMO_B_BASELINE_BASIC$MAIN4= 8$ $= $4: := T4= t =  wwL72S DAN INT_DEMO_B_BASELINE_BASIC$MAIN.Yo)a DAN INT_DEMO_B_BASELINE_Cp DAN PROG18Kz DAN INT_DEMO_B_BASELINE_FORTRA$MAIN8zل DAN INT_DEMO_B_IO_BASELINE_BAS$MAIN19 DAN INT_DEMO_B_IO_BASELINE_C򠈐 DAN PROG2ݪ DAN FOR23_W DAN INT_DEMO_B_READ_BASIC$MAINiÈ DAN PROG5҈ DAN FOR5 1D""aV1.0QQINT_DEMO_B_BASELINE_CV1.016-DEC-1994 16:13DEC C V1.3-000A0 0 $READONLY$$BSS$$DATA$P$LINK$ $LITERAL$i$CODE$ $ABS$(JxMAIN(J__MAIN DECC$MAIN DECC$EXIT =0x;=0;=0  DECC$EXIT DECC$MAIN =#4G~^ ^(GG#0B  = > 8b@Zk @4G B(bG@ZkG] ](0#k4Gk4$GH DECC$MAIN4<b# DECC$MAIN4D@H DECC$MAIN4PG` DECC$EXIT4Tb# DECC$EXIT4\@` DECC$EXITL L=<43INT_DEMO_B_BASELINE_CDEC C V1.3-000A? ?= 4=TRANSFER$BREAK$GOZ Z=VNHCVR3/DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_BASELINE_C.C;1 = p p= x44= mainx4=  = H H= 44=__main~ ~=zr p1 p2 p3 p4 p5 p6 argc  argv envp = x =  ww1Q`p0>>PROG1016-DEC-1994 16:13DEC COBOL V2.0-271 iX$CODE$X$LOCAL$P$LINK$$UNINIT$PDATA$ COB$NAMES_____1 0COB$NAMES_____2 COB$NAMES_____3 COB$NAMES_____4$LOCAL_1DCOB$IMAGE_INIT(JPROG1 DCOB$CALLED DCOB$STOP =`X#~^^GG  (4G@BHb@Zk "G0B8b@Zk44G@ DCOB$CALLED48b# DCOB$CALLED4<@@ DCOB$CALLED4LGX DCOB$STOP4Pb# DCOB$STOP4T@X DCOB$STOP =PROG1= @;= @=H;= =0;=  8;; DCOB$STOP DCOB$CALLED| |;;= ;=? ?=/'&PROG1DEC COBOL V2.0-271` `=\TNI`]35DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_BASELINE_COBOL.COB;1 = t t= 44= PROG14= $ $= 4 = H4=MAINLINEH4=START-UP4= START-UP-EXIT4= RETURN-CODE 4=  = X =  ww1.z XXINT_DEMO_B_BASELINE_FORTRA$MAIN 16-DEC-1994 16:13DEC Fortran V6.1-386 $LINK$i$CODE$$IODATA$$BSS$$DATA$@JINT_DEMO_B_BASELINE_FORTRA$MAINL L= 0;=4 4=GG4GGk[ [=KCBINT_DEMO_B_BASELINE_FORTRA$MAINDEC Fortran V6.1-386b b=^VPKxX#7DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_BASELINE_FORTRAN.FOR;1 = = ,44=-%INT_DEMO_B_BASELINE_FORTRA$MAIN4=  X X= 4= $BEGIN$ 4= 1 =  =  ww1H؄ XXINT_DEMO_B_IO_BASELINE_BAS$MAIN 16-DEC-1994 16:14DEC BASIC V1.0-001h hi$CODE$$LINK$ $READ_ONLY$ $LITERAL$$ARRAY$DESC VENDOR_MAP@JINT_DEMO_B_IO_BASELINE_BAS$MAINDBASIC$HANDLER DBASIC$INIT DBASIC$OPEN DBASIC$CLOSE DBASIC$END\ \=0#~^^cGG"P"TG@BHb@Zkp&"&!"="4GTG0GG`Bhb@Zk"4GTGBb@Zkc"4GBb@Zk4GcG]]#k40G< DBASIC$INIT44b# DBASIC$INIT48@< DBASIC$INIT4pG| DBASIC$OPEN4tb# DBASIC$OPEN4x@| DBASIC$OPEN4G DBASIC$CLOSE4b# DBASIC$CLOSE4@ DBASIC$CLOSE4G DBASIC$END4b# DBASIC$END4@ DBASIC$ENDT T=0;= 7DBASIC$HANDLER=;@ DBASIC$INIT;` DBASIC$OPEN; DBASIC$END DBASIC$CLOSE =|@INT_DEMO_B_IO_BASELINE_BASIC: :="sys$scratch:tti_vendor.tmpY Y=IA@INT_DEMO_B_IO_BASELINE_BAS$MAINDEC BASIC V1.0-001c c=_WQLrX&wx8DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_BASIC.BAS;3 =  = ,44=-%INT_DEMO_B_IO_BASELINE_BAS$MAIN4=8$ $= $4^ ^="4= WHOLE_REC$ e4="4=NAME$ 2e4=" 4= SEX$ be4="4=BDATE$ e4="%4=STREET$ e4=" C4=CITY$ e4="  O4= ZIP$ $e4="X4=ETHNIC$ Se4="Y4=PARENT$ e4=" q4=PHONE$ e4=" {4=BPHONE$ e4=" 4=EPHONE$ e4="4=BALANCE$ Le4: := 4=  =  ww17ⱑV1.0TTINT_DEMO_B_IO_BASELINE_CV1.016-DEC-1994 16:14DEC C V1.3-000A  $READONLY$$BSS$($DATA$$LINK$ $LITERAL$i$CODE$ $ABS$DECC$GA_STDERR DECC$GA_STDINDECC$GA_STDOUT DECC$FOPEN(JMAIN(J8 __MAIN DECC$MAIN DECC$EXIT_ _=r=#sys$scratch:tti_vendor.tmp =0;=  DECC$FOPEN;=0;=0 ` DECC$EXIT DECC$MAIN =#4G~^ ^(GG#8B  = > @b@Zkb# @(B4G0bG@ZkG] ](0#kG#0TG~^ " [GG({@Zk4GG] #k4$GH DECC$MAIN4<b#8 DECC$MAIN4D@H DECC$MAIN4PGd DECC$EXIT4Xb#8 DECC$EXIT4`@d DECC$EXIT4G DECC$FOPEN4{# DECC$FOPEN4@ DECC$FOPENO O=?76INT_DEMO_B_IO_BASELINE_CDEC C V1.3-000A? ?= 4=TRANSFER$BREAK$GO] ]=YQKF/r&wp2DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_C.C;3O O=KCB=㠈Q$SYS$COMMON:[SYSLIB]DECC$RTLDEF.TLB;1stdioH H=D<    = 44= main4=(    $ $= 4 =  char ee4=  ee4=@8_iobufp _cnt _ptr re4=@_base e4=5-`_flagh_file e4=   e4="file_ptr e4 = HH H= 484=__main~ ~=zr p1 p2 p3 p4 p5 p6 argc  argv envp =  =  8ww1?.ꠈ0>>PROG2016-DEC-1994 16:14DEC COBOL V2.0-271H Hih$CODE$ $LOCAL$$LINK$$UNINIT$PDATA$ COB$NAMES_____1 0COB$NAMES_____2 COB$NAMES_____3 COB$NAMES_____4$LOCAL_1DCOB$IMAGE_INIT(J`PROG2 DCOB$CALLED DCOB$OPEN DCOB$CLOSE DCOB$STOP DCOB$RMS_STS_STV DCOB$RMS_FILENAME(DCOB$CURRENT_RMS_STS_STV(DCOB$RMS_CURRENT_FILENAMEx x =ph#~^^GG4GBb@Zk"""b""GGGGBb@Zk"""GtGBb@ZkGBb@Zk#~^^G[ "GTGBb@Zk" X#~^^G[ "4GTGBb@Zk" E#~^^G[ ""h1"GtGBb@Zkh 2#~^^G[ G4GBb@Zk" !#~^^G`[ 4G4GBb@Zk" #~^^G @[ h"GTGBb@Zkh G]] #k4 4G@ DCOB$CALLED4 8b#` DCOB$CALLED4 <@@ DCOB$CALLED4hGt DCOB$OPEN4lb#` DCOB$OPEN4p@t DCOB$OPEN4G DCOB$CLOSE4b#` DCOB$CLOSE4@ DCOB$CLOSE4G DCOB$STOP4b#` DCOB$STOP4@ DCOB$STOP< GDCOB$RMS_STS_STV< b#`DCOB$RMS_STS_STV< @DCOB$RMS_STS_STV< G(DCOB$RMS_STS_STV< b#`DCOB$RMS_STS_STV< $@(DCOB$RMS_STS_STV<pG|DCOB$RMS_FILENAME<tb#`DCOB$RMS_FILENAME<x@|DCOB$RMS_FILENAMEDGDCOB$CURRENT_RMS_STS_STVDb#`DCOB$CURRENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVDGDCOB$CURRENT_RMS_STS_STVDb#`DCOB$CURRENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVD <GHDCOB$RMS_CURRENT_FILENAMED@b#`DCOB$RMS_CURRENT_FILENAMED D@HDCOB$RMS_CURRENT_FILENAME ;;=80x;=PROG2=;x;= =(SYS$SCRATCH:TTI_VENDOR.TMP=;=  DCOB$CLOSE DCOB$STOP DCOB$RMS_FILENAME`;@(DCOB$CURRENT_RMS_STS_STV DCOB$RMS_STS_STV=0;=  =0;=  =0;=  =0<;=  =0;=  =0;=  =0;=  ;= DCOB$CALLED( DCOB$RMS_CURRENT_FILENAME DCOB$OPEN| |;`;=;=? ?=/'&PROG2DEC COBOL V2.0-271c c=_WQL̄&w8DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_COBOL.COB;3 = -| |= 4`4= PROG24=%$ $= 4C C= H4=MAINLINEH4=START-UP4= START-UP-EXIT4= RETURN-CODE 4=!RMS-STS4= RMS-STV4=:2 RMS-FILENAME4= \e4=( #RMS-CURRENT-STS4=( #RMS-CURRENT-STV4=B:(RMS-CURRENT-FILENAME 4= e4=QI      1TEST-FILE-RECORD@ NAME 0e4= SEX Ee4= B-DATE Ze4= (STREET oe4= CITY e4= xZIP e4= ETHNIC e4= PARENT e4=PHONE e4= BPHONE e4= (EPHONE e4=!xBALANCE e4=  0e4= 4=!TEST-FILE-RECORD Ee4: := L4= h =  `ww1Ԫ ==FOR2 16-DEC-1994 16:15DEC Fortran V6.1-386 $LINK$i$CODE$$IODATA$$BSS$$DATA$(JFOR2 DFOR$OPEN DFOR$HANDLER DFOR$CLOSE =0X;=p 7 DFOR$HANDLER=0#sys$scratch:tti_vendor.tmpP=8   DFOR$OPEN DFOR$CLOSE=  =#~X^`^hcGGPb"0 TG@8=4GH=TGP]"4G_"8"G`Bhb@Zkb""4G_"GGpBxb@Zk4GcGX]`]hp#k4\Gh DFOR$OPEN4`b# DFOR$OPEN4d@h DFOR$OPEN4G DFOR$CLOSE4b# DFOR$CLOSE4@ DFOR$CLOSE@ @=0('FOR2DEC Fortran V6.1-386e e=aYSN&w:DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_FORTRAN.FOR;3 = u u= 44= FOR24= ܼ $ $= $45 5= 4=$BEGIN$ =  =  ww 1\V SSINT_DEMO_B_READ_BASIC$MAIN 16-DEC-1994 16:15DEC BASIC V1.0-001` `i0$CODE$$LINK$4 $READ_ONLY$ $LITERAL$$ARRAY$DESC VENDOR_MAP@J`INT_DEMO_B_READ_BASIC$MAINDBASIC$HANDLERDBASIC$HANDLER DBASIC$INIT DBASIC$OPEN    DBASIC$GET DBASIC$PRINT DBASIC$OUT_T_DX_S DBASIC$OUT_L_V_B DBASIC$IO_END DBASIC$ERR DBASIC$CONTINUE_TARGET DBASIC$EXIT_HNDL DBASIC$ENDOTS$JUMP_TO_BPVT T=80#~^^cGG"P"TGpBxb@ZkG0JF]"]c &"&!"="4GTGGG`Bhb@Zkc4G 4G  "4GGGGBb@Zk8@"T]bKU_Ű"GTG@BHb@Zk & ""4GBb@Zk4G0B8b@Zk"4GBb@ZkcTG "GTG@BHb@Zk & ""4GBb@Zk4G0B8b@Zk"4GBb@Zkc"4GBb@Zk4GcG]]#k0#~^^cGG=""1"TGBb@ZkcTG "4GXB`b@ZkWH"T"h"TG8B@ b@ZkcTG "4GxBb@ZkcTG ""TG8B@b@ZkcG]]#k4 0G< DBASIC$INIT44b#` DBASIC$INIT4 8@< DBASIC$INIT4 G DBASIC$OPEN4 b#` DBASIC$OPEN4 @ DBASIC$OPEN4G DBASIC$GET4b#`  DBASIC$GET4@ DBASIC$GET4 ,G8 DBASIC$PRINT4 0b#` DBASIC$PRINT4 4@8 DBASIC$PRINT<TG`DBASIC$OUT_T_DX_S<Xb#`DBASIC$OUT_T_DX_S<\@`DBASIC$OUT_T_DX_S<hGtDBASIC$OUT_L_V_B<lb#`DBASIC$OUT_L_V_B<p@tDBASIC$OUT_L_V_B4|G DBASIC$IO_END4b#` DBASIC$IO_END4@ DBASIC$IO_END4 G DBASIC$PRINT4 b#` DBASIC$PRINT4 @ DBASIC$PRINT<GDBASIC$OUT_T_DX_S<b#`DBASIC$OUT_T_DX_S<@DBASIC$OUT_T_DX_S<GDBASIC$OUT_L_V_B<b#`DBASIC$OUT_L_V_B<@DBASIC$OUT_L_V_B4G DBASIC$IO_END4b#` DBASIC$IO_END4@ DBASIC$IO_END4 G DBASIC$END4b#` DBASIC$ENDP~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;14@ DBASIC$END4 pG| DBASIC$INIT4tb# DBASIC$INIT4 x@| DBASIC$INIT4G DBASIC$ERR4b# DBASIC$ERR4@ DBASIC$ERR<GDBASIC$CONTINUE_TARGET<b#DBASIC$CONTINUE_TARGET<@DBASIC$CONTINUE_TARGET<GDBASIC$EXIT_HNDL<b#DBASIC$EXIT_HNDL<@DBASIC$EXIT_HNDL<GDBASIC$CONTINUE_TARGET< b#DBASIC$CONTINUE_TARGET<@DBASIC$CONTINUE_TARGET =B;= Records read:  ;8OTS$JUMP_TO_BPV;@ DBASIC$IO_END DBASIC$OUT_T_DX_S=0;= 7DBASIC$HANDLER= DBASIC$OUT_L_V_B DBASIC$PRINT; DBASIC$OPEN DBASIC$INIT DBASIC$GET DBASIC$END=@= On record:=08;= 7DBASIC$HANDLER=P DBASIC$CONTINUE_TARGET=0Bp DBASIC$ERR; DBASIC$EXIT_HNDL; =|   $@INT_DEMO_B_READ_BASIC=4= (=: :="sys$scratch:tti_vendor.tmpT T=D<;INT_DEMO_B_READ_BASIC$MAINDEC BASIC V1.0-001\ \=XPJEXE&w1DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_READ_BASIC.BAS;3 = ' = '4`4=( INT_DEMO_B_READ_BASIC$MAIN4=( 8$ $= $4 =91 ٰR ٴI%4= WHOLE_REC$ e4="4=NAME$ Ee4=" 4= SEX$ ue4="4=BDATE$ e4="%4=STREET$ e4=" C4=CITY$ e4="  O4= ZIP$ 7e4="X4=ETHNIC$ fe4="Y4=PARENT$ e4=" q4=PHONE$ e4=" {4=BPHONE$ e4=" 4=EPHONE$ -e4="4=BALANCE$ _e4=  4= DONE| |= 844=_handler84=@$ $= `4: := 4= : := 4= 8 =   `ww01&aÈ0>>PROG5016-DEC-1994 16:15DEC COBOL V2.0-271 i$CODE$$LOCAL$o$LINK$$UNINIT$PDATA$ COB$NAMES_____1 0COB$NAMES_____2 COB$NAMES_____3 COB$NAMES_____4$LOCAL_1DCOB$IMAGE_INIT(JPROG5 DCOB$CALLED DCOB$OPEN DCOB$ACC_DISPLAY DCOB$EDITPC DCOB$SCR_DISPLAY DCOB$CLOSE DCOB$STOP DCOB$READ DCOB$RMS_STS_STV DCOB$RMS_FILENAME(DCOB$CURRENT_RMS_STS_STV(DCOB$RMS_CURRENT_FILENAME OTS$FETCH_U_OPN1_1 OTS$STORE_U_OPN1_1 =#~^^G#Gx@4GXB`b@Zk"8""b""GGGGHBPb@ZkD8D"0""xb""G"GHBPb@Zk" F "1!F BrF4fFrb GBb@Zk "7J"4JBB6J GBb@Zk TGBb@Zk ?"1'J"0JB@B6J TGBb@Zkbs3v`Js"5`"""4G4GGtGGBb@Zk"!0J1'JFb"G"1"G"GBb@Zk" > TG"1"4GGGGtGBb@Zk00 "0J`HF"1kB8bt"""4G4GGGGBb@Zk"!0J1'JFb"G"1"G"GBb@Zk" > TG"1"4GGGGtGBb@Zk8"""GtGhBpb@ZkGhBpb@Zk#~^^G#[ "GTGBb@Zk" ]#~^^G#[ "4GTGBb@Zk" I#~^^G#[ ""1"GtGXB`b@Zk 5#~^^G#[ G4G(B0b@Zk" ##~^^G#`[ 4G4G(B0b@Zk" #~^^G# @[ "GTGxBb@Zk G]] #kFJJF!JJ?48GD DCOB$CALLED4<b# DCOB$CALLED4@@D DCOB$CALLED4lGx DCOB$OPEN4pb# DCOB$OPEN4t@x DCOB$OPEN4G DCOB$READ4b# DCOB$READ4@ DCOB$READ<GOTS$FETCH_U_OPN1_1<b#OTS$FETCH_U_OPN1_1<@OTS$FETCH_U_OPN1_1< HGTOTS$STORE_U_OPN1_1< Lb#OTS$STORE_U_OPN1_1< P@TOTS$STORE_U_OPN1_1<`GlOTS$FETCH_U_OPN1_1<db#OTS$FETCH_U_OPN1_1<h@lOTS$FETCH_U_OPN1_1< GOTS$STORE_U_OPN1_1< b#OTS$STORE_U_OPN1_1< @OTS $STORE_U_OPN1_1<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY4 G, DCOB$EDITPC4$b# DCOB$EDITPC4 (@, DCOB$EDITPC<dGpDCOB$SCR_DISPLAY<hb#DCOB$SCR_DISPLAY<l@p!DCOB$SCR_DISPLAY<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY4 G$ DCOB$EDITPC4b# DCOB$EDITPC4 @$ DCOB$EDITPC<\GhDCOB$SCR_DISPLAY<`b#DCOB$SCR_DISPLAY<d"@hDCOB$SCR_DISPLAY4|G DCOB$CLOSE4b# DCOB$CLOSE4@ DCOB$CLOSE4G DCOB$STOP4b# DCOB$STOP4@ DCOB$STOP< GDCOB$RMS_STS_STVH H< b#DCOB$RMS_STS_STV< @#DCOB$RMS_STS_STV< G$DCOB$RMS_STS_STV< b#DCOB$RMS_STS_STV< @$DCOB$RMS_STS_STV<pG|DCOB$RMS_FILENAME<tb#DCOB$RMS_FILENAME<x@|DCOB$RMS_FILENAMEDGDCOB$CURRENT_RMS_STS_STVDb#DCOB$CURR$ENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVDGDCOB$CURRENT_RMS_STS_STVDb#DCOB$CURRENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVDHGTDCOB$RMS_CURRENT_FILENAMEDLb#DCOB$RMS_CURRENT_FILENAMEDP@TDCOB$RMS_CURRENT_FILENAMET T%=0=000000=00;;0=80;;=PROG5=X;;= =(&SYS$SCRATCH:TTI_VENDOR.TMPj==;X;=== =;x;=4=H= R='X=`;= 0x;=000000;= 00;=;;=g g; DCOB$READ DCOB$RMS_FILENAME DCOB$CLOS(E=HHx;= ` DCOB$SCR_DISPLAY DCOB$RMS_STS_STV= OTS$STORE_U_OPN1_1=  DCOB$EDITPC==0;=  =0;=  =0;=)  =08;=  =0;=  =0;=  =0;=  ; DCOB$ACC_DISPLAY= G OTS$FETCH_U_OPN1_1=(DCOB$CURRENT_RMS_STS_STV=*; DCOB$OPEN DCOB$CALLED DCOB$STOP(DCOB$RMS_CURRENT_FILENAME= On record: `=Records read: | |;;=;=? ?=/'&PROG5DEC COBOL V2.0-271\ \=XPJEU&w1DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_READ_COBOL.COB;3 += C = 44= PROG54=>65* 74-*$ $=  4 = L4=MAINLINEL4=START-UP4= START-UP-EXIT4= 1-READ-FILE4= 1-EXIT4= RETURN-CODE ,4=!RMS-STS4= RMS-STV4=:2 RMS-FILENAME(4= e4=( #RMS-CURRENT-STSH4=( #RMS-CURRENT-STVh4=B:(RMS-CURRENT-FILENAME4= &e4=QI-      1TEST-FILE-RECORD@ NAME pe4= SEX e4= B-DATE e4= (STREET .e4= CITY e4= xZIP e4= ETHNIC e4= PARENT e4=PHONE e4= BPHONE -e4= (EPHONE Be4=!xBALANCE We4=/  pe4= 4=!TEST-FILE-RECORD e4="4= FILE-EOF-SW )e4=& 4= RECORD-CNT _e4=& 4=TMP-CNT e4: := X4=  =  ww011 ш ==FOR5 16-DEC-1994 16:16DEC Fortran V6.1-386X X$LINK$iP$CODE$0$IODATA$$BSS$$DATA$(JpFOR5 DFOR$OPEN DFOR$HANDLER DFOR$WRITE_SEQ_LIS DFOR$WRITE_SEQ_LIS_XMIT DFOR$READ_SEQ_FMT DFOR$READ_SEQ_FMT_XMIT 2 DFOR$READ_SEQ_FMT= On record: = 8    @ DFOR$OPEN DFOR$WRITE_SEQ_LIS= h=8p=0h;= 7 DFOR$HANDLER=; DFOR$READ_SEQ_FMT_XMIT( DFOR$WRITE_SEQ_LIS_XMIT=Records read:3=(sys$scratch:tti_vendor.tmp=8; =XPp#~h^p^x~cGGb"p TG4G4G@8=4GHPX=TG`]"4G_"8"GBb@Zk0b"0"! G@=8"4G_"8"GBb@ZkG""0""! 4G@=8"8]"tG@BHb@ZkG""0"#! G@=8"8]"tG@BHb@ZkG~""0")! G@=8"48]"tG@BHb@ZkGp""0"G! G@=8"8]"tG@BHb@ZkGb""0"S! 4G@=8"8]"tG@BHb@ZkGT""0"\! 4G@=8"8]"tG@BHb@ZkGF""0"]! G@=8"8]"tG@BHb@ZkG8""0"u! TG@=8"8]"tG@BHb@ZkG*""0"! TG@=8"8]"tG@BHb@ZkG""0"! TG@=8"8]"tG@BHb@ZkG""0"! G@=8"8]"tG@BHb@ZkG# ' 00B0"05BR0@B0bS08FE0b""TG@ݶ8"?"_"8"GBb@Zk""08"8]"tGPBXb@Zk,b"` G@8="?"_"8"GBb@Zk""08"8]"tGPBXb@Zk4GcGh]p]x}#k4pG| DFOR$OPEN4tb#p DFOR$OPEN4x@| DFOR$OPEN<GDFOR$READ_SEQ_FMT<b#p6DFOR$READ_SEQ_FMT<@DFOR$READ_SEQ_FMT<GDFOR$READ_SEQ_FMT_XMIT<b#pDFOR$READ_SEQ_FMT_XMIT<@DFOR$READ_SEQ_FMT_XMIT<$G0DFOR$READ_SEQ_FMT_XMIT<(b#pDFOR$READ_SEQ_FMT_XMIT<,@0DFOR$READ_SEQ_FMT_XMIT<\GhDFOR$READ_SEQ_FMT_XMI7T<`b#pDFOR$READ_SEQ_FMT_XMIT<d@hDFOR$READ_SEQ_FMT_XMIT<GDFOR$READ_SEQ_FMT_XMIT<b#pDFOR$READ_SEQ_FMT_XMIT<@DFOR$READ_SEQ_FMT_XMIT<GDFOR$READ_SEQ_FMT_XMIT<b#pDFOR$READ_SEQ_FMT_XMIT<@DFOR$READ_SEQ_FMT_XMIT<G8DFOR$READ_SEQ_FMT_XMIT<b#pDFOR$READ_SEQ_FMT_XMIT< @DFOR$READ_SEQ_FMT_XMIT<<GHDFOR$READ_SEQ_FMT_XMIT<@b#pDFOR$READ_SEQ_FMT_XMIT<D@HDFOR$READ_SEQ_FMT_XMIT<tGDFOR$READ_SEQ_FMT_XMIT<xb#pDFOR$READ_SEQ_FMT_XMIT<|@DFOR$READ_SEQ9_FMT_XMIT<GDFOR$READ_SEQ_FMT_XMIT<b#pDFOR$READ_SEQ_FMT_XMIT<@DFOR$READ_SEQ_FMT_XMIT<GDFOR$READ_SEQ_FMT_XMIT<b#pDFOR$READ_SEQ_FMT_XMIT<@DFOR$READ_SEQ_FMT_XMIT<G(DFOR$READ_SEQ_FMT_XMIT< b#pDFOR$READ_SEQ_FMT_XMIT<$:@(DFOR$READ_SEQ_FMT_XMIT<GDFOR$WRITE_SEQ_LIS<b#pDFOR$WRITE_SEQ_LIS<@DFOR$WRITE_SEQ_LIS< GDFOR$WRITE_SEQ_LIS_XMIT< b#pDFOR$WRITE_SEQ_LIS_XMIT< @DFOR$WRITE_SEQ_LIS_XMIT<GDFOR$WRITE_SEQ_LIS<b#pDFOR$;WRITE_SEQ_LIS<@DFOR$WRITE_SEQ_LIS<  G,DFOR$WRITE_SEQ_LIS_XMIT| |< $b#pDFOR$WRITE_SEQ_LIS_XMIT< (@,DFOR$WRITE_SEQ_LIS_XMITP P=806QQQQQ Q QQQ Q7@ @=0('FOR5DEC Fortran V6.1-386^ ^=ZRLGN3DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_READ_FORTRAN.FOR;<5 = % = 4p4= FOR54=nfe$$ $= (4k k= 4= $BEGIN$ 4=iaR  =   . 1TEST_FILE_RECORD@ NAME 3e4= SEX He4=BDATE ]e4= (STREET re4= CITY e4= xZIP >e4= ETHNIC e4= PARENT e4=PHONE e4= BPHONE e4= (EPHONE e4=!xBALANCE e4=  /e4=  4= REC ^e4=  4=I 4=100 140 4= 200 = P =  pww?@1W߈ TTINT_DEMO_B_REDIM_BASIC$MAIN 16-DEC-1994 16:16DEC BASIC V1.0-001 iX$CODE$0$LINK$ $READ_ONLY$+ $LITERAL$$ARRAY$DESC@J@INT_DEMO_B_REDIM_BASIC$MAINDBASIC$HANDLERDBASIC$HANDLER DBASIC$INIT DBASIC$RT_DIM DBASIC$PRINT ADBASIC$OUT_T_DX_B DBASIC$IO_END DBASIC$RETRY DBASIC$CONTINUE_TARGET DBASIC$ENDOTS$JUMP_TO_BPV =`X#~^^cG#G""TGPBXb@ZkG84JF@"ݲc 0"=}}C"TGBb@ZkC"TGBb@Zk"GTGBb@Zk&+""4GpBxb@Zk"4G`Bhb@Zk0B cG ==0B*T=}lU`ctG ݢ%W&_] C C  OBø=0B12V=cG "4GBb@Zk4GcG]] #k&"0#~^^cGG="P"1"TGBb@ZkcG " T=]R}%W &_S4"TG`Bhb@Zk==1B*T]2}slUB`cG %W&_=C}{=! 0C !C @;OB}s%W&_]] B B NuBwscG ]=Vݦւ]V֨"8W=cG =Xu[WW}]%W&_};="TG`Bhb@Zk==1B*T]2}slUB`cG %W&_=}{=! 0C !CL K@;OB}s%W&_]D] B B< ; NuBwscG ]=Vݦւ]V֨"8W=cG ="4G0B8b@Zkc"@"TGPBXb@ZkcG]]#k&"M&"]&"&"44G@ DBASIC$INIT48b#@ DBASIC$INIT4<@@ DBASIC$INIT4G DBASIC$RT_DIME4b#@ DBASIC$RT_DIM4@ DBASIC$RT_DIM4G DBASIC$RT_DIM4b#@ DBASIC$RT_DIM4@ DBASIC$RT_DIM4 G DBASIC$PRINT4b#@ DBASIC$PRINT4 @ DBASIC$PRINT< G DBASIC$OUT_T_DX_B< b#@FDBASIC$OUT_T_DX_B< @ DBASIC$OUT_T_DX_B4 (G4 DBASIC$IO_END4 ,b#@ DBASIC$IO_END4 0@4 DBASIC$IO_END4G DBASIC$END4b#@ DBASIC$END4@ DBASIC$END4XGd DBASIC$INIT4\b# DBASIC$INITG4`@d DBASIC$INIT4G DBASIC$RT_DIM4b# DBASIC$RT_DIM4@ DBASIC$RT_DIM4dGp DBASIC$RT_DIM4hb# DBASIC$RT_DIM4l@p DBASIC$RT_DIM4G DBASIC$RETRY4b# DBASIC$RETRY4@ DBAHSIC$RETRY<GDBASIC$CONTINUE_TARGET<b#DBASIC$CONTINUE_TARGET<@DBASIC$CONTINUE_TARGET  DBASIC$END=zF;;= B0 DBASIC$RT_DIM=0;=  7DBASIC$HANDLER= @xIx;8OTS$JUMP_TO_BPV DBASIC$INIT DBASIC$IO_END DBASIC$OUT_T_DX_B DBASIC$PRINT=0 ;= 7DBASIC$HANDLER= DBASIC$RETRY@;  DBASIC$CONTINUE_TARGET =| @@``hJ@INT_DEMO_B_REDIM_BASIC=@4=   l=l44= K K=3+Array redimension from 1 to 4000 started...U UK=E=<INT_DEMO_B_REDIM_BASIC$MAINDEC BASIC V1.0-001] ]=YQKFF2DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_REDIM_BASIC.BAS;2 = ! = (4@4=)!INT_DEMO_B_REDIM_BASIC$MAIN4=4,+   @$ $= (4 = ٰZ ٴ CUR_ELEMENTS ٸI ټZ% Z5  INCREMENT  TABLE_SAVE _e4=,$ TABLE e4 =  44=_handler 4=)! ȸȸ8 $ $= H4: := 4= 8: := 4=   =   @ww4D߈ DAN INT_DEMO_B_REDIM_BASIC$MAIN8hꈐ DAN INT_DEMO_B_SCREEN_IO_BASIC$MAIN/r󈐘 DAN INT_DEMO_B_SCREEN_IO_Ci DAN PROG45jvc DAN INT_DEMO_B_SCREEN_IO_FORTRAN5hb DAN INT_DEMO_B_UPDATE_BASIC$MAINlF, DAN PROG64qNQ7 DAN INT_DEMO_B_WRITE_BASIC$MAIN_D DAN PROG31 P DAN INT_DEMO_B_WRITE_FORTRAN~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;1@MN1ZFꈐ XXINT_DEMO_B_SCREEN_IO_BASIC$MAIN 16-DEC-1994 16:16DEC BASIC V1.0-001p pi$CODE$$LINK$ $READ_ONLY$ $LITERAL$$ARRAY$DESC@JINT_DEMO_B_SCREEN_IO_BASIC$MAINDBASIC$HANDLER DBASIC$INIT DBASIC$PRINT DBASIC$OUT_L_V_S DBASIC$ NOIO_END DBASIC$END( (=0#~^^cGG"P"TG@BHb@Zk4G="GTG0B8b@Zk4GBb@Zk"4GpBxb@Zk8@C"=19 B=c"4G`Bhb@Zk4GcG]]#k40G< DBASIC$INIT44b# DBASIC$INIT48@< DBASIC$INIT4TG` DBASIC$PRINT4PXb# DBASIC$PRINT4\@` DBASIC$PRINT< hGtDBASIC$OUT_L_V_S< lb#DBASIC$OUT_L_V_S< p@tDBASIC$OUT_L_V_S4|G DBASIC$IO_END4b# DBASIC$IO_END4@ DBASIC$IO_END4G DBASIC$END4Qb# DBASIC$END4@ DBASIC$END$ $=0;= 7DBASIC$HANDLER= DBASIC$PRINT DBASIC$INIT;` DBASIC$END DBASIC$IO_END DBASIC$OUT_L_V_S =|R@INT_DEMO_B_SCREEN_IO_BASICY Y=IA@INT_DEMO_B_SCREEN_IO_BASIC$MAINDEC BASIC V1.0-001a a=]UOJ5-6DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_BASIC.BAS;1 =  = ,44=-%INT_DEMO_B_SCREEN_IO_BASIC$MAIN4= 8$ $= $4 = ٨I%: := 4=  =  wwT1@󈐘V1.0RRINT_DEMO_B_SCREEN_IO_CV1.016-DEC-1994 16:17DEC C V1.3-000AH H $READONLY$$BSS$$DATA$$LINK$ $LITERAL$iX$CODE$ $ABS$(JMAIN DECC$GPRINTF(J@__MAIN DECC$MAIN DECC$EXITF F TU=%3d =  =0;=@| ;= DECC$GPRINTF=0;=0  DECC$EXIT DECC$MAIN =`X#4G~^ ^(GG#0B  = > 8b@Zkb# @ B4G(bG@ZkG] ](0#kG# ~^^~ (0V޴8GG4G ¤(4G0BG8bGTG@Zk4GH"D! @%L$H D! @A?@A!@!a@ 0B8b@Zk4@ @0`@G]4G]} (0ݤ8@#k4$GH DECC$MAIN4<b#@ DECC$MAIN4D@H DECC$MAIN4PGd DECC$EXIT4Xb#@ DECC$EXIT4`@d DECC$EXIT4WG DECC$GPRINTF4b# DECC$GPRINTF4@ DECC$GPRINTF4 G DECC$GPRINTF4b# DECC$GPRINTF4@ DECC$GPRINTFM M==54INT_DEMO_B_SCREEN_IO_CDEC C V1.3-000A? ?= 4=TRANSFER$BREAK$GO[ [=WOID`30DEVDISK:[INTOUCHX_DEMO]INT_DEMO_B_SCREEN_IO_C.C;1 = = 44= main4=4,+ ,$ $= 4 = i = H H= 4@4=__main~ ~=zr p1 p2 p3 p4 p5 p6 argc  argv envp =  =  @wwZ10>>PROG4016-DEC-1994 16:17DEC COBOL V2.0-271@ @i$CODE$($LOCAL$$LINK$$UNINIT$PDATA$ COB$NAMES_____1 0COB$NAMES_____2 COB$NAMES_____3 COB$NAMES_____4$LOCAL_1DCOB$IMAGE_INIT(JPROG4 DCOB$CALLZ[ED DCOB$STOP DCOB$EDITPC DCOB$SCR_DISPLAY OTS$FETCH_U_OPN0_1 OTS$FETCH_U_OPN1_1 OTS$CMP_LE_DEC_1 OTS$STORE_U_OPN1_1 =#~^^G#G  84GBb@Zk "@ "Q2\J0JPFQ  GBb@ZkG(¦B@ZkG0b t X79 \TG "(1"4GGGGtGxBb@Zk k  GhBpb@Zk ?"1'J"0JB@B6J  GBb@Zk bG]] #kP GBb@ZkF!JJ?4 8GD DCOB$CALLED4 <b# DCOB$CALLED4 @@D DCOB$CALLED< tGOTS$FETCH_U_OPN0_1< xb#OTS$FETCH_U_OPN0_1< ]|@OTS$FETCH_U_OPN0_1< GOTS$CMP_LE_DEC_1< @OTS$CMP_LE_DEC_14G DCOB$EDITPC4b# DCOB$EDITPC4@ DCOB$EDITPC<$G0DCOB$SCR_DISPLAY<(b#DCOB$SCR_DISPLAY<,@0DCOB$SCR_DISPLAY^<HGTOTS$FETCH_U_OPN1_1<Lb#OTS$FETCH_U_OPN1_1<P@TOTS$FETCH_U_OPN1_1<GOTS$STORE_U_OPN1_1<b#OTS$STORE_U_OPN1_1<@OTS$STORE_U_OPN1_14G DCOB$STOP4b# DCOB$STOP4@ DCO_B$STOP =00001;0=PROG48=@;= r= ;`;=== ==`8;= 00001;=;;=   DCOB$SCR_DISPLAY DCOB$EDITPC= 0 DCOB$STOP OTS$STORE_U_OPN1_1 OTS$FETCH_U_OPN0_1 DCOB$CALLED= G8OTS$CMP_LE_DEC_1=0a;=  X;=<;;=00001;=  OTS$FETCH_U_OPN1_1| |0;;=@;=? ?=/'&PROG4DEC COBOL V2.0-271a a=]UOJ={66DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_COBbOL.COB;1 =  = 44= PROG44=)!  $ $=  4 = L4=MAINLINEL4=START-UP4= START-UP-EXIT4= 1-DISPLAY4= 1-EXIT84= RETURN-CODE 4=' 4=WS-CNT Re4: := 4=  =  ww cd1b UUINT_DEMO_B_SCREEN_IO_FORTRAN 16-DEC-1994 16:17DEC Fortran V6.1-386 X$LINK$i$CODE$$IODATA$$BSS$$DATA$@JINT_DEMO_B_SCREEN_IO_FORTRAN DFOR$WRITE_SEQ_FMT DFOR$HANDLER =0@;=` 7e DFOR$HANDLER=;= @ DFOR$WRITE_SEQ_FMT;x x=#~@^H^PcGG4G0"8b"08"?"_"8"PG@BHb@Zk00@0"0"4GcG@]H]P`#k<TG`DFOR$WRITE_SEQ_FMT<Xb#DFOR$WRITE_SEQ_FMT<\@`DFOR$fWRITE_SEQ_FMT8 8= 6+VE7X X=H@?INT_DEMO_B_SCREEN_IO_FORTRANDEC Fortran V6.1-386c c=_WQLss}38DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_FORTRAN.FOR;1 =  = )44=*"INT_DEMO_B_SCREEN_IO_FORTRAN4=# $ $= $4 = 4= $BEGIN$ 04= 100 4=I 200 =  =  wwh1|V UUINT_DEMO_B_UPDATE_BASIC$MAIN 16-DEC-1994 16:18DEC BASIC V1.0-001 i$CODE$$LINK$4 $READ_ONLY$ $LITERAL$$ARRAY$DESC VENDOR_MAP@JINT_DEMO_B_UPDATE_BASIC$MAINDBASIC$HANDLERDBASIC$HANDLER DBASIC$INIT DBASIC$OPENi DBASIC$GET DBASIC$PRINT DBASIC$OUT_T_DX_S DBASIC$OUT_L_V_B DBASIC$IO_END DBASIC$VAL_F DBASIC$NUM1_F DBASIC$RSET DBASIC$UPDATE DBASIC$ERR DBASIC$CONTINUE_TARGET DBASIC$EXIT_HNDL DBASIC$ENDOTS$JUMP_TO_BPV =#~^^cG#G""TGBb@ZkG=<1'J!F$ij=}"}c `¦ݲ'#&!"="4GTG0GGBb@Zkc4G 4G "4GGGGpBxb@Zk8@"T]bKU@Ŵ"GTGBb@Zk & ""4GPBXb@Zk4GBb@Zk"4G@BHb@Zkc4G 0"_&R"]"4GBb@Zk=B*T"?#Bb@Zk0 &""="TGBb@Zk"4GTGBb@ZkcTG "GTGBb@Zk` k&""4GPBXb@Zk4GBb@Zk"4G@BHb@Zkc"4GpBxb@Zk4GcG]]#k0#~^^cGG=""1"TGBb@ZkcTG "4GPBXb@ZkW@"T"`"TG0B8b@ZkcTG "4GpBxb@ZkcTG ""TG0B8b@ZkcG]]#k44G@ DBASIC$INIT48b# DBASIC$INIT4<@l@ DBASIC$INIT4G DBASIC$OPEN4b# DBASIC$OPEN4@ DBASIC$OPEN4G DBASIC$GET4b# DBASIC$GET4@ DBASIC$GET4 4G@ DBASIC$PRINT4 8b# DBASIC$PRINT4 <@@ DBASIC$PRINT<m\GhDBASIC$OUT_T_DX_S<`b#DBASIC$OUT_T_DX_S<d@hDBASIC$OUT_T_DX_S< pG|DBASIC$OUT_L_V_B< tb#DBASIC$OUT_L_V_B< x@|DBASIC$OUT_L_V_B4 G DBASIC$IO_END4b# DBASIC$IO_END4 @ DBASIC$IO_ENDn4G DBASIC$VAL_F4b# DBASIC$VAL_F4@ DBASIC$VAL_F4G DBASIC$NUM1_F4b# DBASIC$NUM1_F4@ DBASIC$NUM1_F4G DBASIC$RSET4b# DBASIC$RSET4@ DBASIC$RSET4(G4 DBAoSIC$UPDATE4,b# DBASIC$UPDATE40@4 DBASIC$UPDATE4 PG\ DBASIC$PRINT4 Tb# DBASIC$PRINT4 X@\ DBASIC$PRINT<xGDBASIC$OUT_T_DX_S<|b#DBASIC$OUT_T_DX_S<@DBASIC$OUT_T_DX_S< GDBASIC$OUT_L_V_Bp< b#DBASIC$OUT_L_V_B< @DBASIC$OUT_L_V_B4 G DBASIC$IO_END4b# DBASIC$IO_END4 @ DBASIC$IO_END4G DBASIC$END4b# DBASIC$END4@ DBASIC$END4G( DBASIC$INIT4 qb#p DBASIC$INIT4$@( DBASIC$INIT4<GH DBASIC$ERR4@b#p DBASIC$ERR4D@H DBASIC$ERR<lGxDBASIC$CONTINUE_TARGET<pb#pDBASIC$CONTINUE_TARGET <t@xDBASIC$CONTINUE_TARGET<GDBASIC$EXIT_HNDL< rb#pDBASIC$EXIT_HNDL<@DBASIC$EXIT_HNDL<GDBASIC$CONTINUE_TARGET<b#pDBASIC$CONTINUE_TARGET<@DBASIC$CONTINUE_TARGET =Records updated: DBASIC$END=HC0 DBASIC$RSET=BHHp; DBAsSIC$INIT=@p DBASIC$OPEN DBASIC$PRINT DBASIC$OUT_L_V_B=0;= 7DBASIC$HANDLER=; DBASIC$IO_END DBASIC$OUT_T_DX_S; DBASIC$GET;8OTS$JUMP_TO_BPV DBASIC$VAL_F DBASIC$NUM1_F= On record:t` DBASIC$UPDATE=0;= 7DBASIC$HANDLER= DBASIC$CONTINUE_TARGET=0B DBASIC$ERR8; DBASIC$EXIT_HNDL8; =|   $@INT_DEMO_B_UPDATE_BASuIC=84= (=: :="sys$scratch:tti_vendor.tmpV V=F>=INT_DEMO_B_UPDATE_BASIC$MAINDEC BASIC V1.0-001^ ^=ZRLG+'w^3DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_UPDATE_BASIC.BAS;3 =v * = )44=*"INT_DEMO_B_UPDATE_BASIC$MAIN4=-%$İ8$ $= (4 =D< ٰZ ٴR ٸI%4= WHOLE_REC$ &e4="4=NAME$ [e4=" w4= SEX$ e4="4=BDATE$ e4="%4=STREET$ e4=" C4=CITY$ e4="  O4= ZIP$ Me4="xX4=ETHNIC$ |e4="Y4=PARENT$ e4=" q4=PHONE$ e4=" {4=BPHONE$ e4=" 4=EPHONE$ Ce4="4=BALANCE$ ue4=  84= DONE| |= 4p4=_handler4=@$ $=  4: := 4= : := 4=  =  wwz1N6,0>>PROG6016-DEC-1994 16:18DEC COBOL V2.0-271 i$CODE$ $LOCAL$$LINK$$UNINIT$PDATA$ COB$NAMES_____1 0COB$NAMES_____2 COB$NAMES_____3 COB$NAMES_____4$LOCAL_1DCOB$IMAGE_INIT(JPROG6 DCOB$CALL{ED DCOB$OPEN DCOB$ACC_DISPLAY DCOB$EDITPC DCOB$SCR_DISPLAY DCOB$CLOSE DCOB$STOP DCOB$READ DCOB$INSPECT DCOB$REWRITE DCOB$RMS_STS_STV DCOB$RMS_FILENAME(DCOB$CURRENT_RMS_STS_STV(DCOB$RMS_CURRENT_FILENAME OTS$FETCH_U_OPN1_1 OTS$STORE_U_OPN1_1OTS$MOVE OTS$MOVEMOTS {|$FILL OTS$FETCH_U_OPN0_1OTS$ADD_DEC8_1 =#~^^GG`p4G`Bhb@Zk"h""b""GtGGGpBxb@ZkD8D@"p0""$b""G"GBb@Zk" F "1!F BrF4fFr GBb@Zk "7J"4JBRB6J GBb@Zk TGBb@Zk ?"1'J"0JBC@B6J TG}Bb@Zkbs3v`Js"6`"" "4G4GGtGGBb@Zk"!0J1'JFb"G"1"G"GBb@Zk# " > TG"(1"4GGGGtGBb@Zk00 "0J`HF4GG4GN<CGGG C G@B"GSB8B@Zk75B"GG4GB@ZkGHB@Zko"GTGG"4GGBb@Zkw GBb@ZkG"Bb@Zkw GBb@Zk""$b""GGG~Bb@Zk"Gpk"0BbpS"""4G4GG4GGBb@Zk"!0J1'JFb"G"1"G"GBb@Zk# " > TG"1"4GGGGtGBb@Zk"""GtGBb@ZkGPBXb@Zk#~^^G[ "GTGBb@Zk" X#~^^G[ "4GTGBb@Zk" E#~^^G[ ""1"GtGPBXb@Zk 2#~^^G[ G4G0B8b@Zk" !#~^^G`[ 4G4G0B8b@Zk" #~^^G @[ "GTG`Bhb@Zk G]] #kFJJF!JJ?4 4G@ DCOB$CALLED4 8b# DCOB$CALLED4 <@@ DCOB$CALLED4hGt DCOB$OPEN4 lb# DCOB$OPEN4p@t DCOB$OPEN4 G DCOB$READ4 b# DCOB$READ4 @ DCOB$READ< GOTS$FETCH_U_OPN1_1<b#OTS$FETCH_U_OPN1_1<@OTS$FETCH_U_OPN1_1<DGPOTS$STORE_U_OPN1_1<Hb#OTS$STORE_U_OPN1_1<L@POTS$STORE_U_OPN1_1<\GhOTS$FETCH_U_OPN1_1<`b#OTS$FETCH_U_OPN1_1<d@hOTS$FETCH_U_OPN1_1<GOTS$STORE_U_OPN1_1<b#OTS$STORE_U_OPN1_1<@OTS$STORE_U_OPN1_1<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY4G( DCOB$EDITPC4 b# DCOB$EDITPC4$@( DCOB$EDITPC<dGpDCOB$SCR_DISPLAY<hb#DCOB$SCR_DISPLAY<l@pDCOB$SCR_DISPLAY4GOTS$MOVE4@OTS$MOVE4%G OTS$MOVEM4%@ OTS$MOVEM4GOTS$FILL4@OTS$FILL4# G, DCOB$INSPECT4$$b# DCOB$INSPECT4#(@, DCOB$INSPECT<8GDOTS$FETCH_U_OPN1_1<<b#OTS$FETCH_U_OPN1_1<@@DOTS$FETCH_U_OPN1_1 4'LGXOTS$ADD_DEC8_14(Pb#OTS$ADD_DEC8_14'T@XOTS$ADD_DEC8_1<dGpOTS$STORE_U_OPN1_1<hb#OTS$STORE_U_OPN1_1<l@pOTS$STORE_U_OPN1_14G DCOB$REWRITE4b# DCOB$REWRITE4@ DCOB$REWRITE<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY40G< DCOB$EDITPC44b# DCOB$EDITPC48@< DCOB$EDITPC<xGDCOB$SCR_DISPLAY<|b#DCOB$SCR_DISPLAY<@DCOB$SCR_DISPLAY4!G DCOB$CLOSE4"b# DCOB$CLOSE4!@ DCOB$CLOSE4G DCOB$STOP4b# DCOB$STOP4@ DCOB$STOP< GDCOB$RMS_STS_STV<b#DCOB$RMS_STS_STV< @DCOB$RMS_STS_STV< ,G8DCOB$RMS_STS_STV<0b#DCOB$RMS_STS_STV< 4@8DCOB$RMS_STS_STV<GDCOB$RMS_FILENAME<b#DCOB$RMS_FILENAME<@DCOB$RMS_FILENAMEDGDCOB$CURRENT_RMS_STS_STVDb#DCOB$CURRENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVDG DCOB$CURRENT_RMS_STS_STVDb#DCOB$CURRENT_RMS_STS_STVD@ DCOB$CURRENT_RMS_STS_STVDLGXDCOB$RMS_CURRENT_FILENAMEDPb#DCOB$RMS_CURRENT_FILENAMEDT@XDCOB$RMS_CURRENT_FILENAME =0=000000=00(;;0=80;= ;=PROG6=;;= (=(SYS$SCRATCH:TTI_VENDOR.TMP==;;==;p;=$=8= B=H;h;=== ==;= 0;=000000;= 00;= ~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;1m;;=  DCOB$REWRITE= On record:   ;8OTS$MOVE=088OTS$FILL DCOB$RMS_FILENAME DCOB$CALLED;p DCOB$READ=  DCOB$RMS_STS_STV DCOB$ACC_DISPLAY=  DCOB$SCR_DISPLAY= G= OTS$FETCH_U_OPN1_1=0;=  =0;=  =0;=  =0L;=  =0;=  =0;=  =0 ;=   ; OTS$STORE_U_OPN1_1= DCOB$EDITPC=(DCOB$CURRENT_RMS_STS_STVt;@ DCOB$STOP(DCOB$RMS_CURRENT_FILENAME DCOB$OPEN! DCOB$CLOSE# DCOB$INSPECT8 OTS$MOVEM=(Records updated: 'OTS$ADD_DEC8_1| |;;=;=? ?=/'&PROG6DEC COBOL V2.0-271^ ^=ZRLGz?'wj3DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_UPDATE_COBOL.COB;3 = H = 44= PROG64=H@?+ 8.+$ $= 4< < = H4=MAINLINEH4=START-UP4= START-UP-EXIT4= 1-READ-FILE4= 1-EXIT4= RETURN-CODE 4=!RMS-STS4= RMS-STV04=:2 RMS-FILENAMEP4= e4=( #RMS-CURRENT-STSp4=( #RMS-CURRENT-STV4=B:(RMS-CURRENT-FILENAME4= 2e4=f^      1TEST-FILE-RECORD@ NAME |e4= SEX e4= B-DATE e4= (STREET e4= CITY e4= xZIP e4= ETHNIC e4= PARENT e4=PHONE $e4= BPHONE 9e4= (EPHONE Ne4=!xBALANCE ce4=&x BALANCE-CHAR |e4=  e4= 4=!TEST-FILE-RECORD e4="4= FILE-EOF-SW le4=& 4= RECORD-CNT e4=& 4=TMP-CNT e4: := \4=  =  ww1AB7 TTINT_DEMO_B_WRITE_BASIC$MAIN 16-DEC-1994 16:19DEC BASIC V1.0-001 i$CODE$$LINK$ $READ_ONLY$h $LITERAL$$ARRAY$DESC INDEX_MAP@JINT_DEMO_B_WRITE_BASIC$MAINDBASIC$HANDLER DBASIC$INIT DBASIC$PRINT DBASIC$OUT_T_DX_B DBASIC$IO_END DBASIC$OPEN STR$COPY_DX STR$CONCAT DBASIC$OUT_T_DX_S DBASIC$OUT_F_V_B DBASIC$NUM1_F DBASIC$RSET DBASIC$PUT DBASIC$CLOSE DBASIC$END OTS$MOVEMOTS$FILL =0#~^^cG#G"X"TGBb@Zk"GTGBb@ZkP &""4GBb@Zk"4GBb@Zk0 & "XBR"^&A"="4G"P"GhBpb@Zk"GTGBb@Zk &""4GBb@Zk"4GBb@Zk&""="TGBb@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@Zk"="]"tG8B@b@ZkH=HB*T= !\`lU`Ũ"GTGBb@Zkh &""4GBb@Zk?#Bb@Zk"4GBb@Zk="?#Bb@ZkP&""="TGXB`b@Zk vH=P"GG?"xB@ZkGB@Zk"4GTGxBb@ZkH"T \bKU_լH,U"4GTGBb@Zkc"4GBb@Zk4GcG]]#k4 4G@ DBASIC$INIT4 8b# DBASIC$INIT4 <@@ DBASIC$INIT4TG` DBASIC$PRINT4Xb# DBASIC$PRINT4\@` DBASIC$PRINT< GDBASIC$OUT_T_DX_B<b#DBASIC$OUT_T_DX_B< @DBASIC$OUT_T_DX_B4G DBASIC$IO_END4b# DBASIC$IO_END4@ DBASIC$IO_END4G DBASIC$OPEN4b# DBASIC$OPEN4@ DBASIC$OPEN4G DBASIC$PRINT4b# DBASIC$PRINT4@ DBASIC$PRINT< (G4DBASIC$OUT_T_DX_B<,b#DBASIC$OUT_T_DX_B< 0@4DBASIC$OUT_T_DX_B4<GH DBASIC$IO_END4@b# DBASIC$IO_END4D@H DBASIC$IO_END4 hGt STR$COPY_DX4 lb# STR$COPY_DX4 p@t STR$COPY_DX4G STR$CONCAT4b# STR$CONCAT4@ STR$CONCAT4G STR$CONCAT4b# STR$CONCAT4@ STR$CONCAT4G STR$CONCAT4b# STR$CONCAT4@ STR$CONCAT4G STR$CONCAT4b# STR$CONCAT4@ STR$CONCAT4G STR$CONCAT4b# STR$CONCAT4@ STR$CONCAT4G STR$CONCAT4b# STR$CONCAT4@ STR$CONCAT4,G8 STR$CONCAT40b# STR$CONCAT44@8 STR$CONCAT4HGT STR$CONCAT4Lb# STR$CONCAT4P@T STR$CONCAT4dGp STR$CONCAT4hb# STR$CONCAT4l@p STR$CONCAT4G DBASIC$PRINT4b# DBASIC$PRINT4@ DBASIC$PRINT <GDBASIC$OUT_T_DX_S<b#DBASIC$OUT_T_DX_S<@DBASIC$OUT_T_DX_S<GDBASIC$OUT_F_V_B<b#DBASIC$OUT_F_V_B<@DBASIC$OUT_F_V_B4G DBASIC$IO_END4b# DBASIC$IO_END4@ DBASIC$IO_END4G DBASIC$NUM1_F4 b# DBASIC$NUM1_F4@ DBASIC$NUM1_F4<GH DBASIC$RSET4@b# DBASIC$RSET4D@H DBASIC$RSET4hGp OTS$MOVEM4l@p OTS$MOVEM4tG|OTS$FILL4x@|OTS$FILL4G DBASIC$PUT4b# DBASIC$PUT4@ DBASIC$PUT4G DBASIC$CLOSE4b# DBASIC$CLOSE4@ DBASIC$CLOSE4G DBASIC$END4b# DBASIC$END4@ DBASIC$END  DBASIC$RSET=Records written:8 OTS$MOVEM0 DBASIC$END8OTS$FILLP STR$COPY_DX DBASIC$INIT DBASIC$OUT_T_DX_B DBASIC$PRINT DBASIC$IO_END;=0;= 7DBASIC$HANDLER= STR$CONCAT=@;;=B DBASIC$OPEN DBASIC$PUT=HD@ DBASIC$CLOSE DBASIC$OUT_T_DX_S DBASIC$OUT_F_V_B DBASIC$NUM1_F =| @INT_DEMO_B_WRITE_BASIC=  = DATA DATA DATA DATA = Populating file...0=@8sys$scratch:int_demo_indexed.tmpCreating Indexed file...U U=E=<INT_DEMO_B_WRITE_BASIC$MAINDEC BASIC V1.0-001] ]=YQKFX$L"2DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_WRITE_BASIC.BAS;2 = $ = (44=)!INT_DEMO_B_WRITE_BASIC$MAIN4=0(' Ԑ8$ $= (45 5=F> ٨R ٬I ڨڨ THE_DATA$ e4=" 4= KEY$ Fe4="4=DATA$ ue4: := 4=  =  ww<1RD0>>PROG3016-DEC-1994 16:19DEC COBOL V2.0-271 i$CODE$ $LOCAL$ $LINK$$UNINIT$PDATA$ COB$NAMES_____1 0COB$NAMES_____2 COB$NAMES_____3 COB$NAMES_____4$LOCAL_1DCOB$IMAGE_INIT(JPROG3 DCOB$CALLED DCOB$ACC_DISPLAY DCOB$OPEN DCOB$CLOSE DCOB$STOP DCOB$EDITPC DCOB$SCR_DISPLAY DCOB$WRITE_INDEXED DCOB$RMS_STS_STV DCOB$RMS_FILENAME(DCOB$CURRENT_RMS_STS_STV(DCOB$RMS_CURRENT_FILENAME OTS$FETCH_U_OPN0_1 OTS$FETCH_U_OPN1_1 OTS$CMP_LE_DEC_1 OTS$CVT_DEC8_1_TO_INT64 OTS$STORE_U_OPN1_1OTS$MOVEOTS$FILL =#~^^ G#G`4GxBb@Zk"0_&R"2F1_&00R"2F0 tGBb@ZkG8¦B@Zk7Xbt tGBb@ZkhB@ZkNhCX.8/G0J3JJpJxJsxJQF0GTF3GX>8?k tGBb@Zk ?"1'J"0JB@B6J tGBb@Zk9pbt"""4G4GGGGBb@Zk""b""G4GGGHBPb@Zk""p"4G4GGTGGBb@Zk &"0D1&00"0D  tGBb@ZkG8¦B@Zk BbS8K4JG"?"GB@Zk tGBb@Zk "7J?#9'KB(B6J tGBb@Zk0J5?&021"F7Br&"tF0&00"tFr"""4G4GG4GGBb@Zk"!0J1 JFb"G"1"tG"GBb@Zk" > TG"1"4GGGGtGBb@Zk"B"TGB@ZkBR"tGB@Zk"G]"B@Zk"BR"?"B@ZkP""b""G"GXB`b@Zk" F"1%F """G^G^BR"^4GTGG4G4GBb@Zkk tGBb@Zk ?"1'J"0JB@B6J tGBb@Zk?bH"""GtGBb@ZkG(B0b@Zk#~^^ G#[ "GTG(B0b@Zk" ]#~^^ G#[ "4GTG(B0b@Zk" I#~^^ G#[ ""1"GtGBb@Zk 5#~^^ G#[ G4GB b@Zk" ##~^^ G#`[ 4G4GB b@Zk" #~^^ G# @[ "GTG8B@b@Zk G]] 0#kF!JJ{?}FJ!KF!JJ^?`4 8GD DCOB$CALLED4<b# DCOB$CALLED4 @@D DCOB$CALLED<|GOTS$FETCH_U_OPN0_1<b#OTS$FETCH_U_OPN0_1<@OTS$FETCH_U_OPN0_1<GOTS$CMP_LE_DEC_1<@OTS$CMP_LE_DEC_1<GOTS$FETCH_U_OPN1_1<b#OTS$FETCH_U_OPN1_1<@OTS$FETCH_U_OPN1_1< GOTS$CVT_DEC8_1_TO_INT64< @OTS$CVT_DEC8_1_TO_INT64<,G8OTS$FETCH_U_OPN1_1<0b#OTS$FETCH_U_OPN1_1<4@8OTS$FETCH_U_OPN1_1<dGpOTS$STORE_U_OPN1_1<hb#OTS$STORE_U_OPN1_1<l@pOTS$STORE_U_OPN1_1<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY4G DCOB$OPEN4 b# DCOB$OPEN4@ DCOB$OPEN<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY<0G<OTS$FETCH_U_OPN0_1<4b#OTS$FETCH_U_OPN0_1<8@<OTS$FETCH_U_OPN0_1<DGLOTS$CMP_LE_DEC_1<H@LOTS$CMP_LE_DEC_14%GOTS$FILL4%@OTS$FILL<GOTS$FETCH_U_OPN1_1\ \ <b#OTS$FETCH_U_OPN1_1<@OTS$FETCH_U_OPN1_1<GOTS$STORE_U_OPN1_1<b#OTS$STORE_U_OPN1_1<@OTS$STORE_U_OPN1_1<<GHDCOB$ACC_DISPLAY<@b#DCOB$ACC_DISPLAY<D@HDCOB$ACC_DISPLAY4G DCOB$EDITPC4b# DCOB$EDITPC4@ DCOB$EDITPC<GDCOB$SCR_DISPLAY<b#DCOB$SCR_DISPLAY<@DCOB$SCR_DISPLAY4GOTS$MOVE4@OTS$MOVE4GOTS$MOVE4@OTS$MOVE4GOTS$MOVE4@OTS$MOVE4,G4OTS$MOVE40@4OTS$MOVE< PG\DCOB$WRITE_INDEXED< Tb#DCOB$WRITE_INDEXED< X@\DCOB$WRITE_INDEXED<GDCOB$ACC_DISPLAY<b#DCOB$ACC_DISPLAY<@DCOB$ACC_DISPLAY<GOTS$FETCH_U_OPN1_1<b#OTS$FETCH_U_OPN1_1<@OTS$FETCH_U_OPN1_1<G$OTS$STORE_U_OPN1_1<b#OTS$STORE_U_OPN1_1< @$OTS$STORE_U_OPN1_14#TG` DCOB$CLOSE4$Xb# DCOB$CLOSE4#\@` DCOB$CLOSE4dGp DCOB$STOP4hb# DCOB$STOP4l@p DCOB$STOP<GDCOB$RMS_STS_STV<b#DCOB$RMS_STS_STV<@DCOB$RMS_STS_STV<GDCOB$RMS_STS_STV<b#DCOB$RMS_STS_STV<@DCOB$RMS_STS_STV<!HGTDCOB$RMS_FILENAME<"Lb#DCOB$RMS_FILENAME<!P@TDCOB$RMS_FILENAMEDGDCOB$CURRENT_RMS_STS_STVDb#DCOB$CURRENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVDGDCOB$CURRENT_RMS_STS_STVDb#DCOB$CURRENT_RMS_STS_STVD@DCOB$CURRENT_RMS_STS_STVD G,DCOB$RMS_CURRENT_FILENAMED$b#DCOB$RMS_CURRENT_FILENAMED(@,DCOB$RMS_CURRENT_FILENAME =000=000=00000( ; H ;;@=80 t;(;;=PROG3=  ;;= ( =80SYS$SCRATCH:INT_DEMO_INDEXED.TMP  = ;  ;= = =  = = ;= 000 ;= 0008 ;= 00000P ;=t;;=(;;=  DCOB$EDITPC DCOB$SCR_DISPLAY= Records written: 88;= DCOB$STOP(DCOB$RMS_CURRENT_FILENAME(;= p DCOB$WRITE_INDEXED8 OTS$CVT_DEC8_1_TO_INT64t; DCOB$CALLED= Creating Indexed file... OTS$FETCH_U_OPN0_18OTS$CMP_LE_DEC_1==  OTS$STORE_U_OPN1_1 OTS$FETCH_U_OPN1_18OTS$MOVE=0;=0 =0p;=0 =0;=0 =0;=0 =0`;=0 =0;=0 =0;=0  ;= DCOB$ACC_DISPLAY=0(DCOB$CURRENT_RMS_STS_STV DCOB$RMS_STS_STV=` DCOB$OPEN ;;=(DATA Populating file...=(INVALID FILE WRITE KEY: = !DCOB$RMS_FILENAME# DCOB$CLOSE=008OTS$FILL= = G| |;;= ;=? ?=/'&PROG3DEC COBOL V2.0-271] ]=YQKF@"$Lx2DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_WRITE_COBOL.COB;2 = K = 44= PROG34=_WV$  &'̰E ++$ $=  4 = L4=MAINLINEL4=START-UP4= START-UP-EXIT4= 1-LOAD-TABLE\4= 1-EXIT\4= 2-WRITE-FILE(4= 2-EXIT4= RETURN-CODE 4=!RMS-STS84= RMS-STVX4=:2 RMS-FILENAMEx4= e4=( #RMS-CURRENT-STS4=( #RMS-CURRENT-STV4=B:(RMS-CURRENT-FILENAME4= oe4=iaTEST-FILE-RECORDhKEY-FLD e4="(DATA-FLD e4= 4=!TEST-FILE-RECORD e4=& 4=WS-CNT fe4=& 4=WS-CNT-1 e4=qi : e4=7/WS-NAMEhWS-KEY-1 e4=!(WS-DATA e4= 4=WS-NAME ;e4: := 04=  =  ww1P QQINT_DEMO_B_WRITE_FORTRAN 16-DEC-1994 16:19DEC Fortran V6.1-386 $LINK$i$CODE$ $IODATA$$BSS$$DATA$@JINT_DEMO_B_WRITE_FORTRAN DFOR$OPEN DFOR$HANDLER DFOR$CLOSEDFOR$WRITE_SEQ DFOR$WRITE_INT_FMT DFOR$WRITE_SEQ_LIS DFOR$WRITE_SEQ_LIS_XMIT OTS$MOVEMOTS$FILL =8 =8= DFOR$WRITE_SEQ DFOR$WRITE_INT_FMT=0!sys$scratch:int_demo_indexed.tmph=(Creating Indexed file...=DATA = Populating file...  DFOR$WRITE_SEQ_LIS=0;= 7 DFOR$HANDLER=;=88 OTS$MOVEM=8,8         @ DFOR$OPEN8OTS$FILL; DFOR$CLOSE= Records written:= (DFOR$WRITE_SEQ_LIS_XMIT\ \ = #~^^cGG8b" G`X="?"_"X"GBb@Zk4G@GH=GP4G8=Hb""G4GxpTGtG=G]4G}TG}#}ݶ8"ݶTGݶ"4G_"p"GBb@Zk8b" TG`X="?"_"X"GBb@Zk4G0"00"151 B0BB0 "GBGB"G@B@ZkGB@Zk0B00"99#?4G0"0¦֢0B0ղ08F0"Hb"B"G`]X"?"_"X"GBb@Zk""0X"X]"tGBb@Zk@B"0 G`X=0"h="?"X}"GpBxb@Zk8b"0 `? X="4G_"X"G`Bhb@Zk00@0"07"Pb""4G_"GGBb@Zk4GcG]]#k<LGXDFOR$WRITE_SEQ_LIS<Pb#DFOR$WRITE_SEQ_LIS<T@XDFOR$WRITE_SEQ_LIS4 G DFOR$OPEN4 b# DFOR$OPEN4 @ DFOR$OPEN<G(DFOR$WRITE_SEQ_LIS< b#DFOR$WRITE_SEQ_LIS<$@(DFOR$WRITE_SEQ_LIS4lGt OTS$MOVEM4p@t OTS$MOVEM4 xGOTS$FILL4 |@OTS$FILL<GDFOR$WRITE_SEQ_LIS<b#DFOR$WRITE_SEQ_LIS< @DFOR$WRITE_SEQ_LIS<(G4DFOR$WRITE_SEQ_LIS_XMIT<,b#DFOR$WRITE_SEQ_LIS_XMIT<0@4DFOR$WRITE_SEQ_LIS_XMIT<hGtDFOR$WRITE_INT_FMT<lb#DFOR$WRITE_INT_FMT<p@tDFOR$WRITE_INT_FMT4GDFOR$WRITE_SEQ4b#DFOR$WRITE_SEQ4@DFOR$WRITE_SEQ4 G DFOR$CLOSE4b# DFOR$CLOSE4 @ DFOR$CLOSE, ,= 6V7T T=D<;INT_DEMO_B_WRITE_FORTRANDEC Fortran V6.1-386_ _=[SM ~DEMO.BCK6CL+ [INTOUCH_DEMO]INT_DEMO_AXP.OLB;13H̹$L4DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_WRITE_FORTRAN.FOR;3 =  = %44=&INT_DEMO_B_WRITE_FORTRAN4=JBA  L8  $ $= $4G G= 4= $BEGIN$ 4=R. TEST_FILE_RECORD8' KEY 8e4= (DATA Me4= h be4=  4= REC e4=  44= 100 4=I 4=140 120 =  =  ww%*[INTOUCH_DEMO]INT_DEMO_BASELINE.COM;4+,3./@ 4H-L+0123 KPWO56' Ba7 h8B`9GHJ7$! int_demo_baseline.com - INTOUCH Demonstration System$!H$! command procedure to run a series of baseline programs capturing the D$! process accounting information before and after each program runs$!$$ envi = f$trnlnm("vms_environment")$ if envi .eqs. "AXP"$ then$ exe_type = ".EXE_AXP"$ else$ exe_type = ".EXE"$ endif$!>$ open/write results sys$scratch:int_demo_baseline_results.tmp$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")B$ $tti_run:intouch tti_int_demo:int_demo_b_baseline_intouch/source$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)E$ write results "INTOUCH,NON,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")E$ $tti_run:intouch tti_int_demo:int_demo_b_io_baseline_intouch/source$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)D$ write results "INTOUCH,IO,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")6$ run tti_int_demo:int_demo_b_baseline_basic'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)C$ write results "BASIC,NON,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")9$ run tti_int_demo:int_demo_b_io_baseline_basic'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)B$ write results "BASIC,IO,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")8$ run tti_int_demo:int_demo_b_baseline_fortran'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)E$ write results "FORTRAN,NON,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim");$ run tti_int_demo:int_demo_b_io_baseline_fortran'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)D$ write results "FORTRAN,IO,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")6$ run tti_int_demo:int_demo_b_baseline_cobol'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)C$ write results "COBOL,NON,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")9$ run tti_int_demo:int_demo_b_io_baseline_cobol'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)B$ write results "COBOL,IO,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")2$ run tti_int_demo:int_demo_b_baseline_c'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)?$ write results "C,NON,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")5$ run tti_int_demo:int_demo_b_io_baseline_c'exe_type'$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)>$ write results "C,IO,Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ close results$ exit&*[INTOUCH_DEMO]INT_DEMO_BENCHMARK.COM;4+,( 2./@ 4P-L+0123 KPWO56Ba7gh8iR`9GHJ8$! int_demo_benchmark.com - INTOUCH Demonstration System$!P$! command procedure to run a benchmark program capturing the process accounting0$! information before and after the program runs$! $! Expects:'$! p1 = benchmark procedure to run$! p2 = language$!$$ envi = f$trnlnm("vms_environment")$ if envi .eqs. "AXP"$ then$ exe_type = ".EXE_AXP"$ else$ exe_type = ".EXE"$ endif$!$ b1 = f$getjpi("", "bufio")$ d1 = f$getjpi("", "dirio")$ t1 = f$time()$ c1 = f$getjpi("", "cputim")*$ if p2 .eqs. "INTOUCH" then goto intouch$ run 'p1''exe_type' $ goto done $ intouch:$ $tti_run:intouch 'p1'/source$ done:$ c2 = f$getjpi("", "cputim")$ t2 = f$time()$ b2 = f$getjpi("", "bufio")$ d2 = f$getjpi("", "dirio") $ b = b2 - b1 $ d = d2 - d1 $ c = c2 - c1"$ h1 = f$cvtime(t1,,"hour") * 3600"$ m1 = f$cvtime(t1,,"minute") * 60$ s1 = f$cvtime(t1,,"second")"$ h2 = f$cvtime(t2,,"hour") * 3600"$ m2 = f$cvtime(t2,,"minute") * 60$ s2 = f$cvtime(t2,,"second")%$ e = (h2 + m2 + s2) - (h1 + m1 + s1)@$ open/write results sys$scratch:int_demo_benchmark_results.tmp 9$ write results "Bio=''b',DIO=''d',CPU=''c',ELAPSED=''e'"$ close results$ exit-*[INTOUCH_DEMO]INT_DEMO_B_BASELINE_BASIC.BAS;1+,S+./@ 4J-L+0123KPWO56`C4-7z)h8_`9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Program: BASIC_BASELINE.BAS/ ! System : INTOUCH DEMONSTRATION System% ! Author : Daniel James Swain ! Date : 4-JAN-1991J ! Purpose: Establish baseline buffered i/os, direct i/os, cpu time= ! for just starting up and stopping an imageJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end'*[INTOUCH_DEMO]INT_DEMO_B_BASELINE_C.C;1+,V+./@ 4-L+0123KPWO56VR37Uh8'R`9GHJmain (){}-*[INTOUCH_DEMO]INT_DEMO_B_BASELINE_COBOL.COB;1+,Y+./@ 4-L+0123KPWO56`]37Zh8뿿`9GHJIDENTIFICATION DIVISION.PROGRAM-ID. prog1.** Starts a program image*PROCEDURE DIVISION.MAINLINE SECTION. START-UP. STOP RUN.START-UP-EXIT. EXIT./*[INTOUCH_DEMO]INT_DEMO_B_BASELINE_FORTRAN.FOR;1+,]+./@ 4K-L+0123KPWO56xX#7uh8m`a9GHJKC !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%(C ! Program: INTOUCH_BASELINE.INT0C ! System : INTOUCH DEMONSTRATION System&C ! Author : Daniel James SwainC ! Date : 4-JAN-1991KC ! Purpose: Establish baseline buffered i/os, direct i/os, cpu time>C ! for just starting up and stopping an imageKC !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1 end/*[INTOUCH_DEMO]INT_DEMO_B_BASELINE_INTOUCH.INT;1+,_+./@ 4J-L+0123KPWO56X#7>h8\a9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ! Program: INTOUCH_BASELINE.INT/ ! System : INTOUCH DEMONSTRATION System% ! Author : Daniel James Swain ! Date : 4-JAN-1991J ! Purpose: Establish baseline buffered i/os, direct i/os, cpu time= ! for just starting up and stopping an imageJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end0*[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_BASIC.BAS;3+,V ./@ 4Lx-L+0123 KPWO56rX&w7pX&w8-"a9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%3 ! Program: INT_DEMO_B_IO_BASELINE_BASIC.BAS/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 11-JAN-1991L ! Purpose: Establish performance baseline for opening/closing a fileJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 map (vendor_map) string whole_rec$ = 2007 map (vendor_map) string name$ = 30, sex$ = 1, &A bdate$ = 6, street$ = 30, city$ = 12, zip$ = 9, &G ethnic$ = 1, parent$ = 24, phone$ = 10, bphone$ = 10, &* ephone$ = 10, balance$ = 8A open 'sys$scratch:tti_vendor.tmp' for input as file #1, &K access read, allow modify, map vendor_map, sequential fixed close #1 end**[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_C.C;3+,_Q./@ 45p-L+0123 KPWO56/r&w7:r&w8Sa9GHJ#include stdiomain (){FILE *file_ptr;5file_ptr = fopen ("sys$scratch:tti_vendor.tmp", "r");}0*[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_COBOL.COB;3+,./@ 46-L+0123 KPWO56̄&w7P&w8S3a9GHJIDENTIFICATION DIVISION.PROGRAM-ID. prog2.** opens and closes a file*ENVIRONMENT DIVISION.INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TEST-FILE6 ASSIGN TO "SYS$SCRATCH:TTI_VENDOR.TMP"+ ORGANIZATION IS SEQUENTIAL.DATA DIVISION. FILE SECTION.FD TEST-FILE.01 TEST-FILE-RECORD. 05 NAME PIC X(30). 05 SEX PIC X. 05 B-DATE PIC X(6). 05 STREET PIC X(30). 05 CITY PIC X(12). 05 ZIP PIC X(9). 05 ETHNIC PIC X. 05 PARENT PIC X(24). 05 PHONE PIC X(10). 05 BPHONE PIC X(10). 05 EPHONE PIC X(10). 05 BALANCE PIC 9(8). 05 FILLER PIC X(49).PROCEDURE DIVISION.MAINLINE SECTION. START-UP.# OPEN INPUT TEST-FILE ALLOWING ALL. CLOSE TEST-FILE. STOP RUN.START-UP-EXIT. EXIT.2*[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_FORTRAN.FOR;3+, ./@ 4D-L+0123 KPWO56&w7&&w8DFa9GHJ program for2D! Purpose: Establish performance baseline for opening/closing a fileB open (unit=1,file='sys$scratch:tti_vendor.tmp',status='old') close (unit=1) end2*[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_INTOUCH.INT;3+,./@ 4J-L+0123 KPWO56&w7Э4&w8qa9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! Program: INT_DEMO_B_IO_BASELINE.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 11-JAN-1991I ! Purpose: Establish performance baseline for opening and closing# ! a data structureJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%8 open structure vendor : name 'tti_run:vendor', &/ datafile "sys$scratch:tti_vendor.tmp" extract structure vendor i = i + 1' if i > 1 then cancel extract end extract close all end)*[INTOUCH_DEMO]INT_DEMO_B_READ_BASIC.BAS;3+, ./@ 4K-L+0123 KPWO56XE&w70`&w8yja9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%) ! Program: BASIC_INDEXED_READ.BAS/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 7-JAN-19911 ! Purpose: Show how to read indexed filesJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 map (vendor_map) string whole_rec$ = 2007 map (vendor_map) string name$ = 30, sex$ = 1, &A bdate$ = 6, street$ = 30, city$ = 12, zip$ = 9, &G ethnic$ = 1, parent$ = 24, phone$ = 10, bphone$ = 10, &* ephone$ = 10, balance$ = 8A open 'sys$scratch:tti_vendor.tmp' for input as file #1, &K access read, allow modify, map vendor_map, sequential fixed when error in while -1% get #1 i% = i% + 1% r = r + 1 if r = 25 then r = 0$ print 'On record:'; i% end if next use if err = 11 then continue done else exit handler end if end when! done: print 'Records read:'; i% end)*[INTOUCH_DEMO]INT_DEMO_B_READ_COBOL.COB;3+,./@ 46-L+0123 KPWO56U&w70ͤ&w88db9GHJIDENTIFICATION DIVISION.PROGRAM-ID. prog5.** Reads a sequential file*ENVIRONMENT DIVISION.INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TEST-FILE6 ASSIGN TO "SYS$SCRATCH:TTI_VENDOR.TMP"+ ORGANIZATION IS SEQUENTIAL.DATA DIVISION. FILE SECTION.FD TEST-FILE.01 TEST-FILE-RECORD. 05 NAME PIC X(30). 05 SEX PIC X. 05 B-DATE PIC X(6). 05 STREET PIC X(30). 05 CITY PIC X(12). 05 ZIP PIC X(9). 05 ETHNIC PIC X. 05 PARENT PIC X(24). 05 PHONE PIC X(10). 05 BPHONE PIC X(10). 05 EPHONE PIC X(10). 05 BALANCE PIC 9(8). 05 FILLER PIC X(49).WORKING-STORAGE SECTION.'01 FILE-EOF-SW PIC X VALUE '0'.' 88 FILE-EOF VALUE '1'.%01 RECORD-CNT PIC 9(6) VALUE 0.!01 TMP-CNT PIC 99 VALUE 0.PROCEDURE DIVISION.MAINLINE SECTION. START-UP.# OPEN INPUT TEST-FILE ALLOWING ALL.0 PERFORM 1-READ-FILE THRU 1-EXIT UNTIL FILE-EOF.6 DISPLAY "Records read: " RECORD-CNT WITH CONVERSION. CLOSE TEST-FILE. STOP RUN.START-UP-EXIT. EXIT. 1-READ-FILE. READ TEST-FILE AT END SET FILE-EOF TO TRUE GO TO 1-EXIT. ADD 1 TO RECORD-CNT. ADD 1 TO TMP-CNT. IF TMP-CNT = 25 THEN 3 DISPLAY "On record: " RECORD-CNT WITH CONVERSION MOVE 0 TO TMP-CNT END-IF.1-EXIT. EXIT.+*[INTOUCH_DEMO]INT_DEMO_B_READ_FORTRAN.FOR;5+,iB./@ 4BN-L+0123KPWO5678*^b9GHJ program for55!5. A program to read records from a sequential file: integer r" structure /test_file_record/ character name*30 character sex*1 character bdate*6 character street*30 character city*12 character zip*9 character ethnic*1 character parent*24 character phone*10 character bphone*10 character ephone*10 character balance*8 byte %fill(49) end structure# record /test_file_record/ recB open (unit=1,file='sys$scratch:tti_vendor.tmp',status='old', & readonly,shared) i=0 100 continue? read (unit=1,fmt=140,end=200) rec.name,rec.sex,rec.bdate,; & rec.street,rec.city,rec.zip,rec.ethnic,rec.parent,4 & rec.phone,rec.bphone,rec.ephone,rec.balance2 140 format (a30,a1,a6,a30,a12,a9,a1,a24,3a10,a8) i=i+1 r=r+1 if (r.eq.25) then r=0 print *,'On record:',i end if go to 100 200 print *,'Records read:',i end+*[INTOUCH_DEMO]INT_DEMO_B_READ_INTOUCH.INT;3+,./@ 4J -L+0123 KPWO56'w7pS'w8kxlb9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! Program: INTOUCH_INDEXED_READ.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 7-JAN-19913 ! Purpose: Show how to read data structuresJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% declare integer i, r8 open structure vendor : name 'tti_run:vendor', &/ datafile "sys$scratch:tti_vendor.tmp" extract structure vendor i = i + 1 r = r + 1 if r = 25 then r = 0! print "On record:"; i end if end extract) print 'Records read:'; _extracted end**[INTOUCH_DEMO]INT_DEMO_B_REDIM_BASIC.BAS;2+,w+./@ 4J-L+0123KPWO56F7v-h8 }b9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" ! Program: BASIC_REDIM.BAS/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 4-JAN-1991A ! Purpose: To illustrate redimensioning arrays with BASICJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% increment = 10 z5 = 1% dim table(z%) dim table_save(z%); print 'Array redimension from 1 to 4000 started...' for i = 1 to 4000 when error in table(i) = i use cur_elements = i - 1( dim table_save(cur_elements)% for z = 1 to cur_elements& table_save(z) = table(z) next z( z = cur_elements + increment dim table(z)% for z = 1 to cur_elements& table(z) = table_save(z) next z retry end when next i end,*[INTOUCH_DEMO]INT_DEMO_B_REDIM_INTOUCH.INT;5+,z+./@ 4J-L+0123KPWO569F7:0Xh8`8b9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$ ! Program: INTOUCH_REDIM.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 4-JAN-1991C ! Purpose: To illustrate redimensioning arrays with INTOUCHJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dim table(1) increment = 10; print 'Array redimension from 1 to 4000 started...' for i = 1 to 4000< if i > size(table) then redim table(i + increment) table(i) = i next i end.*[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_BASIC.BAS;1+,{+./@ 4J-L+0123KPWO565-7jh8b9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program: BASIC_SCREEN_IO.BAS ! System : INT_DEMO% ! Author : Daniel James Swain ! Date : 3-JAN-1991I ! Purpose: To benchmark screen I/O operations. This program will2 ! print to the screen 1000 times.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% for i% = 1% to 1000% print i%; next i% end(*[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_C.C;1+,~+./@ 4-L+0123KPWO56`37ڿh8ob9GHJmain (){ int i;for (i = 1; i <= 1000; i++) { printf ("%3d ", i); if ((i % 20) == 0) printf("\n"); }}@ ~DEMO.BCK+L+.[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_COBOL.COB;13.*[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_COBOL.COB;1+,+./@ 43-L+0123KPWO56={67h8c9GHJIDENTIFICATION DIVISION.PROGRAM-ID. prog4.*3* displays numbers across a line up to 1000 numbers*ENVIRONMENT DIVISION.DATA DIVISION.WORKING-STORAGE SECTION.301 WS-CNT PIC 9(5) VALUE 1.PROCEDURE DIVISION.MAINLINE SECTION. START-UP.- PERFORM 1-DISPLAY VARYING WS-CNT FROM 1 BY 1 UNTIL WS-CNT > 1000. STOP RUN.START-UP-EXIT. EXIT. 1-DISPLAY.  . DISPLAY WS-CNT with conversion no advancing.1-EXIT. EXIT.0*[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_FORTRAN.FOR;1+,+./@ 49-L+0123KPWO56ss}37= h8Sc9GHJ* program int_demo_b_screen_io_fortran9!4. A program to print numbers to the screen, in a loop. 7! Print as many numbers as possible on a single line: ! EX: 1 2 3 4 5 6 7 8 9 10 ... do 100 i=1,1000 100 print 200,i 200 format ('+',i5,$) end0*[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_INTOUCH.INT;1+,+./@ 4J-L+0123KPWO560Uy=7 h8X_c9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( ! Program: INTOUCH_SCREEN_IO.INT ! System : INT_DEMO% ! Author : Daniel James Swain ! Date : 3-JAN-1991I ! Purpose: To benchmark screen I/O operations. This program will2 ! print to the screen 1000 times.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% declare integer i for i = 1 to 1000 print i; next i end+*[INTOUCH_DEMO]INT_DEMO_B_UPDATE_BASIC.BAS;3+, ./@ 4M^-L+0123 KPWO56+'w7Ж,'w8mc9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%. ! Program: INT_DEMO_B_UPDATE_BASIC.BAS/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 10-JAN-19913 ! Purpose: Illustrate updating data recordsJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 map (vendor_map) string whole_rec$ = 2007 map (vendor_map) string name$ = 30, sex$ = 1, &A bdate$ = 6, street$ = 30, city$ = 12, zip$ = 9, &G ethnic$ = 1, parent$ = 24, phone$ = 10, bphone$ = 10, &* ephone$ = 10, balance$ = 8A open 'sys$scratch:tti_vendor.tmp' for input as file #1, &M access modify, allow modify, map vendor_map, sequential fixed when error in while -1% get #1 i% = i% + 1% r = r + 1 if r = 25 then r = 0$ print 'On record:'; i% end if z = val(balance$)) rset balance$ = num1$(z + 50) update #1 next use if err = 11 then continue done else exit handler end if end when$ done: print 'Records updated:'; i% end+*[INTOUCH_DEMO]INT_DEMO_B_UPDATE_COBOL.COB;3+, ./@ 48j-L+0123 KPWO56z?'w7x?'w8Ŗc9GHJIDENTIFICATION DIVISION.PROGRAM-ID. prog6.** Updates a sequential file*ENVIRONMENT DIVISION.INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TEST-FILE6 ASSIGN TO "SYS$SCRATCH:TTI_VENDOR.TMP"+ ORGANIZATION IS SEQUENTIAL.DATA DIVISION. FILE SECTION.FD TEST-FILE.01 TEST-FILE-RECORD. 05 NAME PIC X(30). 05 SEX PIC X. 05 B-DATE PIC X(6). 05 STREET PIC X(30). 05 CITY PIC X(12). 05 ZIP PIC X(9). 05 ETHNIC PIC X. 05 PARENT PIC X(24). 05 PHONE PIC X(10). 05 BPHONE PIC X(10). 05 EPHONE PIC X(10). 05 BALANCE PIC 9(6)v99./ 05 BALANCE-CHAR REDEFINES BALANCE PIC X(8). 05 FILLER PIC X(49).WORKING-STORAGE SECTION.'01 FILE-EOF-SW PIC X VALUE '0'.' 88 FILE-EOF VALUE '1'.%01 RECORD-CNT PIC 9(6) VALUE 0.%01 TMP-CNT PIC 99 VALUE 0.PROCEDURE DIVISION.MAINLINE SECTION. START-UP.! OPEN I-O TEST-FILE ALLOWING ALL.0 PERFORM 1-READ-FILE THRU 1-EXIT UNTIL FILE-EOF.8 DISPLAY "Records updated: " RECORD-CNT WITH CONVERSION. CLOSE TEST-FILE. STOP RUN.START-UP-EXIT. EXIT. 1-READ-FILE. READ TEST-FILE AT END SET FILE-EOF TO TRUE GO TO 1-EXIT. ADD 1 TO RECORD-CNT. ADD 1 TO TMP-CNT. IF TMP-CNT = 25 THEN 3 DISPLAY "On record: " RECORD-CNT WITH CONVERSION MOVE 0 TO TMP-CNT END-IF.3 INSPECT BALANCE-CHAR REPLACING ALL SPACE BY ZERO.  ADD 50 TO BALANCE. REWRITE TEST-FILE-RECORD.1-EXIT. EXIT.-*[INTOUCH_DEMO]INT_DEMO_B_UPDATE_INTOUCH.INT;3+, ./@ 4Jn-L+0123 KPWO56P _'w7-_'w8tc9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 ! Program: INT_DEMO_B_UPDATE_INTOUCH.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 10-JAN-19913 ! Purpose: Illustrate updating data recordsJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% declare integer i, r: open structure customer : name 'tti_run:vendor', &= datafile "sys$scratch:tti_vendor.tmp", access outin" extract structure customer i = i + 1 r = r + 1 if r = 25 then r = 0! print "On record:"; i end if4 customer(balance) = customer(balance) + 50 end extract, print 'Records updated:'; _extracted close all end**[INTOUCH_DEMO]INT_DEMO_B_WRITE_BASIC.BAS;2+,+./@ 4M"-L+0123KPWO56X$L7h8c9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program: BASIC_SCREEN_IO.BAS ! System : INT_DEMO% ! Author : Daniel James Swain ! Date : 3-JAN-1991G ! Purpose: To benchmark adding 200 records to an indexed file. J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%* map (index_map) string key$ = 4, &. data$ = 1000, &* fill$ = 251( print 'Creating Indexed file...'H open 'sys$scratch:int_demo_indexed.tmp' for output as file #1, &< access write, allow modify, map index_map, &/ indexed fixed, primary key key$" print 'Populating file...'* the_data$ = 'DATA DATA DATA DATA 'M the_data$ = the_data$ + the_data$ + the_data$ + the_data$ + the_data$M the_data$ = the_data$ + the_data$ + the_data$ + the_data$ + the_data$) the_data$ = the_data$ + the_data$ for i = 1 to 200 r = r + 1 if r = 25 then r = 0' print 'Records written:'; i end if rset key$ = num1$(i) lset data$ = the_data$ put #1 next i close #1 end**[INTOUCH_DEMO]INT_DEMO_B_WRITE_COBOL.COB;2+,+./@ 4<x-L+0123KPWO56@"$L7h89d9GHJIDENTIFICATION DIVISION.PROGRAM-ID. PROG3.*%* WRITES 200 RECORDS TO AN ISAM FILE*ENVIRONMENT DIVISION.INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TEST-FILE< ASSIGN TO "SYS$SCRATCH:INT_DEMO_INDEXED.TMP"' ORGANIZATION IS INDEXED RECORD KEY IS KEY-FLD ACCESS IS DYNAMIC.DATA DIVISION. FILE SECTION.FD TEST-FILE.01 TEST-FILE-RECORD. 05 KEY-FLD PIC X(5).# 05 DATA-FLD PIC X(1000).WORKING-STORAGE SECTION.301 WS-CNT PIC 999 VALUE 0.301 WS-CNT-1 PIC 999 VALUE 0. 01 WS-NAME.3 05 WS-KEY-1 PIC 9(5) VALUE 0.; 05 WS_DATA OCCURS 200 TIMES PIC X(5).PROCEDURE DIVISION.MAINLINE SECTION. START-UP.8 PERFORM 1-LOAD-TABLE VARYING WS-CNT FROM 1 BY 1  UNTIL WS-CNT > 200.$ DISPLAY "Creating Indexed file...".$ OPEN OUTPUT TEST-FILE ALLOWING ALL. DISPLAY "Populating file...".0 PERFORM 2-WRITE-FILE VARYING WS-CNT FROM 1 BY 1 UNTIL WS-CNT > 200. CLOSE TEST-FILE. STOP RUN.START-UP-EXIT. EXIT. 1-LOAD-TABLE.' MOVE 'DATA' TO WS-DATA(WS-CNT).1-EXIT. EXIT. 2-WRITE-FILE.   INITIALIZE TEST-FILE-RECORD. ADD 1 TO WS-CNT-1. IF WS-CNT-1 = 25 THEN MOVE 0 TO WS-CNT-1< DISPLAY "Records written: " WS-CNT WITH CONVERSION END-IF. MOVE WS-CNT TO WS-KEY-1." MOVE WS-NAME TO TEST-FILE-RECORD. WRITE TEST-FILE-RECORD< INVALID KEY DISPLAY "INVALID FILE WRITE KEY: " WS-KEY-1.2-EXIT. EXIT.,*[INTOUCH_DEMO]INT_DEMO_B_WRITE_FORTRAN.FOR;3+,+./@ 4@-L+0123KPWO56̹$L7ah8.Sd9GHJ& program int_demo_b_write_fortran?! Purpose: To benchmark adding 200 records to an indexed file.  integer r" structure /test_file_record/ character key*5 character data*1000 byte %fill(250) end structure# record /test_file_record/ rec( print *,'Creating Indexed file...'; open (unit=1,file='sys$scratch:int_demo_indexed.tmp',< & status='new',organization='indexed',access='keyed',@ & recordtype='fixed',form='unformatted',recl=1255,shared, & key=(1:5:character))7 print *,'Populating file...'  do 100 i=1,1000,5 100 rec.data(i:i+4)='DATA ' do 140 i=1,200 r=r+1 if (r.eq.25) then r=0) print *,'Records written:', i end if" write (rec.key,fmt=120) i 120 format (i5)  write (unit=1) rec 140 continue close (unit=1) end,*[INTOUCH_DEMO]INT_DEMO_B_WRITE_INTOUCH.INT;3+,+./@ 4J$-L+0123KPWO56`$L7Z h8`d9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( ! Program: INTOUCH_SCREEN_IO.INT ! System : INT_DEMO% ! Author : Daniel James Swain ! Date : 3-JAN-1991G ! Purpose: To benchmark adding 200 records to an indexed file. J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% declare integer i, r( print 'Creating Indexed file...'< pass 'create/fdl=tti_int_demo:int_demo_indexed ' + &2 'sys$scratch:int_demo_indexed.tmp'" print 'Populating file...'F open structure index : name 'tti_int_demo:int_demo_indexed', & access outin% data$ = repeat$('data ', 200) for i = 1 to 200 r = r + 1 if r = 25 then r = 0& print "Record written:"; i end if add structure index index(key) = i index(data) = data$ end add next i close all end&*[INTOUCH_DEMO]INT_DEMO_COPYRIGHT.COM;6+,(O). /@ 4W -L+0123 KPWO 56zuZg7:C4h8nd9GHJF$! INT_DEMO_COPYRIGHT.COM - INT_DEMO Copyright and Version Definitions$!&$! p1 = procedure name being executed-$! p2 = required privileges of the procedure+$! p3 = NO if no quota checking is needed$!,$! Result: int_demo_version = this version2$! int_demo_status = ERROR if an error$$ int_demo_status == "ERROR"$ int_demo_version == "4.1"$$ write sys$output -W "INTOUCH Demo - VAX INTOUCH Demonstration (V''INT_DEMO_version') - ''p1' Procedure"@$ write sys$output "Copyright (c) 1994 Touch Technologies, Inc."$ write sys$output ""$+$ if p2 .eqs. "" then goto no_priv_required8$ if f$privilege("''p2'") .eqs. "FALSE" then goto nopriv$$ no_priv_required:0$! Define various missing logicals, if necessary*$ if f$trnlnm("SYS$LOGIN") .eqs. "" then -) define/process sys$login tti_INT_DEMO,$ if f$trnlnm("SYS$SCRATCH") .eqs. "" then -+ define/process sys$scratch tti_INT_DEMO$$ delete :==""$ create :==""$ delete/symbol/global delete$ delete/symbol/global create%$! Check SYS$SCRATCH for write access$B$ scratch_file = "sys$scratch:temp_''INT_DEMO_local_nodename'.tmp"1$ if f$search("''scratch_file'") .nes. "" then - delete 'scratch_file';* $ on warning then goto noscratch$ define/user sys$error nla0:$ define/user sys$output nla0:$ create 'scratch_file'$ create 'scratch_file'$$$ on warning then goto version_limit0$ delete 'scratch_file'; ! get rid of version 2<$ delete 'scratch_file'; ! try to get rid of version 1 also $ set noon$$! C H E C K Q U O T A S$!6$ if p3 .eqs. "NO" then goto okay ! no quota checking$$ a=f$getjpi("","bytlm")%$ if a .le. 23000 then goto bad_bytlm$$ a=f$getjpi("","pgflquota"))$ if a .le. 20000 then goto bad_pgflquota$$ a=f$getsyi("virtualpagecnt").$ if a .le. 20000 then goto bad_virtualpagecnt$$ okay:$ INT_DEMO_status == "OKAY"J$ set process/resource_wait ! enable waiting for resources...just in case$ exit$ $ nopriv:$ write sys$output ""I$ write sys$output "Insufficient privilege...Required privileges are:"$$ write sys$output " ''p2'"$ write sys$output ""$ exit$ $ noscratch:)$ scratch_dir = f$trnlnm("sys$scratch")J$ write sys$output "INTOUCH Demo requires write access to SYS$SCRATCH:"5$ write sys$output "SYS$SCRATCH --> ''scratch_dir'"$ write sys$output ""$ exit$$ version_limit:)$ scratch_dir = f$trnlnm("sys$scratch")$ write sys$output -B "Directory version limit of SYS$SCRATCH: must be at least 2"5$ write sys$output "SYS$SCRATCH --> ''scratch_dir'"$ write sys$output ""$ exit$ $ bad_bytlm: $ temp = f$getjpi("", "bytlm")<$ write sys$output "INTOUCH Demo requires BYTLM >= 24000"0$ write sys$output "Current BYTLM --> ''temp'"$ write sys$output ""$ exit$$ bad_pgflquota:$$ temp = f$getjpi("", "pgflquota")>$ write sys$output "INTOUCH Demo requires PGFLQUO >= 20480"2$ write sys$output "Current PGFLQUO --> ''temp'"$ write sys$output ""$ exit$$ bad_virtualpagecnt:%$ temp = f$getsyi("virtualpagecnt")E$ write sys$output "INTOUCH Demo requires VIRTUALPAGECNT >= 20480"9$ write sys$output "Current VIRTUALPAGECNT --> ''temp'"$ write sys$output ""$ exit)*[INTOUCH_DEMO]INT_DEMO_DB_SEARCHING.INT;6+,+./@ 4J-L+0123KPWO56`cQ7Ih8jd9GHJ J1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program: INT_DEMO_DB_SORTING/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Dan Esbensen ! Date : 05-MAR-19910 ! Purpose: Illustrate the SORT statementJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 5, 1, 21, 80 set scroll 10, 21= print at 7,20, underline: 'Search for RIGHTSLIST IDs'8 open structure rights: name 'tti_run:rightslist' do2 message 'Use the "*" for wildcard names'D line input 'User name (identifier)', at 9, 1, length 32, &% default 'SYSTEM': uname$" clear area 10, 1, 21, 80" if _exit then exit do! uname$ = ucase$(uname$)! wild = pos(uname$, '*') if wild > 0 then# gosub do_partial_lookup else9 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~9 ~~ set structure rights, field id: key uname$ ~~9 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~, if _extracted = 0 then repeat do. group$ = encode$(rights(group), 8)/ member$= encode$(rights(member), 8)4 if member$ = '177777' then member$ = '*'@ print rights(id); tab(20);'[';group$;',';member$;']' end if loop stop routine do_partial_lookup, left_text$ = left$(uname$, wild-1), right_text$ = mid$(uname$, wild+1)G ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~G ~~ extract structure rights, field id : partial key left_text$ ~~G ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~- group$ = encode$(rights(group), 8); exclude len(group$) >= 6 ! skip resource names9 include pos(rights(id), right_text$, wild) > 0. member$= encode$(rights(member), 8)3 if member$ = '177777' then member$ = '*'? print rights(id); tab(20);'[';group$;',';member$;']' ask window: row z if z >= 21 then= print at 22,30, bold: 'Press CTRL/Z to exit or'; delay% clear area 10, 1, 22, 80 print at 10,1:;) if _exit then exit extract end if end extract end routine**[INTOUCH_DEMO]INT_DEMO_DB_SELECTING.INT;10+,+./@ 4P-L+0123KPWO56/{7Z`h8d9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( ! Program: INT_DEMO_DB_SELECTING/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Dan Esbensen ! Date : 05-MAR-19916 ! Purpose: Illustrate the selection facilitiesJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 5, 1, 21, 80G print at 9,1, underline: 'Selecting and Sorting RIGHTSLIST IDs'8 open structure rights: name 'tti_run:rightslist'P message 'Selecting 5- to 8-character IDs that contain the letter "E"...' print at 23, 72:; extract structure rights, group$ = encode$(rights(group), 8)@ exclude len(group$) >= 6 ! skip resource namesB ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~B ~~ include len(rights(id)) >= 5 and len(rights(id)) <= 8 ~~B ~~ include pos(rights(id), 'E') > 0 ~~B ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sort by rights(id) end extract print at 10, 1:; message '' for each rights, group$ = encode$(rights(group), 8)- member$= encode$(rights(member), 8)2 if member$ = '177777' then member$ = '*'> print rights(id); tab(20);'[';group$;',';member$;']' ask window: row z if z >= 21 then< print at 22,30, bold: 'Press CTRL/Z to exit or'; delay$ clear area 10, 1, 22, 80 print at 10,1:; if _exit then stop end if next rights delay(*[INTOUCH_DEMO]INT_DEMO_DB_SORTING.INT;14+,+./@ 4J:-L+0123KPWO56@V$/{7uh89d9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program: INT_DEMO_DB_SORTING/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Dan Esbensen ! Date : 05-MAR-19910 ! Purpose: Illustrate the SORT statementJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 5, 1, 21, 80G print at 9,1, underline: 'Selecting and Sorting RIGHTSLIST IDs'8 open structure rights: name 'tti_run:rightslist'= message 'Sorting by first letter and length of ID...' print at 23, 62:; extract structure rights, group$ = encode$(rights(group), 8)@ exclude len(group$) >= 6 ! skip resource names; exclude rights(id) < 'A' ! skip non-id records$ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~$ ~~ sort by rights(id)[1:1] ~~$ ~~ sort by len(rights(id)) ~~$ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ end extract print at 10, 1:; message '' for each rights, group$ = encode$(rights(group), 8)- member$= encode$(rights(member), 8)2 if member$ = '177777' then member$ = '*'> print rights(id); tab(20);'[';group$;',';member$;']' ask window: row z if z >= 21 then< print at 22,30, bold: 'Press CTRL/Z to exit or'; delay$ clear area 10, 1, 22, 80 print at 10,1:; if _exit then stop end if next rights delay"*[INTOUCH_DEMO]INT_DEMO_F_ASK.INT;3+,+./@ 4J^-L+0123KPWO56Ҭ S{7zh8뵻d9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Program: INT_DEMO_F_ASK.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Herron ! Date : 12-FEB-19914 ! Purpose: Illustrate the ask system commandJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 3, 1, 22, 80 print at 4, 1:; ask system: user z$& print 'Current Username : ';z$ ask system: directory z$& print 'Default Directory: ';z$ ask system: mode z$& print 'Execution Mode : ';z$ ask system: rights z$& print 'Authorized Rights: ';z$H print at 10, 20, bold: 'INTOUCH gives you easy access to system'H print at 11, 20, bold: 'information with these simple commands:'1 print at 13, 25, bold: 'ask system: user'6 print at 14, 25, bold: 'ask system: directory'1 print at 15, 25, bold: 'ask system: mode'3 print at 16, 25, bold: 'ask system: rights' delay end$*[INTOUCH_DEMO]INT_DEMO_F_CLEAR.INT;9+,+./@ 4J -L+0123KPWO56T{v77dh8d9GHJ J1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! Program: INT_DEMO_F_CLEAR/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Allen ! Date : May 1, 1991- ! Purpose: illustrate screen clearingJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% frame off action$ = "do_frame" do select case action$8 case "do_frame" : gosub do_frameB case "ask_upper_left_row" : gosub ask_upper_left_rowB case "ask_upper_left_col" : gosub ask_upper_left_colC case "ask_lower_right_row" : gosub ask_lower_right_rowC case "ask_lower_right_col" : gosub ask_lower_right_col9 case "do_finish" : gosub do_finish1 case "exit" : exit do end select loop stop routine do_frame gosub paint_frame( action$ = "ask_upper_left_row" end routine" routine ask_upper_left_row( action$ = "ask_upper_left_col" end routine" routine ask_upper_left_col) action$ = "ask_lower_right_row" end routine# routine ask_lower_right_row) action$ = "ask_lower_right_col" end routine# routine ask_lower_right_col action$ = "do_finish" end routine routine do_finish delay action$ = "exit" end routine routine paint_frame z1$ = space$(80)E cset z1$ = "This program illustrates INTOUCH's screen " + &- "clearing capabilities." z2$ = space$(80) z3$ = "EXIT = Exit" z2$[1:len(z3$)] = z3$' z3$ = "\ = Back HELP = Help") z2$[80 - len(z3$) + 1:80] = z3$( print reverse, at 1, 1 : z1$;( print reverse, at 24, 1 : z2$; end routine end ~DEMO.BCK+L+$[INTOUCH_DEMO]INT_DEMO_F_DATE.INT;35J$*[INTOUCH_DEMO]INT_DEMO_F_DATE.INT;35+,+./@ 4J:-L+0123KPWO56 (7Gh8 print bold, at 12, 6 : "CTRL/E moves to end of line";6 print bold, at 8, 46 : "Gold/T moves to top";9 print bold, at 9, 46 : "Gold/B moves to bottom";: print bold, at 10, 46 : "F10 to abort/exit input";= print bold, at 11, 46 : "CTRL/Z to abort/exit input";8 print bold, at 12, 46 : "Gold/F finishes input";0 print at 16, 6 : "Enter some text into";1 print at 17, 6 : "the input area to the";2 print at 18, 6 : "right. Try some of the";2 print at 19, 6 : "features listed above."; doI message "Press Gold/F to Finish Input Press CTRL/Z to Exit"* !clear area box : 14, 32, 21, 731 !line input area 15, 33, 20, 72 : text$0 line input area 14, 32, 21, 73 : text$ loop until _exit end.*[INTOUCH_DEMO]INT_DEMO_F_INPUT_MENU_MAIN.INT;2+, ./@ 4J-L+0123 KPWO56`[Gd7h8e9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%1 ! Program: INT_DEMO_F_INPUT_MENU_MAIN.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Shohfi# ! Date : October 20, 19942 ! Purpose: Illustrate INPUT MENU facility.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 1, 1, 2, 80 z1$ = space$(40)) cset z1$ = "Creating a Main Menu"+ print wide, reverse, at 1, 1 : z1$;H print at 4, 21 : "INPUT MENU allows you to use the arrow keys";H print at 5, 21 : "to select a menu item and then press RETURN";= print at 10, 41 : "This is an example of a main menu"= print at 11, 41 : "which is used as a starting point"1 print at 12, 41 : "in many applications."A main_menu$ = '%at 8, 10, %title "Customer Maintenance",'&C + '%heading "Procedures","Add New Customers",' &0 + '"Change Customer Data",' &? + '"Delete Customers","Customer Inquiry",' &B + '%heading "Other Options","Mail","Directory"'. line input menu main_menu$: selection$ end.*[INTOUCH_DEMO]INT_DEMO_F_INPUT_MENU_POP.INT;40+,./@ 4PR-L+0123 KPWO56 gQd7xh8oe9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 ! Program: INT_DEMO_F_INPUT_MENU_POP.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Shohfi# ! Date : October 20, 19942 ! Purpose: Illustrate INPUT MENU facility.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 1, 1, 2, 80 z1$ = space$(40)* cset z1$ = "Creating Pop-Up Menus"+ print wide, reverse, at 1, 1 : z1$;K print at 5, 22 : "Only one line of code is needed to create this";G print at 6, 22 : "pop-up menu. The INPUT MENU statement is:";P print at 8, 22, bold : "INPUT MENU 'ADD,CHANGE,DELETE,INQUIRE' : ANS$";H print at 14, 12 : "Use the arrow keys to select a menu item "; &2 "and then press RETURN";5 input menu 'add,change,delete,inquire' : ans$ clear area 14, 1, 14, 806 print at 14, 27 : "Your menu selection was ";  print bold : ans$; delay 3 end/*[INTOUCH_DEMO]INT_DEMO_F_INPUT_MENU_PULL.INT;21+, ./@ 4P-L+0123 KPWO56 c7h80e9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%1 ! Program: INT_DEMO_F_INPUT_MENU_PULL.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Shohfi# ! Date : October 20, 19942 ! Purpose: Illustrate INPUT MENU facility.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 1, 1, 2, 80 z1$ = space$(40)- cset z1$ = "Creating Pull-Down Menus"+ print wide, reverse, at 1, 1 : z1$;L print at 15, 8 : "This is an example of a horizontal menu with "; &/ "pull-down submenus.";% print at 17, 10, bold : ">>"; print " and "; print bold : "<<";C print " indicate that the menu can scroll left and right.";P message "Use the arrow keys to select a menu item and then press RETURN"O customer_data$ = '%at 3, 1, %menubar, %autovbar on, %autodisplay on,' & + '"Account",' &F + '"Name" = {%title "", "First", "Middle", "Last"},' &H + '"Address" = {%title "", "Street", "City", "State",' &" + ' "Zip Code",' &@ + '"Country" = {"United States", "Foreign"}},' &N + '"Phone", "Extension", "Division", "Cost Center", "Contact"'2 line input menu customer_data$: selection$ end.*[INTOUCH_DEMO]INT_DEMO_F_INPUT_MENU_SUB.INT;15+,./@ 4P-L+0123 KPWO56։Zd7 h8f2e9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 ! Program: INT_DEMO_F_INPUT_MENU_SUB.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Shohfi# ! Date : October 20, 19942 ! Purpose: Illustrate INPUT MENU facility.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 1, 1, 2, 80 z1$ = space$(40)2 cset z1$ = "Creating Menus with Sub-menus"+ print wide, reverse, at 1, 1 : z1$;L print at 4, 25 : "Input menu windows overlay your current screen.";N print at 5, 25 : "After you select an item, the screen is restored.";G print at 15, 5 : "This is an example of a menu with sub-menus"F print at 16, 5 : "and a sub-menu which has another sub-menu."% print at 18, 4, bold : "[>";: print " indicates that a menu item is a sub-menu."P message "Use the arrow keys to select a menu item and then press RETURN"? customer_data$ = '%title "Customer Data", "Account",' &; + '"Name" = {"First", "Middle", "Last"},' &I + '"Address" = {"Street", "City", "State", "Zip Code",' &@ + '"Country" = {"United States", "Foreign"}},' &N + '"Phone", "Extension", "Division", "Cost Center", "Contact"'2 line input menu customer_data$: selection$ end$*[INTOUCH_DEMO]INT_DEMO_F_MATH.INT;35+,+. /@ 4J -L+0123KPWO 56Ø7ڸh8Ee9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%, ! Program: INT_DEMO_F_INPUT_AREA.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Allen ! Date : May 15, 19912 ! Purpose: illustrate INPUT AREA facility.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% row% = 6 col_1% = 5 col_2% = 30 col_3% = 60 reply$ = "1234.5678" do line input at 4, 1, &$ prompt "Number? ", & length 12, &' default reply$ : reply$- if _back or _exit then exit do/ if not valid(reply$, "NUMBER") then5 message error : "Numeric entry expected" repeat do end if reply = val(reply$)0 clear area row%, col_1%, row% + 14, 802 print bold, at row% + 0, col_1% : "ABS";! print "("; reply$; ")";. print tab(col_2%); "absolute value";/ print bold : tab(col_3%); abs(reply);3 print bold, at row% + 1, col_1% : "CEIL";! print "("; reply$; ")";5 print tab(col_2%); "smallest integer >= X";0 print bold : tab(col_3%); ceil(reply);1 print bold, at row% + 2, col_1% : "FP";! print "("; reply$; ")";/ print tab(col_2%); "fractional part";. print bold : tab(col_3%); fp(reply);2 print bold, at row% + 3, col_1% : "INT";! print "("; reply$; ")";1 print tab(col_2%); "largest real <= X";/ print bold : tab(col_3%); int(reply);6 print bold, at row% + 4, col_1% : "INTEGER";! print "("; reply$; ")";- print tab(col_2%); "integer value";3 print bold : tab(col_3%); integer(reply);1 print bold, at row% + 5, col_1% : "IP";! print "("; reply$; ")";, print tab(col_2%); "integer part";. print bold : tab(col_3%); ip(reply);2 print bold, at row% + 6, col_1% : "MAX";& print "("; reply$; ", 100)";4 print tab(col_2%); "larger of two values";4 print bold : tab(col_3%); max(reply, 100);2 print bold, at row% + 7, col_1% : "MIN";& print "("; reply$; ", 100)";4 print tab(col_2%); "lesser of two values";4 print bold : tab(col_3%); min(reply, 100);2 print bold, at row% + 8, col_1% : "MOD";$ print "("; reply$; ", 5)";2 print tab(col_2%); "remainder of X / Y";2 print bold : tab(col_3%); mod(reply, 5);3 print bold, at row% + 9, col_1% : "REAL";! print "("; reply$; ")";* print tab(col_2%); "real value";0 print bold : tab(col_3%); real(reply);5 print bold, at row% + 10, col_1% : "ROUND";$ print "("; reply$; ", 2)";% print tab(col_2%); "round";4 print bold : tab(col_3%); round(reply, 2);3 print bold, at row% + 11, col_1% : "SGN";! print "("; reply$; ")";$ print tab(col_2%); "sign";/ print bold : tab(col_3%); sgn(reply);3 print bold, at row% + 12, col_1% : "SQR";! print "("; reply$; ")";+ print tab(col_2%); "square root"; when exception in1 print bold : tab(col_3%); sqr(reply); use, print bold : "invalid operation" end when4 print bold, at row% + 13, col_1% : "STR$";! print "("; reply$; ")";. print tab(col_2%); "real to string"; print tab(col_3%);B if sgn(reply) = 0 or sgn(reply) = 1 then print " ";# print bold : str$(reply);3 print bold, at row% + 14, col_1% : "VAL";# print '("'; reply$; '")';. print tab(col_2%); "string to real";0 print bold : tab(col_3%); val(reply$); loop end#*[INTOUCH_DEMO]INT_DEMO_F_PASS.INT;9+,+./@ 4P-L+0123KPWO56@UZ{7Z0h8Ne9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! Program: PASS_EXAMPLE.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM% ! Author : Daniel James Swain ! Date : 8-JAN-1991. ! Purpose: Illustrate the PASS commandJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% do set scroll 1, 24! clear area 3, 1, 22, 80P message 'Enter any SHOW command (USERS, MEMORY, SYSTEM, ...) or EXIT' # line input "Show what", &" default "USERS", & at 4, 1, & length 30 : cmd$< if _exit or _back or cmd$ = '' then exit do set scroll 6, 21 set window : row 5 pass 'show ' + cmd$) ask system, pass : success okay if not okay then= message error : "Pass failed. Error: " + systext$ end if delay loopend**[INTOUCH_DEMO]INT_DEMO_F_PRINT_ATTR.INT;14+,+./@ 4P-L+0123KPWO56 }709h8iYe9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%, ! Program: INT_DEMO_F_PRINT_ATTR.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Allen! ! Date : April 29, 1991I ! Purpose: illustrate video print attributes: BOLD, REVERSE, etc.J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%K print at 4, 15 : "This program illustrates how easy it is to print"H print at 5, 15 : " text using video attributes with INTOUCH."< print blink, at 8, 6 : "This line is BLINKing."C print bold, at 10, 6 : "This line is printed in BOLD."P print reverse, at 12, 6 : "REVERSE video really makes text stand out."> print underline, at 14, 6 : "This line is UNDERLINEd."C print wide, at 16, 4 : "Here, we use WIDE characters." print blink, & bold, &O reverse, at 18, 6 : "BLINK, BOLD, and REVERSE simulataneously." delay end)*[INTOUCH_DEMO]INT_DEMO_F_PRINT_POS.INT;14+,+./@ 4J-L+0123KPWO56Du~7Kh8ge9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! Program: INT_DEMO_F_PRINT_POS.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Allen! ! Date : April 30, 19910 ! Purpose: illustrate cursor positioningJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%C print at 4, 21 : "This program illustrates how easy it is";B print at 5, 21 : " to position the cursor with INTOUCH."; row% = 3% col% = 1% gosub save_prev do ask_row: when exception inA input at 7, 1, prompt "Row (3-23)? ", length 4 : row% use" message error : extext$ retry end when- if _exit or _back then exit do! if (row% < 3%) or & (row% > 23%) then/ message error : "3 through 23 only" goto ask_row end if ask_col: when exception inD input at 8, 1, prompt "Column (1-80)? ", length 4 : col% use# message error : extext$ retry end when' if _back then goto ask_row" if _exit then exit do! if (col% < 1%) or & (col% > 80%) then/ message error : "1 through 80 only" goto ask_col end if  position_cursor: gosub restore_prev gosub save_prev9 print blink, bold, reverse, at row%, col%: "X"; loop stop routine save_prev prev_row% = row% prev_col% = col%B ask window area row%, col%, row%, col% : data prev_char$ end routine routine restore_prevH set window area prev_row%, prev_col%, prev_row%, prev_col% : & data prev_char$ end routine end#*[INTOUCH_DEMO]INT_DEMO_F_SCAN.INT;6+,$ ./@ 4Q-L+0123 KPWO56Pfr'w7Pzr'w8 xe9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program: INT_DEMO_F_SCAN.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Herron ! Date : 13-FEB-1991/ ! Purpose: Illustrate the SCAN functionJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%6 open structure vend : name 'tti_run:vendor', &/ datafile "sys$scratch:tti_vendor.tmp" clear area 3, 1, 21, 80 print at 4, 1, bold : &Q 'No spacing is needed and the characters do not need to be contiguous.' print at 5, 1, bold : &N 'The names are in "last-name, first-name" format. For example, try' print at 6, 1, bold : &F 'taking the default and then some combinations of your own.' set scroll 10,21 do clear area 8, 1, 8, 80A line input at 8, 5, prompt 'Enter parts of a name: ', &% default 'ZRN,L':part$8 if _exit or _back or part$ = '' then exit do part$ = ucase$(part$)" clear area 10, 1, 21, 80 print at 10,1:; extract structure vend3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~3 ~~ include scan(vend(name), part$) > 0 ~~3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~B print vend(name); tab(30); vend(phone);' '; vend(city) ask window: row z if z >= 21 then> print at 22,30, bold: 'Press CTRL/Z to exit or'; delay* if _exit then exit extract& clear area 10, 1, 22, 80 print at 10,1:; end if end extract loop set scroll 1,24 end#*[INTOUCH_DEMO]INT_DEMO_F_SET.INT;14+,+./@ 4Lh-L+0123KPWO56=X{7:qh8=:e9GHJJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Program: INT_DEMO_F_SET.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Herron ! Date : 12-FEB-19914 ! Purpose: Illustrate the SET SYSTEM commandJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% clear area 3, 1, 22, 80; print at 10, 10 : 'This example uses the INTOUCH ';. print bold : 'SET SYSTEM SYMBOL';% print normal : ' command.'D print bold, at 12, 20 : 'Other SET SYSTEM commands include:'6 print bold, at 14, 25 : 'SET SYSTEM DIRECTORY'4 print bold, at 15, 25 : 'SET SYSTEM LOGICAL'( symbol_name$ = 'TTI_DEMO_SYMBOL' do% line input 'Symbol name', & at 4, 1, &' default symbol_name$, &( length 50 : symbol_name$D if _exit or _back or symbol_name$ = '' then exit doB ask system, symbol symbol_name$ : value symbol_contents$ gosub display_symbol& line input 'Symbol value', & at 5, 1, &+ default symbol_contents$, &, length 50 : symbol_contents$$ if _back then repeat do" if _exit then exit doB set system, symbol symbol_name$ : value symbol_contents$ gosub display_symbol loop stop routine display_symbolL print at 7, 1, bold, erase : symbol_name$; ' = '; symbol_contents$  end routineend&*[INTOUCH_DEMO]INT_DEMO_F_WINDOW.INT;31+,+./@ 4NT-L+0123KPWO567h8ٕe9GHJ J1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$ ! Program: INT_DEMO_F_WINDOW/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Allen ! Date : May 2, 19914 ! Purpose: illustrate "windowing" capabilityJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% frame off z1$ = space$(40)% cset z1$ = "Creating Windows"+ print wide, reverse, at 1, 1 : z1$;- print reverse, at 24, 1 : space$(80);& clear area box : 3, 38, 13, 76D for z = 4 to 12 \ print at z, 39 : repeat$("1", 37) \ next z2 print at 6, 50 : " ";2 print bold, at 7, 50 : " W I N D O W ";2 print at 8, 50 : " ";2 print bold, at 9, 50 : " O N E ";2 print at 10, 50 : " ";# ask window : current first$6 z1$ = "Press the RETURN key to see WINDOW TWO" gosub pause% clear area box : 6, 5, 16, 43I for z = 7 to 15 \ print bold, at z, 6 : repeat$("2", 37) \ next z, print at 9, 17 : " ";, print at 10, 17 : " W I N D O W ";, print at 11, 17 : " ";, print at 12, 17 : " T W O ";, print at 13, 17 : " ";$ ask window : current second$8 z1$ = "Press the RETURN key to see WINDOW THREE" gosub pause' clear area box : 10, 11, 20, 70N for z = 11 to 19 \ print reverse, at z, 12 : repeat$("3", 58) \ next z2 print at 13, 32 : " ";2 print bold, at 14, 32 : " W I N D O W ";2 print at 15, 32 : " ";2 print bold, at 16, 32 : " T H R E E ";2 print at 17, 32 : " ";: z1$ = "Press the RETURN key to erase WINDOW THREE" gosub pause$ set window : current second$8 z1$ = "Press the RETURN key to erase WINDOW TWO" gosub pause# set window : current first$ delay stop routine pause! z = 40 - (len(z1$) / 2)% print bold, at 23, z : z1$; do key input z$+ loop until _terminator = "RETURN" end routine end#*[INTOUCH_DEMO]INT_DEMO_F_WRAP.INT;5+,+./@ 4M`-L+0123KPWO56]ưO{7ʗh8e9GHJ  ~DEMO.BCK+L+#[INTOUCH_DEMO]INT_DEMO_F_WRAP.INT;5MJ1 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& ! Program: INT_DEMO_F_WRAP.INT/ ! System : INTOUCH DEMONSTRATION SYSTEM ! Author : Jim Herron ! Date : 13-FEB-1991/ ! Purpose: Illustrate the WRAP functionJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%L the_text$ = 'With a single line of code this program illustrates ' &H + 'how easy and flexible text manipulation is with ' &M + 'INTOUCH. Please enter various left and right margin ' &< + 'values to see how the display changes.' left_margin = 5 right_margin = 75I message 'This text has a left margin of ' + str$(left_margin) + &@ ' and a right margin of ' + str$(right_margin)  gosub display_text do input at 4, 1, & length 4, & default '40', &9 prompt 'New Left Margin : ' : left_margin- if _exit or _back then exit do input at 5, 1, & length 4, & default '70', &: prompt 'New Right Margin: ' : right_margin$ if _back then repeat do" if _exit then exit do gosub display_text loop stop routine display_text! clear area 9, 1, 21, 80 set scroll 9, 21F print at 9, 1 : wrap$(the_text$, left_margin, right_margin); set scroll 1, 24 end routine end!*[INTOUCH_DEMO]INT_DEMO_HELP.DAT;1+,+./@ 4!   Z-L+0123 KPWO5x6027:yh8,e9GHJrg TOPIC *sO @ SUBTOPIC m `Z g s  s y 3O$0B_BASELINE_POST B_BASELINE_POST Each benchmark focuses on a single issue. Real applications perform many different functions. In order to give you a clear benchmark, these 'baseline' figures will be subtracted from the final statistics for each language.          RE B_BASELINE_PRE yApplications spend most of their time processing. INTOUCH spends an extra second at startup to set up a complete context. This complete context gives you dramatic performance improvements even over 3GL's. This baseline procedure determines the overhead required on YOUR system to activate and exit images. Each program performs its languages equivalent to an 'exit'.         KIO_BASELINE_POST B_IO_BASELINE_POST In order to give you a clear benchmark, these 'baseline' figures will be subtracted from the final statistics for each language.          BRE B_IO_BASELINE_PRE bThis procedure calculates the overhead required on YOUR system to open files (called 'structures' in INTOUCH) in the selected languages. With a simple 'OPEN' statement, INTOUCH gives you the data dictionary power to change the way your data is defined. This involves NO CODE CHANGES. You get 3GL speed and control, plus 4GL power and simplicity.         bL READ_POST B_READ_POST  INTOUCH uses fewer direct I/Os than other languages to perform reads. The result is that INTOUCH is the ideal environment for I/O intensive applications. INTOUCH handles READS, WRITES and SCREEN I/Os much more efficiently and faster than any other language!         >RE B_READ_PRE INTOUCH is much more efficient than other languages at handling reads from disk. INTOUCH is typically 5 to 10 times more efficient at handling I/O than other languages. For most applications, reads make up the vast majority of I/Os. This benchmark program reads 1383 records sequentially from disk. Benchmark programs are provided in several languages including INTOUCH. A report follows to display Direct I/Os, CPU Time, and Elapsed Time. This benchmark takes about 1 minute to complete on a VAX 3100.         DIM_POST B_REDIM_POST pIn other languages redimensioning erases any existing information in an array. INTOUCH redimensions the array faster and preserves the data as well. With INTOUCH you can use the convenience of dynamic arrays without bogging down your applications and your system. This convenience translates directly into programmer productivity and more maintainable code.         T RE B_REDIM_PRE vMost 3GLs require the programmer to specify a fixed size for each array at compile-time (when the program is written.) If the application needs to store more data than the array was sized for, a fatal error is returned and the application is terminated. INTOUCH, and a few 3GLs, allows you to dynamically redimension arrays at run-time. Thus, the array size can be expanded as needed. INTOUCH optimizes its array redimensioning. This allows arrays to be expanded quickly at run-time, 5 to 10 times faster than traditional 3GLs. This benchmark program will increase the dimensions of an array from 1 element to 4000 elements, expanding the array 10 elements at a time. We have included benchmark programs in BASIC and INTOUCH. This functionality is not available in most languages including C, Cobol, or Fortran. This benchmark takes about 1 minute on a VAX 3100.       N  SCREEN_IO_POST B_SCREEN_IO_POST INTOUCH significantly reduces buffered I/Os and CPU time. INTOUCH dramatically improves performance and removes bottlenecks associated with screen I/O and interactive applications.            RE B_SCREEN_IO_PRE INTOUCH is typically 50 to 100 times more efficient at performing screen I/O than other languages. The unique, packetized I/O system dramatically reduces buffered I/Os and makes INTOUCH an ideal environment for interactive applications. This benchmark counts from 1 to 1000 and prints each number to the screen in several languages including INTOUCH. A report follows which includes Buffered I/Os, CPU Time, and Elapsed Time on the benchmark for each language. INTOUCH dramatically reduces buffered I/O counts and CPU utilization while handling screen I/O. This benchmark typically completes in less than 1 minute on a VAX 3100.        ? ^ UPDATE_POST B_UPDATE_POST INTOUCH dramatically reduces the number of direct I/Os required for typical update operations. This reduction in the number of direct I/Os is due to the unique INTOUCH packetized I/O handling. INTOUCH is the ideal programming environment for I/O intensive applications.          $ $ $ D D D 4 4  4 44 444 4.          $ $ $ $ $ $ 4 4 4 4e following statistics show you the drastic reduction in I/O system and CPU overhead on YOUR system.       -  UPDATE_POST B_UPDATE_POST INTOUCH optimizes access to your data. You can spend your programming resources on functionality rather than tuning and maintaining your code.        ? $ $ $ $ $ $ $ $  $  $  $ ? $ $ $ $ $ $ $ $  $  $  $ystem and CPU overhead on YOUR system.       -  UPDATE_POST B_UPDATE_POST INTOUCH optimizes access to your data. You can spend your programming resources on functionality rather than tuning and maintaining your code.        ? $ $ $ $ $ $ $ $  $  $  $$ $ $  $  $  $s, and Other Applications are all accessable from within INTOUCH.      RE F_PASS_PRE This function allows you to execute DCL commands from within your INTOUCH procedures. Now you can access multiple applications and common system functions like MAIL) without having to exit from your main application.     z SYSUAF_POST F_SYSUAF_POST <Now take a look at the simple procedure used to perform this complex task (TTI_INT_DEMO:INT_DEMO_F_SYSUAF.INT). This is the kind of power that will let you quickly and easily convert your existing applications without modifying your data structures. Even if they are in more than one format, i.e., RMS, RDB, INGRESS, etc. INTOUCH accesses practically all of the different data structures available on VMS. And it is all transparent to the procedures you write. You can even change the underlying data structures without modifying your applications.     $ $ $ $ $ $ $ $  $  $  $you quickly and easily convert your existing applications without modifying your data structures. Even if they are in more than one format, i.e., RMS, RDB, INGRESS, etc. INTOUCH accesses practically all of the different data structures available on VMS. And it is all transparent to the procedures you write. You can even change the underlying data structures without modifying your applications.    3E  (F_WINDOW_POST F_WINDOW_POST With just a few simple, straightforward statements, INTOUCH allows you to use a sophisticated, pop-up window format: CLEAR AREA BOX: row, col, row, col ASK WINDOW: CURRENT str_var SET WINDOW: CURRENT str_var         2 RE F_WINDOW_PRE It is easy to create windows using INTOUCH's ability to draw boxes, to position data on the screen, and to save and restore screen images. The following statement draws a framed, empty, rectangle: CLEAR AREA BOX: row, col, row, col Use the PRINT statement to print data within the box. Or, use the INPUT statement to input data from within the box. The following statements are used to save and restore whole screen images: ASK WINDOW: CURRENT str_var SET WINDOW: CURRENT str_var         RAP_POST F_WRAP_POST With its powerful text manipulation capabilities, INTOUCH gives you exact format control with very little effort. An example of utilizing WRAP$ is the display of variable length text stored in data records. This text might include invoice line items, sales comments, etc. Most other languages use several fixed length fields for use with comments. This method lacks flexibility. With this text manipulation functionality, INTOUCH reduces the amount of code you have to maintain, as well as its complexity. With a single line of code, you can format your text data to fit exactly where you want it to fit. PRINT WRAP$(TEXT$, LEFT_MARGIN, RIGHT_MARGIN)        !RE F_WRAP_PRE kThe INTOUCH WRAP$ function allows a programmer to specify how text will be formatted. The WRAP$ function applies to all types of text. Data entry text as well as displayed text is easily handled by the INTOUCH WRAP$ function. This capability makes INTOUCH an ideal language for applications that handle text fields of unknown length. Other languages lack this capability and flexibility. It is very difficult or impossible to achieve text wrapping functionality in other languages. With INTOUCH, this capability involves just a single line of code. PRINT WRAP$(TEXT$, LEFT_MARGIN, RIGHT_MARGIN)        Y HELP_TOPIC HELP_TOPIC e This help system allows you to receive help on any input items that you may enter. When you press the HELP key or type HELP at any prompt, an initial screen of help information is displayed. The help information explains the current topic and gives the names of any related topics that might be helpful to you. After reading this information, you can enter the name of one of the related topics or any other topic in which you might be interested. You only need to enter as much of the help topic name as is necessary to distinguish it from all other help topics within the help system. If your response is ambiguous, the help system will show you the possible topics and let you select the proper one. To be shown a menu of all topics, type a * at the "Help topic" prompt. Help topic? * To exit the help system, press the RETURN key.       _@ MENU_ITEM MENU_ITEM  Enter a menu item name -- Menu items are listed on the left-hand side of the screen, followed by a short description of what each item does. To choose a given item, just enter its name. You only need to enter as many characters of the item name as is necessary to distinguish it from all other items within the menu system. To exit from a sub-menu to the "Main" menu, enter EXIT at the prompt. To exit from the menu completely, return to the "Main" menu and then enter EXIT.         OVERVIEW OVERVIEW k INTOUCH is a very fast, very powerful programming language that delivers unparalleled programmer productivity and performance. INTOUCH has the complete functionality and flexibility that other 4GLs lack. INTOUCH is uniquely designed for performance and is specifically optimized for VMS and the handling of I/O. The purpose of the INTOUCH Evaluation Kit is to make it easy for you to evaluate INTOUCH. You will become familiar with some of the unique features and capabilities of the INTOUCH programming language. INTOUCH is very fast. INTOUCH is much faster than other 4GLs. INTOUCH is also faster than any other language, 3GL or 4GL, for I/O intensive applications. To illustrate this point to you, we have included several programs to benchmark the performance capabilities of INTOUCH against languages such as COBOL, BASIC, FORTRAN, and C. These programs illustrate the speed and efficiency of INTOUCH. Feel free to write your own benchmark programs in any other language to compare performance potential with INTOUCH. Source code for these benchmarks and the entire demo system can be reviewed under the menu selection "SOURCE". INTOUCH has Superior Functionality and Flexibility. INTOUCH has more functionality and more flexibility than any other language. Our customers can attest to this, but we want you to discover it for yourself. Most 4GLs are very limited and lack flexibility in certain programming situations and in handling complex applications. These 4GLs usually require a 3GL workaround to compensate for their lack of flexibility. This workaround can be very awkward and difficult to maintain as well as expensive. INTOUCH does NOT have these limitations. We have included a series of demonstrations that quickly illustrates some of the powerful functionality that is unique to INTOUCH. Please note that these examples are just a sampling of some of the unique INTOUCH functionality. For a complete overview of INTOUCH functionality, please refer to the INTOUCH SPECIFICATIONS manual. Complete INTOUCH Language In addition, we have included the full INTOUCH language, the Guided Query Language report writer and query language, and a full documentation set. Feel free to use INTOUCH for your most challenging applications. If you have any questions please call Technical Support at (800) 525-2527. Y PRINT_OPTION PRINT_OPTION  Enter SCR to display the report on your terminal screen. Enter SYS to submit the report to your system printer queue. Enter PRI to print the report on a printer attached to your terminal, Uif there is one. Enter LAS to submit the report to your laser printer queue, 9if there is one. This option will not appear on your 9print options menu unless the symbol LASER is defined ;on your system. Enter EXIT to return to the DEMO menu.        E$D - B_UPDATE_PRE B_UPDATE_PRE The update process is a very common I/O application. Again INTOUCH is typically 5 to 10 times more efficient at handling I/O operations than other languages. This benchmark will update all of the records in the TTI_RUN:VENDOR file (about 1300 records.) Benchmark programs are provided in several languages including INTOUCH. A report follows to display Direct I/Os, CPU Time, and Elapsed Time for each program. This benchmark takes about 3 minutes to complete on a VAX 3100.          WRITE_POST B_WRITE_POST GINTOUCH uses a small fraction of the direct I/Os compared to other languages when writing data records. Only Digital's optimized FORTRAN matches the I/O performance of INTOUCH when populating an indexed file. Most applications are I/O bound. INTOUCH is the ideal programming environment for I/O intensive applications.         } RE B_WRITE_PRE uI/O is the bottleneck on most VAX/VMS systems. INTOUCH is typically 5 to 10 times more efficient at handling I/O than other programming languages. This benchmark program creates an empty indexed file and populates it by writing 200 records of 1255 characters. These characters consist of a 4-character sequential ID number and 1000 text characters consisting of the word "DATA " 200 times. Benchmark programs are provided in several languages including INTOUCH. A report follows to display Direct I/Os, CPU Time, and Elapsed Time for each program. This benchmark takes about 3 minutes to complete on a VAX 3100.        O$GDB_SEARCHING_POST DB_SEARCHING_POST INTOUCH's comprehensive indexed field searching capabilities make it ideal for both simple and complex application development. INTOUCH is truly a 4GL built for professional programmers ... yet easy enough for even a novice to master quickly.         $RE DB_SEARCHING_PRE lINTOUCH allows data to be searched by any indexed field (key value). Data can be searched by either an exact match or by partial key value. For instance, you can rapidly search for a given name...or a name that begins with a given prefix (all names starting with SYS). Included with all VMS systems is a file called RIGHTSLIST.DAT. This file contains the names of each user (identifier) and each resource on the system. Using INTOUCH, we will ask for an identifier. If a "*" is entered as part of the identifier, we will do a "wildcard" lookup. The INTOUCH code to accomplish this searching task is: -SET STRUCTURE RIGHTS, FIELD ID: KEY UNAME$ and <EXTRACT STRUCTURE RIGHTS, FIELD ID : PARTIAL KEY LEFT_TEXT$       $, LECTING_POST DB_SELECTING_POST INTOUCH's powerful and flexible selection statements make it easy to write applications of any complexity ... without having to resort to calling 3GL routines. With INTOUCH, application development is fast and efficient.         $RE DB_SELECTING_PRE INTOUCH allows data to be selected by any field or combination of fields. In addition, INTOUCH allows data to be selected by derived information. For instance, you can select information based on the presence of a letter in a name as well as the length of the name. Included with all VMS systems is a file called RIGHTSLIST.DAT. This file contains the names of each user (identifier) and each resource on the system. Using INTOUCH, we will select identifiers that are between five and eight letters long. In addition, the identifiers must contain the letter "E". The INTOUCH code to accomplish this selection task is: 8INCLUDE LEN(RIGHTS(ID)) >= 5 AND LEN(RIGHTS(ID)) <= 8 !INCLUDE POS(RIGHTS(ID), 'E') > 0       $ ORTING_POST DB_SORTING_POST INTOUCH's easy-to-learn syntax, coupled with its powerful sorting capabilities, make it ideal for developing both simple and complex applications.          . 4 4 T T T T D D DD DD Dstance, you could sort data by the first letter of a name and, within that, by length of name (shortest names first.) Included with all VMS systems is a file called RIGHTSLIST.DAT. This file contains the names of each user (identifier) and each resource on the system. Using INTOUCH, we will sort by the first letter of each identifier. Within each letter group we will sort by the length of the identifier (shortest names first.) The INTOUCH code to accomplish this sorting task is: SORT BY RIGHTS(ID)[1:1] SORT BY LEN(RIGHTS(ID))       7EXIT EXIT          $ F_ASK_POST F_ASK_POST QINTOUCH makes data from the operating system readily available. This allows the program to make decisions based on operating system information. Other languages require cumbersome calls to library routines or system services to achieve comparable functionality. INTOUCH typically makes difficult programming tasks very easy.         s$RE F_ASK_PRE \"System Information" tells an application about the system environment the application is running in, i.e. Current Username, Current Default Directory, etc. Many applications require information from the system. In other languages cumbersome calls to external routines are used. These calls work around the languages' lack of this functionality. INTOUCH has built-in statements to access system information. The following example reads and displays some of the information INTOUCH gives you about the current process. The example shows you the simple statements used to obtain the data.        h$] CLEAR_POST F_CLEAR_POST this is F_CLEAR_POST           ELEMENT_POST F_ELEMENT_POST `INTOUCH delivers unparalleled functionality for manipulating text. One example of this parsing capability can be seen when breaking down existing fields or text strings into multiple fields. If a record has a single NAME field, INTOUCH can break down the field into LAST_NAME and FIRST_NAME fields using a space (" ") as a delimiter to separete the original field. INTOUCH gives you more text manipulation functionality than any 3GL or 4GL. Functions like "parsing" are seldom attempted in other languages because they are so difficult. INTOUCH makes functions like "parsing" very easy.        dE RE F_ELEMENT_PRE This example demonstrates how easily you can break apart strings of data with INTOUCH. First, the example asks you for a DELIMITER (separator) to determine where each element begins and ends. The default delimiter is a comma. Second, the example asks you for a "DELIMITED STRING." This is a string of characters or group of characters separated by the delimiter you specified in the first question. The default is the comma-separated list "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday." The last question asks which element you would like to see. The default is element 3. If you take all of the defaults, the program tells you that you selected "Wednesday." The program then displays the single line of code needed to perform this entire function.        4 4 4 4  4  4 D D D D D4 4 4 4  4  4t default directory is and then set your default directory to whatever you specify.        4 4 4 4  4  4   YSUAF_POST 49$U F_EVAL_POST F_EVAL_POST  Eval post...          $MRE F_EVAL_PRE INTOUCH is ...           XECUTE_POST F_EXECUTE_POST ??Not implemented yet?? With INTOUCH, code can be compiled and executed at run-time. This feature lets you write generalized routines that evaluate and execute code "on the fly."           RE F_EXECUTE_PRE q??Not implemented yet?? INTOUCH has the ability to dynamically compile and execute INTOUCH code at run-time.          S4INPUT_AREA_POST F_INPUT_AREA_POST INTOUCH'S INPUT AREA facility allows you to input lengthy quantities of text in an easy and straightforward manner. There is no need to ask for several lines of text, one line at a time. The string resulting from an INPUT AREA can be stored in a data file. And, the string can be retrieved from the data record and used as the default for an INPUT AREA statement ... even if that area is defined by different coordinates from the original.         4DRE F_INPUT_AREA_PRE The LINE INPUT AREA statement does input from an area on the screen. This area is usually more than one line long. It is often used to input text which is free-format and "conversational." Such text may consist of comments or long descriptions. The LINE INPUT AREA performs automatic word-wrapping, handles insert and delete, and allows the use of the arrow keys within the input area. Special "Gold" and "CTRL" key combinations are used to move to the beginning or end of a line, move to the top of bottom of the input area, to abort and exit, and to finish the input. LINE INPUT AREA gets input from a rectagular area on the screen defined by the upper-left row and column and the lower-right row and column. -LINE INPUT AREA row, col, row, col : str_var       4MENU_MAIN_POST F_INPUT_MENU_MAIN_POST INTOUCH gives you the ability to easily set up a main menu as the starting point of your application. As just seen, you can give your menu a title and headings, and can place it anywhere on the screen. You can control many other menu characteristics as well, including size, width and number of columns. Or you can let INTOUCH automatically determine those characteristics for you.         >4^RE F_INPUT_MENU_MAIN_PRE FIn many applications, the first thing that a user will see is the main menu. With INTOUCH menus, the user simply uses arrow keys to select any menu item and then presses the RETURN key. INTOUCH makes it easy to set up a main menu as the starting point of your application using the MENU option of the INPUT statement. INPUT MENU str_expr : str_var Str_expr is a string expression that describes the menu. It consists of multiple comma-separated elements. The user's menu selection is ret~DEMO.BCK+L+![INTOUCH_DEMO]INT_DEMO_HELP.DAT;1!   m |:urned in the string variable, str_var.        4] POP_POST F_INPUT_MENU_POP_POST INTOUCH makes it very easy to create pop-up menus. With a wide range of options available to the programmer, menus can be as simple as this example or as complex as you like. Unless otherwise directed, INTOUCH automatically determines menu width and screen position.         48RE F_INPUT_MENU_POP_PRE "Menus are a form of input often favored by users because they require the least amount of effort. The user simply uses the arrow keys to select the menu item and then presses the RETURN key. INTOUCH makes it easy to create pop-up menus using the MENU option of the INPUT statement. INPUT MENU str_expr : str_var Str_expr is a string expression that describes the menu. It consists of multiple comma-separated elements. The user's menu selection is returned in the string variable, str_var.        4RE T T T T  ring expression that describes the menu. It consists of multiple comma-separated elements. The user's menu selection is returned in the string variable, str_var.        4RE T T T T   arithmetic functions: ABS(num_expr) !absolute value CEIL(num_expr) -smallest integer >= num_expr FP(num_expr) !fractional part INT(num_expr) .largest real <= num_expr INTEGER(num_expr) integer value IP(num_expr) 4integer part (truncates) MAX(num_expr, num_expr) 0larger of two values MIN(num_expr, num_expr) 0lesser of two values MOD(num_expr, num_expr) <remainder of num_expr divided by num_expr REAL(num_expr) zreal or floating point value ROUND(num_expr, int_expr) rounds num_expr to int_expr decimal digits SGN(num_expr) "sign (0, +1, -1) SQR(num_expr) square root STR$(num_expr) "string representation of num_expr  VAL(num_str) treal representation of num_str Built-in functions used in trigonometry and calculus include: ACOS(num_expr) Iangle, in radians, whose cosine is num_expr ANGLE(num_expr, num_expr) =angle, in radians, from 0,0 of coordinates ASIN(num_expr) ;angle, in radians, whose sine is num_expr ATN(num_expr) /angle, in radians, of tangent COS(num_expr) 6cosine of angle specified in radians COT(num_expr) 'cotangent of num_expr CSC(num_expr) &cosecant of num_expr DEG(num_expr) 7degrees of angle specified in radians RAD(num_expr) 8radians of angle specified in degrees SEC((num_expr) $secant of num_expr SIN(num_expr) 4sine of angle specified in radians TAN(num_expr) <tangent of angle specified in radians COSH(num_expr) 0hyperbolic cosine of num_expr SINH(num_expr) .hyperbolic sine of num_expr TANH(num_expr) 2hyperbolic tangent of num_expr LOG(num_expr) 0natural logarithm of num_expr LOG2(num_expr) 0base 2 logarithm of num_expr LOG10(num_expr) common logarithm of num_expr  PASS_POST F_PASS_POST With the PASS statement, INTOUCH gives you a simple interface to execute system (DCL) commands. With INTOUCH, you can use simple DCL commands to queue files for printing and to access all system utilities. The PASS statement also allows you to directly run other applications without leaving your INTOUCH program. Examples of this include application programs, VMS Mail, Edit, Print Services and VMS command procedures.         RE F_PASS_PRE Typically, in applications that print information, the most convenient path to the printer is through the VMS queueing system. In most languages this requires calls to system or library services. With INTOUCH, you can directly perform system commands (DCL) with the PASS statement. This statement executes system (DCL) commands from within your INTOUCH procedures. You can print files, execute command procedures, and use any other system (DCL) commands to make your applications simpler and more maintainable. You can even run other application programs. PASS "SHOW USERS" The PASS command suspends processing of INTOUCH, executes the DCL SHOW USERS command, and continues the INTOUCH program when complete.        T T T T    T T T Tyou specified.         D 4$ DB_SORTING_PRE DB_SORTING_PRE INTOUCH allows data to be sorted by any field or combination of fields. In addition, INTOUCH allows data to be sorted by derived information. For instance, you could sort data by the first letter of a name and, within that, by length of name (shortest names first.) Included with all VMS systems is a file called RIGHTSLIST.DAT. This file contains the names of each user (identifier) and each resource on the system. Using INTOUCH, we will sort by the first letter of each identifier. Within each letter group we will sort by the length of the identifier (shortest names first.) The INTOUCH code to accomplish this sorting task is: SORT BY RIGHTS(ID)[1:1] SORT BY LEN(RIGHTS(ID))       7EXIT EXIT          $ F_ASK_POST F_ASK_POST QINTOUCH makes data from the operating system readily available. This allows the program to make decisions based on operating system information. Other languages require cumbersome calls to library routines or system services to achieve comparable functionality. INTOUCH typically makes difficult programming tasks very easy.         s$RE F_ASK_PRE \"System Information" tells an application about the system environment the application is running in, i.e. Current Username, Current Default Directory, etc. Many applications require information from the system. In other languages cumbersome calls to external routines are used. These calls work around the languages' lack of this functionality. INTOUCH has built-in statements to access system information. The following example reads and displays some of the information INTOUCH gives you about the current process. The example shows you the simple statements used to obtain the data.        h D DATE_POST F_DATE_POST ZThe preceeding program makes use of the following INTOUCH functions: days(yyyymmdd$) +returns a "julian" date date$(jul, 0) 3returns a date in YYYYMMDD format date$(jul, 1) 3returns a date in MMDDYYYY format date$(jul, 2) 3returns a date in DDMMYYYY format date$(jul, 3) 6returns a date in DD-Mon-YYYY format date$(jul, 4) 7returns a date in Month DD, YYYY format day$(jul) returns a day of the week Using just these few INTOUCH date manipulation functions, you can easily do date calculations and convert dates into a wide variety of formats.        P DRE F_DATE_PRE WINTOUCH includes a comprehensive selection of date manipulation functions: DATE$ <returns today's date in YYYYMMDD format DAYS(str_expr) -given a date in YYYYMMDD or YYMMDD format, greturns its "julian" date DATE$(int_expr1, int_expr2) given a julian date and a format option, :returns the date in one of 5 formats. DAY$(int_expr) *given a julian date, returns the day of  the week.         ELEMENT_POST F_ELEMENT_POST `INTOUCH delivers unparalleled functionality for manipulating text. One example of this parsing capability can be seen when breaking down existing fields or text strings into multiple fields. If a record has a single NAME field, INTOUCH can break down the field into LAST_NAME and FIRST_NAME fields using a space (" ") as a delimiter to separete the original field. INTOUCH gives you more text manipulation functionality than any 3GL or 4GL. Functions like "parsing" are seldom attempted in other languages because they are so difficult. INTOUCH makes functions like "parsing" very easy.        dE RE F_ELEMENT_PRE This example demonstrates how easily you can break apart strings of data with INTOUCH. First, the example asks you for a DELIMITER (separator) to determine where each element begins and ends. The default delimiter is a comma. Second, the example asks you for a "DELIMITED STRING." This is a string of characters or group of characters separated by the delimiter you specified in the first question. The default is the comma-separated list "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday." The last question asks which element you would like to see. The default is element 3. If you take all of the defaults, the program tells you that you selected "Wednesday." The program then displays the single line of code needed to perform this entire function.        T@  4F_PRINT_ATTR_POST F_PRINT_ATTR_POST {INTOUCH's video attribute printing facilities allow you to create customized screens in a straightforward, simple manner.          I 4 RE F_PRINT_ATTR_PRE INTOUCH includes syntax to print data to the screen using video print attributes. There is no need to use obscure escape sequences or to call external software. The following video print attributes are supported: BLINK 3alternate between normal and low intensity BOLD !bold (high intensity) REVERSE 0reverse video UNDERLINE underlined WIDE wide character format PRINT BOLD: "HELLO" "PRINT BLINK, UNDERLINE: "GOODBYE"        4 POS_POST F_PRINT_POS_POST bINTOUCH's screen positioning functions allow you to place text anywhere on the screen with ease.          b 4 RE F_PRINT_POS_PRE -Positioning text on the screen is very easy with INTOUCH. There is no need to use obscure escape sequences or to call external software. Only a single, obvious statement is needed: PRINT AT row, column: "text_to_print" Or, this alternate syntax can be used to position the cursor: 4SET WINDOW: ROW row SET WINDOW: COLUMN column         _ $ SCAN_POST F_SCAN_POST |SCAN is an extremely powerful INTOUCH function. When applied to a database, SCAN allows very flexible data selection criteria. SCAN allows a variety of "Fuzzy Logic" data selection. For example, data that might have been entered and spelled incorrectly can be searched for using the flexibility of the SCAN function. SCAN can be used anywhere in any INTOUCH program.         H $RE F_SCAN_PRE yThe INTOUCH SCAN function provides a great deal of power and flexibility in scanning data. SCAN allows programmers to search through text for non-contiguous, partial patterns. Example: SCAN('ABCDEFG', 'BE') SCAN starts scanning for a B. When the B is found, SCAN looks for an E, beginning with the character following the B. When the E is found, the SCAN function returns the position of the B as the start of the pattern. EB would not be found because there is no B following the E. Programmers can utilize this function as a one-line command virtually anywhere in their INTOUCH code. This includes all of INTOUCH's powerful fourth generation sort and selection commands. The programming example demonstrates how SCAN is used to look up a contact in a vendor file when only part of the name is known. The name is stored in "last-name, first-name", format. The default values of ZRN,L in the example will find the name YZERMAN, LEAH D. In other languages this procedure would be very complex if not impossible. INTOUCH uses a simple, one-line function. Try the default. Then try some patterns of your own.      K$ET_POST F_SET_POST INTOUCH is a robust, complete language. It is specifically designed to avoid the need to call other languages or external routines. A large percentage of the cost of an application is the ongoing maintenance required. Single language applications are easier and more economical to maintain. These system commands are just a few of the examples of how INTOUCH makes it easy to develop complex applications in a single language.         $WRE F_SET_PRE "With INTOUCH's powerful SET SYSTEM functions, programs have direct access to set or change system information. INTOUCH programs can define logicals, create symbols, and set the default directory. Other languages resort to cumbersome external calls. INTOUCH has this functionality designed and built into the language. This example asks you for a symbol name and the text you would like the symbol to represent. The program then uses the INTOUCH "SET SYSTEM SYMBOL" command to create and load the symbol with the text you specified.        gmgB_UPDATE_POST DB_SORTING_POST F_ELEMENT_PRE INPUT_MENU_PRE PASS_PRE SYSUAF_POST T4D$ .m2mB_BASELINE_POST   RE IO_BASELINE_POST  RE  READ_POST  RE  DIM_POST   RE SCREEN_IO_POST   RE  UPDATE_POST   RE  WRITE_POST   RE DB_SEARCHING_POST $ RE $ LECTING_POST $ RE $ ORTING_POST $  RE $EXIT  F_ASK_POST $ RE $ DATE_POST D RE D ELEMENT_POST   RE  VAL_POST $ RE $ XECUTE_POST   RE INPUT_AREA_POST 4 RE 4MENU_MAIN_POST 4 RE 4 POP_POST 4 RE 4 ULL_POST  RE  SUB_POST  RE  MATH_POST 4 RE 4 PASS_POST  RE RINT_ATTR_POST 4 RE 4 POS_POST 4  RE 4 SCAN_POST $ RE $ET_POST $ RE $ WINDOW_POST   RE  RAP_POST  RE  HELP_TOPIC  MENU_ITEM  OVERVIEW  PRINT_OPTION ION .ss~DEMO.BCK+L+![INTOUCH_DEMO]INT_DEMO_HELP.DAT;1!   xm n TmF_INPUT_MENU_PULL_POST F_INPUT_MENU_PULL_POST INTOUCH makes it very easy to create pull-down menus. A pull-down menu can contain an unlimited number of items, because the menu bar scrolls left and right to bring additional items into view. Each menu item can call a sub-menu, and a sub-menu can call another sub-menu.         gRE F_INPUT_MENU_PULL_PRE "Pull-down menus are a popular and often very useful forms of input. INTOUCH makes it easy to create pull-down menus, and users favor them because, like pop-up menus, they require little effort. The user simply uses arrow keys to select the menu item and then presses the RETURN key.          SUB_POST F_INPUT_MENU_SUB_POST INTOUCH gives you the ability to set up menu systems organized into main menus and sub-menus. Any menu item can call a sub-menu, and any sub-menu item can call another sub-menu.          IRE F_INPUT_MENU_SUB_PRE It is often useful for a menu item to bring up a sub-menu. This is easily accomplished with INTOUCH menus. Using the MENU option of INTOUCH's INPUT statement, you can set up menu items to call sub-menus. Items on sub-menus can also call other sub-menus.         4 MATH_POST F_MATH_POST {INTOUCH's comprehensive selection of built-in mathematical functions add versatility and simplify your programming tasks.          I4RE F_MATH_PRE INTOUCH contains a variety of built-in, mathematical functions useful in business arithmetic, trigonometry, and calculus: Built-in arithmetic functions: ABS(num_expr) !absolute value CEIL(num_expr) -smallest integer >= num_expr FP(num_expr) !fractional part INT(num_expr) .largest real <= num_expr INTEGER(num_expr) integer value IP(num_expr) 4integer part (truncates) MAX(num_expr, num_expr) 0larger of two values MIN(num_expr, num_expr) 0lesser of two values MOD(num_expr, num_expr) <remainder of num_expr divided by num_expr REAL(num_expr) zreal or floating point value ROUND(num_expr, int_expr) rounds num_expr to int_expr decimal digits SGN(num_expr) "sign (0, +1, -1) SQR(num_expr) square root STR$(num_expr) "string representation of num_expr  VAL(num_str) treal representation of num_str Built-in functions used in trigonometry and calculus include: ACOS(num_expr) Iangle, in radians, whose cosine is num_expr ANGLE(num_expr, num_expr) =angle, in radians, from 0,0 of coordinates ASIN(num_expr) ;angle, in radians, whose sine is num_expr ATN(num_expr) /angle, in radians, of tangent COS(num_expr) 6cosine of angle specified in radians COT(num_expr) 'cotangent of num_expr CSC(num_expr) &cosecant of num_expr DEG(num_expr) 7degrees of angle specified in radians RAD(num_expr) 8radians of angle specified in degrees SEC((num_expr) $secant of num_expr SIN(num_expr) 4sine of angle specified in radians TAN(num_expr) <tangent of angle specified in radians COSH(num_expr) 0hyperbolic cosine of num_expr SINH(num_expr) .hyperbolic sine of num_expr TANH(num_expr) 2hyperbolic tangent of num_expr LOG(num_expr) 0natural logarithm of num_expr LOG2(num_expr) 0base 2 logarithm of num_expr LOG10(num_expr) common logarithm of num_expr  PASS_POST F_PASS_POST With the PASS statement, INTOUCH gives you a simple interface to execute system (DCL) commands. With INTOUCH, you can use simple DCL commands to queue files for printing and to access all system utilities. The PASS statement also allows you to directly run other applications without leaving your INTOUCH program. Examples of this include application programs, VMS Mail, Edit, Print Services and VMS command procedures.         RE F_PASS_PRE Typically, in applications that print information, the most convenient path to the printer is through the VMS queueing system. In most languages this requires calls to system or library services. With INTOUCH, you can directly perform system commands (DCL) with the PASS statement. This statement executes system (DCL) commands from within your INTOUCH procedures. You can print files, execute command procedures, and use any other system (DCL) commands to make your applications simpler and more maintainable. You can even run other application programs. PASS "SHOW USERS" The PASS command suspends processing of INTOUCH, executes the DCL SHOW USERS command, and continues the INTOUCH program when complete.       ms. PASS "SHOW USERS" The PASS command suspends processing of INTOUCH, executes the DCL SHOW USERS command, and continues the INTOUCH program when complete.       and more maintainable. You can even run other application programs. PASS "SHOW USERS" The PASS command suspends processing of INTOUCH, executes the DCL SHOW USERS command, and continues the INTOUCH program when complete.       tement executes system (DCL) commands from within your INTOUCH procedures. You can print files, execute command procedures, and use any other system (DCL) commands to make your applications simpler and more maintainable. You can even run other application programs. PASS "SHOW USERS" The PASS command suspends processing of INTOUCH, executes the DCL SHOW USERS command, and continues the INTOUCH program when complete.       ~DEMO.BCK+L+![INTOUCH_DEMO]INT_DEMO_HELP.DAT;1!   `R!*[INTOUCH_DEMO]INT_DEMO_HELP.DEF;1+,+.3/@ 4"34 T-L+0123KPWO45.6 :!7'h8ee9GHJ( 5USER:91:M&8| (2-5USER:91:M&8X| ( 335USER:91:M&8AN ~ SUBTOPIC Subtopic (nickname) 0003300032CHNN N$Y00YMD NN Subtopic (nickname) Subtopic (nickname) P,Short name -- usually last word of full key PUTEXT Text 0006502500CHNN N00YMD NN Text Text _Text of topic nUOPIC Topic 0000100032CHNN N00YMD NN Topic Topic ^ Topic name q ~DEMO.BCK+L+![INTOUCH_DEMO]INT_DEMO_HELP.DEF;1" T3>C 0000100033 00065 01537((!*[INTOUCH_DEMO]INT_DEMO_HELP.FDL;1+,+./@ 4@2-L+0123KPWO56 027zh8Jwe9GHJFILE# BEST_TRY_CONTIGUOUS Yes% ALLOCATION 150 @ NAME "TTI_INT_DEMO:INT_DEMO_HELP.DAT"' ORGANIZATION INDEXEDRECORD" BLOCK_SPAN no/ CARRIAGE_CONTROL carriage_return% FORMAT fixed$ SIZE 2580AREA 0# ALLOCATION 100# BEST_TRY_CONTIGUOUS yes" BUCKET_SIZE 16" EXTENSION 90AREA 1" ALLOCATION 10# BEST_TRY_CONTIGUOUS yes! BUCKET_SIZE 6! EXTENSION 3AREA 2" ALLOCATION 10# BEST_TRY_CONTIGUOUS yes! BUCKET_SIZE 6! EXTENSION 3KEY 0 " CHANGES no# DATA_AREA 0 " DUPLICATES no# INDEX_AREA 1 # LEVEL1_INDEX_AREA 1 ' NAME "TOPIC"" SEG0_LENGTH 32! SEG0_POSITION 0& TYPE stringKEY 1 # CHANGES yes# DATA_AREA 1 # DUPLICATES yes# INDEX_AREA 2 # LEVEL1_INDEX_AREA 2 * NAME "SUBTOPIC"" SEG0_LENGTH 32" SEG0_POSITION 32& TYPE string# NULL_KEY yes!*[INTOUCH_DEMO]INT_DEMO_HELP.STR;1+,+./@ 4QT-L+0123KPWO56vv'7?h81e9GHJSTR01ANQDATTTI_INT_DEMO:INT_DEMO_HELP.DAT RMS NNNNQDEFTTI_INT_DEMO:INT_DEMO_HELP.DEF NNNN$*[INTOUCH_DEMO]INT_DEMO_INDEXED.DEF;1+,+./@ 4"-L+0123KPWO56@"7Zh8QTf9GHJ0  >   u0DEVDISK:[INTOUCH_DEMO]  t`<<PGc2 - u0DEVDISK:[INTOUCH_DEMO]  t`<<P_` u0DEVDISK:[INTOUCH_DEMO]  t`<<PFNDATA * Data 0000501000CHNN NY00YMD NN Data Data  gLKEY * Key  0000100004CHYN NNNNYNNN00YMD  NN Key Key  h   & 00001 00005~DEMO.BCK+L+$[INTOUCH_DEMO]INT_DEMO_INDEXED.DEF;1"w $*[INTOUCH_DEMO]INT_DEMO_INDEXED.FDL;2+,+./@ 4B -L+0123KPWO56LK$L7h8f9GHJFILE# BEST_TRY_CONTIGUOUS Yes% ALLOCATION 150 B NAME "SYS$SCRATCH:INT_DEMO_INDEXED.TMP"' ORGANIZATION INDEXEDRECORD" BLOCK_SPAN no/ CARRIAGE_CONTROL carriage_return% FORMAT fixed$ SIZE 1255AREA 0# ALLOCATION 100# BEST_TRY_CONTIGUOUS yes" BUCKET_SIZE 10" EXTENSION 90AREA 1" ALLOCATION 10# BEST_TRY_CONTIGUOUS yes! BUCKET_SIZE 6! EXTENSION 3KEY 0 " CHANGES no# DATA_AREA 0 " DUPLICATES no# INDEX_AREA 1 # LEVEL1_INDEX_AREA 1 % NAME "KEY"! SEG0_LENGTH 4! SEG0_POSITION 0& TYPE string$*[INTOUCH_DEMO]INT_DEMO_INDEXED.STR;1+,+./@ 4QT-L+0123KPWO56`Wi'7eh8b"f9GHJSTR01ANQDATSYS$SCRATCH:INT_DEMO_INDEXED.TMP RMS NNNNQDEFTTI_INT_DEMO:INT_DEMO_INDEXED.DEF NNNN"*[INTOUCH_DEMO]INT_DEMO_LINK.COM;10+,yN./@ 4J-L+0123 KPWO56uf7; h8b-f9GHJ ,$! INT_DEMO_LINK.COM - Link all .OBJ modules$F$ write sys$output " Linking INTOUCH_DEMO 3GL benchmark modules..."$!$$ if f$getsyi("HW_MODEL") .gt. 1024$ then$ environ = "AXP"$ exe_type = ".EXE_AXP"$ else$ environ = "VAX"$ exe_type = ".EXE"$ endif$!&$ lib_file = "INT_DEMO_''environ'.OLB"$!0$ link/exe=int_demo_b_baseline_basic'exe_type' -1 'lib_file'/inc=int_demo_b_baseline_basic$mainJ$ if environ .eqs. "VAX" then define/user lnk$library sys$share:vaxcrtl,$ link/exe=int_demo_b_baseline_c'exe_type' -( 'lib_file'/inc=int_demo_b_baseline_c0$ link/exe=int_demo_b_baseline_cobol'exe_type' - 'lib_file'/inc=prog12$ link/exe=int_demo_b_baseline_fortran'exe_type' -2 'lib_file'/inc=int_demo_b_baseline_fortra$main3$ link/exe=int_demo_b_io_baseline_basic'exe_type' -2 'lib_file'/inc=int_demo_b_io_baseline_bas$mainJ$ if environ .eqs. "VAX" then define/user lnk$library sys$share:vaxcrtl/$ link/exe=int_demo_b_io_baseline_c'exe_type' -+ 'lib_file'/inc=int_demo_b_io_baseline_c3$ link/exe=int_demo_b_io_baseline_cobol'exe_type' - 'lib_file'/inc=prog25$ link/exe=int_demo_b_io_baseline_fortran'exe_type' - 'lib_file'/inc=for2,$ link/exe=int_demo_b_read_basic'exe_type' -- 'lib_file'/inc=int_demo_b_read_basic$main,$ link/exe=int_demo_b_read_cobol'exe_type' - 'lib_file'/inc=prog5.$ link/exe=int_demo_b_read_fortran'exe_type' - 'lib_file'/inc=for5-$ link/exe=int_demo_b_redim_basic'exe_type' -. 'lib_file'/inc=int_demo_b_redim_basic$main1$ link/exe=int_demo_b_screen_io_basic'exe_type' -2 'lib_file'/inc=int_demo_b_screen_io_basic$mainJ$ if environ .eqs. "VAX" then define/user lnk$library sys$share:vaxcrtl-$ link/exe=int_demo_b_screen_io_c'exe_type' -) 'lib_file'/inc=int_demo_b_screen_io_c1$ link/exe=int_demo_b_screen_io_cobol'exe_type' - 'lib_file'/inc=prog43$ link/exe=int_demo_b_screen_io_fortran'exe_type' -/ 'lib_file'/inc=int_demo_b_screen_io_fortran.$ link/exe=int_demo_b_update_basic'exe_type' -/ 'lib_file'/inc=int_demo_b_update_basic$main.$ link/exe=int_demo_b_update_cobol'exe_type' - 'lib_file'/inc=prog6-$ link/exe=int_demo_b_write_basic'exe_type' -. 'lib_file'/inc=int_demo_b_write_basic$main-$ link/exe=int_demo_b_write_cobol'exe_type' - 'lib_file'/inc=prog3/$ link/exe=int_demo_b_write_fortran'exe_type' -+ 'lib_file'/inc=int_demo_b_write_fortran$!$ exit&*[INTOUCH_DEMO]INT_DEMO_PROCEDURE.DAT;1+,+.r/@ 4! rsZ-L+0123 KPWOs5P6TЫ(7Zh8pJf9GHJ`g NAME q fZf g m RPh BASIC Print BASIC source code $ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.bas; BASIC  N2 _BASELINE $Calculate Image Activation Overhead ROUTINE BENCHMARK BENCHMARK 2"tti_int_demo:int_demo_b_baseline_ "INTOUCH, C, COBOL, FORTRAN, BASIC B_BASELINE_PRE LINE B_BASELINE_POST ELINE E N2 IO_BASELINE Calculate File Open Overhead ROUTINE BENCHMARK BENCHMARK 2$tti_int_demo:int_demo_b_io_baseline "INTOUCH, C, COBOL, FORTRAN, BASIC B_IO_BASELINE_PRE B_IO_BASELINE_POST  KN2READ Reading Data Structures $ROUTINE BENCHMARK BENCHMARK 2tti_int_demo:int_demo_b_read INTOUCH, COBOL, FORTRAN, BASIC  B_READ_PRE ' B_READ_POST D EIO N2DIM Redimension an Array 'ROUTINE BENCHMARK BENCHMARK 2tti_int_demo:int_demo_b_redim INTOUCH, BASIC # B_REDIM_PRE M  B_REDIM_POST IM ENON_ION2 SCREEN_IO I/O to the Screen *ROUTINE BENCHMARK BENCHMARK 2"TTI_INT_DEMO:int_demo_B_SCREEN_IO "INTOUCH, C, COBOL, FORTRAN, BASIC B_SCREEN_IO_PRE EN_IO B_SCREEN_IO_POST EEN_IO ENON_ION2ORT Sorting Data Records 'ROUTINE BENCHMARK BENCHMARK 2tti_int_demo:int_demo_b_sort INTOUCH, BASIC # B_SORT_PRE ' B_SORT_POST T EIO N2UPDATE Updating Data Records &ROUTINE BENCHMARK BENCHMARK 2tti_int_demo:int_demo_b_update INTOUCH, COBOL, BASIC  B_UPDATE_PRE TE B_UPDATE_POST ATE EIO N2WRITE Populating an Indexed File !ROUTINE BENCHMARK BENCHMARK 2tti_int_demo:int_demo_b_write_ INTOUCH, COBOL, FORTRAN, BASIC  B_WRITE_PRE E  B_WRITE_POST TE )create/fdl=tti_int_demo:int_demo_indexed IO N2COBOL Print COBOL source code $ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.cob COBOL L  KN2                 F_SET_POST  K3INTOUCH Print INTOUCH source code "ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.int; INTOUCH  3 FMAIL VMS Mail 3COMMAND MAIL (NONE   3 Z OVERVIEW INTOUCH overview +ROUTINE OVERVIEW 3c OVERVIEW  3pPROCEDURE_LIST Procedure File List (#ROUTINE REPORT PROCEDURE_LIST COMMON   3b MAINT Procedure File -ROUTINE INPUT PROCEDURE_MAINT COMMON   3{VAX_C Print C source code (ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.c C P  K3GMS VMS Facilities -COMMAND $ +NONE   3             3ET "SET/CHANGE VMS System Information ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_set H F_SET_PRE  F_SET_POST  K3INTOUCH Print INTOUCH source code "ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.int; INTOUCH  3 FMAIL VMS Mail 3COMMAND MAIL (NONE   3 Z OVERVIEW INTOUCH overview +ROUTINE OVERVIEW 3c OVERVIEW  3pPROCEDURE_LIST Procedure File List (#ROUTINE REPORT PROCEDURE_LIST COMMON   3b MAINT Procedure File -ROUTINE INPUT PROCEDURE_MAINT COMMON   3{VAX_C Print C source code (ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.c C P  K3GMS VMS Facilities -COMMAND $ +NONE   3      M N ! DB_SEARCHING Searching a Data Base by Key ROUTINE FUNCTION FUNCTION 3#tti_int_demo:int_demo_db_searching ADB_SEARCHING_PRE DB_SEARCHING_POST  KN2 LECTING Selecting Data Base Information ROUTINE FUNCTION FUNCTION 3#tti_int_demo:int_demo_db_selecting ADB_SELECTING_PRE DB_SELECTING_POST  KN2 ORTING Sort Data Base Information !ROUTINE FUNCTION FUNCTION 3!tti_int_demo:int_demo_db_sorting CDB_SORTING_PRE DB_SORTING_POST  KN2FORTRAN Print FORTRAN source code "ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.for; FORTRAN  N2_ASK Ask for VMS System Information ROUTINE FUNCTION FUNCTION 3TTI_INT_DEMO:INT_DEMO_F_ASK H F_ASK_PRE  F_ASK_POST  KN2 DATE Date Functions -ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_date G F_DATE_PRE  F_DATE_POST  KN2ELEMENT Parsing String Information !ROUTINE FUNCTION FUNCTION 3 TTI_INT_DEMO:INT_DEMO_F_ELEMENT DF_ELEMENT_PRE ENT F_ELEMENT_POST MENT E N2 INPUT_AREA Input of Text from Area $ROUTINE FUNCTION FUNCTION 3#tti_int_demo:int_demo_f_input_area AF_INPUT_AREA_PRE F_INPUT_AREA_POST  KN2 MENU_MAIN Main Menus 1ROUTINE FUNCTION FUNCTION 3(tti_int_demo:int_demo_f_input_menu_main <F_INPUT_MENU_MAIN_PRE F_INPUT_MENU_MAIN_POST  KN2  POP Pop-up Menus /ROUTINE FUNCTION FUNCTION 3'tti_int_demo:int_demo_f_input_menu_pop =F_INPUT_MENU_POP_PRE F_INPUT_MENU_POP_POST  KN2 ULL Pull-Down Menus ,ROUTINE FUNCTION FUNCTION 3(tti_int_demo:int_demo_f_input_menu_pull <F_INPUT_MENU_PULL_PRE F_INPUT_MENU_PULL_POST  KN2  SUB Menus with Sub-menus 'ROUTINE FUNCTION FUNCTION 3'tti_int_demo:int_demo_f_input_menu_sub =F_INPUT_MENU_SUB_PRE F_INPUT_MENU_SUB_POST  KN2 MATH Built-in Mathematical Functions ROUTINE FUNCITON FUNCTION 3tti_int_demo:int_demo_f_math G F_MATH_PRE  F_MATH_POST  KN2      )ROUTINE FUNCTION FUNCTION 3"tti_int_demo:int_demo_f_print_pos BF_PRINT_POS_PRE F_PRINT_POS_POST  KN2SCAN ,SCAN for Partial and/or Non-contiguous Data ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_scan G F_SCAN_PRE  F_SCAN_POST  KN2ET "SET/CHANGE VMS System Information ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_set H F_SET_PRE  F_SET_POST  KN2 WINDOW Creating Windows +ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_window E F_WINDOW_PRE F_WINDOW_POST  KY2 RAP -Word-Wrap Text given a Left and Right Margin ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_wrap G F_WRAP_PRE  F_WRAP_POST  KN2 INTOUCH Print INTOUCH source code "ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.int; INTOUCH  N2 KMAIL VMS Mail 3COMMAND MAIL (NONE 1 1 N2 _ OVERVIEW INTOUCH overview +ROUTINE OVERVIEW 31 1 OVERVIEW  N2 uPROCEDURE_LIST Procedure File List (#ROUTINE REPORT PROCEDURE_LIST COMMON 1 1 N2 g MAINT Procedure File -ROUTINE INPUT PROCEDURE_MAINT COMMON 1 1 N2 TSYSTEM VMS System Commands (COMMAND $ +none   L2|VAX_C Print C source code (ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.c C P  KN2      M F_PASS +PASS Commands to the System (DCL commands) ROUTINE FUNCTION FUNCTION 3TTI_INT_DEMO:INT_DEMO_F_PASS G F_PASS_PRE ' F_PASS_POST S E N2 RINT_ATTR !Print to Screen Using Attributes ROUTINE FUNCTION FUNCTION 3#tti_int_demo:int_demo_f_print_attr AF_PRINT_ATTR_PRE F_PRINT_ATTR_POST  KN2 POS Cursor Positioning )ROUTINE FUNCTION FUNCTION 3"tti_int_demo:int_demo_f_print_pos BF_PRINT_POS_PRE F_PRINT_POS_POST  KN2SCAN ,SCAN for Partial and/or Non-contiguous Data ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_scan G F_SCAN_PRE  F_SCAN_POST  KN2ET "SET/CHANGE VMS System Information ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_set H F_SET_PRE  F_SET_POST  KN2 WINDOW Creating Windows +ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_window E F_WINDOW_PRE F_WINDOW_POST  KY2 RAP -Word-Wrap Text given a Left and Right Margin ROUTINE FUNCTION FUNCTION 3tti_int_demo:int_demo_f_wrap G F_WRAP_PRE  F_WRAP_POST  KN2INTOUCH Print INTOUCH source code "ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.int; INTOUCH  N2 KMAIL VMS Mail 3COMMAND MAIL (NONE 1 1 N2 _ OVERVIEW INTOUCH overview +ROUTINE OVERVIEW 31 1 OVERVIEW  N2 uPROCEDURE_LIST Procedure File List (#ROUTINE REPORT PROCEDURE_LIST COMMON 1 1 N2 g MAINT Procedure File -ROUTINE INPUT PROCEDURE_MAINT COMMON 1 1 N2  TSYSTEM VMS System Commands (COMMAND $ +none   L2|VAX_C Print C source code (ROUTINE SOURCE SOURCE 5tti_int_demo:int_demo_*.c C P  KN2`~DEMO.BCK+L+&[INTOUCH_DEMO]INT_DEMO_PROCEDURE.DAT;1! r@|1g"gCOBOL F_MATH   ~DEMO.BCK+L+&[INTOUCH_DEMO]INT_DEMO_PROCEDURE.DAT;1! ro&*[INTOUCH_DEMO]INT_DEMO_PROCEDURE.DEF;1+,+./@ 4"-L+0123 KPWO56>(7"h8,x\f9GHJ6  >  long_name W2 -first  Y&*BASELINE_TYPE * 1Baseline type (IO/NON_IO) 0043100006CHNN N<Y00YMD NN Baseline type (IO/NON_IO) Baseline,Type  ^DESC * Procedure description 0002100060CHNNN%00YMDNNProcedure description Procedure description NProcedure description 0 ISPATCH_TEXT * Dispatch text 0010100045CHNNNY00YMDNNDispatch text Dispatch text VDispatch text 8 YPE * 1Dispatch type (ROUTINE, etc.) 0008100010CHNNNLY00YMDNNDispatch type (ROUTINE, etc.) Dispatch type (ROUTINE, etc.) FDispatch type (ROUTINE, etc.) ( LANGUAGES * Benchmark languages 0021100050CHNNN$Y00YMDNNBenchmark languages Benchmark languages PBenchmark languages 2~NAME * Procedure name 0000100020CHNNNY00YMDNNProcedure name Procedure name UProcedure name 7PARAMETER_TEXT * Parameter text 0014600015CHNNN00YMDNNParameter text Parameter text UParameter text 7OST_EXECUTION_HELP_TOPIC * 1Post-execution help topic 0031100032CHNN NHY00YMD NN Post-execution help topic Post-execution help topic  R RE_EXECUTION_COMMAND * 1Command to execute before demo0036100070CHNN NL00YMD NN Command to execute before demoCommand to execute before demo  M  HELP_TOPIC * Pre-execution help topic 0026100032CHNN N)Y00YMD NN Pre-execution help topic Pre-execution help topic  S OGRAM_NAME * Program to run 0016100050CHNNN00YMDNNProgram name  Program name WProgram to run 7REPAINT * repaint after demo (Y/N) 0043700001CHNN N)Y00YMD NN repaint after demo (Y/N) repaint after demo (Y/N)  S OUTINE_TYPE * 1Routine type (INPUT, etc.) 0009100010CHNNNIY00YMDNNRoutine type (INPUT, etc.) Routine type (INPUT, etc.) IRoutine type (INPUT, etc.) +    00001 00021 00081 00091 00101 00146 00161 00211 00261  0031100361   00431 00437 &*[INTOUCH_DEMO]INT_DEMO_PROCEDURE.FDL;1+,+./@ 4E-L+0123KPWO56@A!g'7n3h8o gf9GHJFILE% ALLOCATION 150 E NAME "TTI_DSS_DATA:INT_DEMO_PROCEDURE.DAT"' ORGANIZATION INDEXEDRECORD" BLOCK_SPAN no/ CARRIAGE_CONTROL carriage_return% FORMAT fixed$ SIZE 1000AREA 0# ALLOCATION 100# BEST_TRY_CONTIGUOUS yes! BUCKET_SIZE 8" EXTENSION 90AREA 1" ALLOCATION 10# BEST_TRY_CONTIGUOUS yes! BUCKET_SIZE 6! EXTENSION 3KEY 0 " CHANGES no# DATA_AREA 0 " DUPLICATES no# INDEX_AREA 1 # LEVEL1_INDEX_AREA 1 & NAME "NAME"" SEG0_LENGTH 20! SEG0_POSITION 0& TYPE string&*[INTOUCH_DEMO]INT_DEMO_PROCEDURE.STR;1+,+./@ 4QT-L+0123KPWO56 n'7>h8pf9GHJSTR01ANQDATTTI_INT_DEMO:INT_DEMO_PROCEDURE.DAT RMS NNNNQDEFTTI_INT_DEMO:INT_DEMO_PROCEDURE.DEF NNNN *[INTOUCH_DEMO]INT_DEMO_VAX.OLB;1+,$./ 4-L+0123 KPWO56 P7708CSf9GHJ4% VAX-11 Librarian V04-00/@ stdin T stdout> T stderr T:`S SYS$COMMON:[SYSLIB]VAXCDEF.TLB;1stddef9g SYS$COMMON:[SYSLIB]VAXCDEF.TLB;1stdioF/r&wp2DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_C.C;3     FOPEN MAINC$MAIN)$CODE$DATASTDINSTDOUTSTDERR$CHAR_STRING_CONSTANTS]Psys$scratch:tti_vendor.tmpPrP^C$MAIN\߬lFOPENPPww @11T01/FOR20116-Dec-1994 16:1516-Dec-1994 16:15VAX FORTRAN V5.6-119 FOR2kQN&w:DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_IO_BASELINE_FORTRAN.FOR;3 "Psys$scratch:tti_vendor.tmp FOR2xP FOR$OPEN@PH[FOR$OPEN FOR$CLOSEP HFOR2  HFOR$OPEN FOR$CLOSE$CODE$PDATA($LOCALwwB16 DINT_DEMO_B_READ_BASIC$MAIN 16-DEC-1994 16:15 VAX BASIC V3.4G!INT_DEMO_B_READ_BASIC$MAIN!INT_DEMO_B_READ_BASIC$MAINN$PDATA$CODE$ARRAY$DESC VENDOR_MAP' INT_DEMO_B_READ_BASIC$MAIN OTS$LINKAGE BAS$LINKAGE BAS$INIT_R8 BAS$END_R8 BAS$CONTINUEBAS$ERR BAS$EXIT_HNDL BAS$RESUME BAS$PRINT BAS$IO_END BAS$OUT_CL_V_BBAS$OUT_T_DX_SBAS$OPENBAS$GETPn\XnnnINT_DEMO_B_READ_BASIC Records read:On record:sys$scratch:tti_vendor.tmpV"P  s WHOLE_REC$NAME$SEX$BDATE$STREET$%CITY$ CZIP$ OETHNIC$XPARENT$YPHONE$ DqBPHONE$ {EPHONE$  BALANCE$ oR kI% DONEHEXE&w1DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_READ_BASIC.BAS;3  '%PϞRPPQ BAS$INIT_R8ߞݏ+^,n+nݏ ݏ7,^BAS$OPEN7^ՏPBAS$GET֫k@oQoB/Po BAS$PRINTBAS$OUT_T_DX_Sݫk BAS$OUT_L_V_B BAS$IO_END,BAS$ERRNP\Q\#  BAS$CONTINUE BAS$EXIT_HNDL BAS$RESUME BAS$PRINTBAS$OUT_T_DX_Sݫk BAS$OUT_L_V_B BAS$IO_ENDP BAS$END_R8P$! wwF1I҈01/FOR50116-Dec-1994 16:1616-Dec-1994 16:16VAX FORTRAN V5.6-119 FOR5dJGN3DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_READ_FORTRAN.FOR;5 %PPsys$scratch:tti_vendor.tmpOn record:Records read:    FOR5P FOR$OPEN@      G  %PH[FOR$OPENԫ~2 FOR$READ_SF840 FOR$IO_T_DSV<8 FOR$IO_T_DSWD@ FOR$IO_T_DS]LH FOR$IO_T_DS{TP FOR$IO_T_DS\X FOR$IO_T_DSd` FOR$IO_T_DSlh FOR$IO_T_DStp FOR$IO_T_DS|x FOR$IO_T_DS˄ˀ FOR$IO_T_DSˌˈ FOR$IO_T_DS FOR$IO_END֫kkk~ FOR$WRITE_SLː FOR$IO_T_DSݫ FOR$IO_L_V FOR$IO_ENDH1~ FOR$WRITE_SL˘ FOR$IO_T_DSݫ FOR$IO_L_V FOR$IO_ENDP HFOR5  R RTEST_FILE_RECORD@ NAME SEX BDATE (STREET CITY  xZIP  ETHNIC PARENT PHONE  BPHONE  (EPHONE  xBALANCE0,111 REC  TFOR$OPEN)I 100 "200|L$CODEI$PDATAh$LOCAL FOR$IO_END FOR$IO_L_V FOR$IO_T_DS FOR$READ_SF FOR$WRITE_SLP P((LwwJ1 EINT_DEMO_B_REDIM_BASIC$MAIN 16-DEC-1994 16:16 VAX BASIC V3.4I"INT_DEMO_B_REDIM_BASIC$MAIN"INT_DEMO_B_REDIM_BASIC$MAIN;$PDATA$CODE$ARRAY$DESC( INT_DEMO_B_REDIM_BASIC$MAIN OTS$LINKAGE BAS$LINKAGE BAS$INIT_R8 BAS$END_R8 BAS$RT_DIM BAS$RETRY BAS$PRINT BAS$IO_ENDBAS$OUT_T_DX_BP\X@Kooo@oINT_DEMO_B_REDIM_BASIC   Array redimension from 1 to 4000 started...mmP+ gZ c CUR_ELEMENTS _I [Z% WZ5 S INCREMENT  TABLE_SAVE 3TABLEIFF2DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_REDIM_BASIC.BAS;2  !%PϞRPPQ BAS$INIT_R8枯P"SNWЫ[Lݩ3 BAS$RT_DIMЫ[ݩ BAS$RT_DIM BAS$PRINTBAS$OUT_T_DX_B BAS$IO_ENDP_J_\ \KO\ЫCXP_Lh1C_cJc\\ݩ BAS$RT_DIMPckPg@gQgk;Jg\ \KO\ЫCXJgW W+/WЫ#VPLhGf@gQgkBgAcSgJg\\ݩ3 BAS$RT_DIMPcoPg@gQgo;Jg\ \+/\Ы#XJgW WKOWЫCVPLhGf@gQgoBg BAS$RETRY@_Q_zF1B_P BAS$END_R8P$! wwN1  IINT_DEMO_B_SCREEN_IO_BASIC$MAIN 16-DEC-1994 16:17 VAX BASIC V3.4Q&INT_DEMO_B_SCREEN_IO_BASIC$MAIN&INT_DEMO_B_SCREEN_IO_BASIC$MAIN;$PDATA`$CODE$ARRAY$DESC, INT_DEMO_B_SCREEN_IO_BASIC$MAINo OTS$LINKAGE BAS$LINKAGE BAS$INIT_R8 BAS$END_R8 BAS$PRINT BAS$IO_END BAS$OUT_L_V_SPs\X sss||tINT_DEMO_B_SCREEN_IO_BASIC h oI%MJ5-6DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_BASIC.BAS;1  %PϞRPPQ BAS$INIT_R8ro BAS$PRINTݫo BAS$OUT_L_V_S BAS$IO_ENDo׫oP BAS$END_R8P    `wwIO_BASIC$MAIN/ DAN INT_DEMO_B_SCREEN_IO_C5IAU DAN INT_DEMO_B_SCREEN_IO_FORTRAN5[" DAN INT_DEMO_B_UPDATE_BASIC$MAIN4|: DAN INT_DEMO_B_WRITE_BASIC$MAIN1 BP DAN INT_DEMO_B_WRITE_FORTRAN DAN PROG1 m DAN PROG2)( DAN PROG5)  DAN PROG4( DAN PROG6ɥ0 DAN PROG3 Q1 V1.0CINT_DEMO_B_SCREEN_IO_CV1.016-DEC-1994 16:17VAX C V3.2-044ORINT_DEMO_B_SCREEN_IO_C main main_1+ i$Q VSD`30DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_C.C;1 bPRINTF MAINC$MAINQ$CODE$DATA$CHAR_STRING_CONSTANTSuP%3d P P^C$MAINRݭbPRINTFzP{PQPP\\ ߢPRINTFPww S1&O01GINT_DEMO_B_SCREEN_IO_FORTRAN0116-Dec-1994 16:1816-Dec-1994 16:18VAX FORTRAN V5.6-119&#INT_DEMO_B_SCREEN_IO_FORTRANiOLss}38DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_SCREEN_IO_FORTRAN.FOR;1 P+(#INT_DEMO_B_SCREEN_IO_FORTRAN_PH[k~ FOR$WRITE_SFk FOR$IO_L_V FOR$IO_ENDkP) HINT_DEMO_B_SCREEN_IO_FORTRAN    100I\8$CODE$PDATA$LOCAL FOR$IO_END FOR$IO_L_V FOR$WRITE_SF 8wwU1iU" FINT_DEMO_B_UPDATE_BASIC$MAIN 16-DEC-1994 16:18 VAX BASIC V3.4K#INT_DEMO_B_UPDATE_BASIC$MAIN#INT_DEMO_B_UPDATE_BASIC$MAINN$PDATAb$CODE$ARRAY $DESC VENDOR_MAP) INT_DEMO_B_UPDATE_BASIC$MAIN OTS$LINKAGE BAS$LINKAGE BAS$INIT_R8 BAS$END_R8BAS$RSET BAS$NUM1_F BAS$VAL_F BAS$CONTINUEBAS$ERR BAS$EXIT_HNDL BAVS$RESUME BAS$PRINT BAS$IO_END BAS$OUT_L_V_BBAS$OUT_T_DX_SBAS$OPENBAS$GET BAS$UPDATEPp\XpppINT_DEMO_B_UPDATE_BASIC Records updated:On record:sys$scratch:tti_vendor.tmpV,P u WHOLE_REC$NAME$SEX$BDATE$STREET$%CITY$ CZIPW$ OETHNIC$XPARENT$YPHONE$ qBPHONE$ {EPHONE$  BALANCE$ oZ kR gI% %DONEJG+'w^3DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_UPDATE_BASIC.BAS;3  *%PϞRPPQ BAS$INIT_R8ߞݏ+^,n+nݏ ݏ7,^BAS$OPEN7^Տ1BAS$GET֫g@kQkB/Pk BAS$PRINTBAS$OUT_T_DX_Sݫg BAS$OUT_L_V_B BAS$IO_END BAS$VAL_FPPoAoHC\P\~ BAS$NUM1_FBAS$RSET BAS$UPDATE1d,BAS$ERRNP\Q\#  BAS$CONTINUE BAS$EXIT_HNDL BAS$RESUME BAS$PRINTBAS$OUT_T_DX_Sݫg BAS$OUT_L_V_B BAS$IO_ENDP BAS$END_R8P'$ bwwY1|: EINT_DEMO_B_WRITE_BASIC$MAIN 16-DEC-1994 16:19 VAX BASIC V3.4I"INT_DEMO_B_WRITE_BASIC$MAIN"INT_DEMO_B_WRITE_BASIC$MAINM$PDATA$CODE$ARRAY($DESC INDEX_MAP( INT_DEMO_B_WRITE_BASIC$MAIN OTS$LINKAGE BAS$LINKAGE BAS$INIT_R8 BAS$END_R8 STR$CONCATBAS$RSET BAS$NUM1_F BAS$PRINT BAS$IO_END BAS$OUT_F_V_BBAS$O~DEMO.BCK$L+ [INTOUCH_DEMO]INT_DEMO_VAX.OLB;1YZUT_T_DX_SBAS$OUT_T_DX_BBAS$OPEN BAS$CLOSEBAS$PUT STR$COPY_R_R8Po\XoooINT_DEMO_B_WRITE_BASIC Records written:DATA DATA DATA DATA Populating file...sys$scratch:int_demo_indexed.tmpCreating Indexed file...5P ~KEY$DATA$ oR kIc THE_DATA$IFX$L"2DEVDI[SK:[INTOUCH_DEMO]INT_DEMO_B_WRITE_BASIC.BAS;2  $%PϞRPPQ BAS$INIT_R8 BAS$PRINTBAS$OUT_T_DX_B BAS$IO_ENDݏ+^,n+nݏݏ7,s߮BAS$OPEN7^ BAS$PRINTBAS$OUT_T_DX_B BAS$IO_END2QR~cP STR$COPY_R_R8cc STR$CONCATc STR$CONCATc STR$CONCATcc STR$CONCATcc STR$CONCATc STR$CONCATc STR$CONCATcc STR$CONCATccc STR$CONCATPk@oQoB0Po BAS$PRINTBAS$OUT_T_DX_SPk~ BAS$OUT_F_V_B BAS$IO_ENDPk~ BAS$NUM1_F BAS$RSET,cg BAS$PUT@kQkHD1wBk BAS$CLOSEP BAS$END_R8P$!  ww]1iCAP01CINT_DEMO_B_WRITE_FORTRAN0116-Dec-1994 16:1916-Dec-1994 16:19VAX FORTRAN V5.6-119"INT_DEMO_B_WRITE_FORTRANeKH̹$L4DEVDISK:[INTOUCH_DEMO]INT_DEMO_B_WRITE_FORTRAN.FOR;3 ePCreating Indexed file...sys$scratch:int_demo_indexed.tmpPopulating file...Records written:$INT_DEMO_B_WRITE_FORTRAN\P   FOR$OPE^N@  9KP ! mcl_line$ = raw, unprocessed .MCL file line> ! err_syntax% = mcl_err% value for syntax error ! ! RESULT:G ! mcl_err% = error number if line is incomprehensible !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_process_mcl_line& z1$ = ltrim$(mcl_line$)[1:1] select case z1$ case "" ! skip blank lines case "!" ! skip comment lines case "$"$ menu_process_mcl_command case "%"& menu_process_mcl_directive case else$ mcl_err% = err_syntax% ! menu_report_mcl_error end select end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%9 ! M E N U _ P R O C E S S _ M C L _ C O M M A N DI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !. ! Process MCL lines that are commands.' ! These lines begin with a "$". ! ! EXPECTED:E ! mcl_line$ = .MCL file line which begins with a "$"F ! nolead% = edit$() param to discard leading spacesA ! ucase% = edit$() param to uppercase lettersA ! err_bad_cmd% = mcl_err% value for invalid command ! ! RESULT:> ! mcl_err% = error number if unknown command !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( routine menu_process_mcl_commandD z1$ = element$(edit$(mcl_line$, nolead% + ucase%), 1, " ") select case z1$ case "$MENU"% menu_process_command_menu case "$HEADING"( menu_process_command_heading case "$TITLE"& menu_process_command_title case "$TEXT"% menu_process_command_text case "$ITEM"% menu_process_command_item case "$SPLIT"& menu_process_command_split case "$END"$ menu_process_command_end case else# mcl_err% = err_bad_cmd%! menu_report_mcl_error end select end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%; ! M E N U _ P R O C E S S _ C O M M A N D _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !" ! Process a $MENU command. ! ! EXPECTED:1 ! mcl_line$ = .MCL file text line= ! err_syntax% = mcl_err% value for syntax errorE ! nolead% = edit$() param to discard leading spacesC ! noextra% = edit$() param to discard extra spaces@ ! ucase% = edit$() param to uppercase lettersF ! notrail% = edit$() param to discard trailing spaces ! ! RESULT:E ! do_end% = set on (we will need to process a $END)I ! (we do this in case we don't ever find one)' ! cur_menu$ = menu name6 ! item_nbr% = 0% = item number/counterG ! item_idz$ = "" = string of unique item IDs (per menu)$ ! I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%) routine menu_process_command_menu" menu_process_command_end do_end% = trueH z1$ = edit$(mcl_line$, nolead% + noextra% + ucase% + notrail%)+ if elements(z1$, " ") <> 2 then# mcl_err% = err_syntax% ! menu_report_mcl_error exit routine end if5 cur_menu$ = z1$[len("$MENU ") + 1:len(z1$)]+ menu_load_arrays_for_command_menu item_nbr% = 0% item_idz$ = "" end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%K ! M E N U _ L O A D _ A R R A Y S _ F O R _ C O M M A N D _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !. ! Load the arrays for a $MENU command. ! ! EXPECTED:- ! cur_menu$ = name of this menu !8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name- ! ! column 2 = command< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 !8 ! menu_menu$(menu_row_max%, menu_col_max%)/ ! ! column 1 = menu name2 ! ! column 2 = menu headingB ! ! column 3 = beginning MENU_INFO$(,) slot? ! ! column 4 = ending MENU_INFO$(,) slotL ! ! column 5 = "N" if all numbered items on this menu ! ! RESULT:. ! menu_menu_slot% is incremented- ! menu_info$(,) array is loaded- ! menu_menu$(,) array is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%1 routine menu_load_arrays_for_command_menuB menu_increment_menu_info_slot ! returns MENU_INFO_SLOT%4 menu_info$(menu_info_slot%, 1) = cur_menu$2 menu_info$(menu_info_slot%, 2) = "$MENU"- menu_info$(menu_info_slot%, 3) = ""- menu_info$(menu_info_slot%, 4) = ""- menu_info$(menu_info_slot%, 5) = ""/ menu_menu_slot% = menu_menu_slot% + 14 menu_menu$(menu_menu_slot%, 1) = cur_menu$- menu_menu$(menu_menu_slot%, 2) = ""@ menu_menu$(menu_menu_slot%, 3) = str$(menu_info_slot%)- menu_menu$(menu_menu_slot%, 4) = ""- menu_menu$(menu_menu_slot%, 5) = "" end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%A ! M E N U _ P R O C E S S _ C O M M A N D _ H E A D I N GI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !% ! Process a $HEADING command. ! ! EXPECTED:/ ! mcl_line$ = .MCL file text line( ! cur_menu$ = current menuC ! nolead% = edit$() param to discard leading spacesA ! noextra% = edit$() param to discard extra spaces !8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name- ! ! column 2 = command< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 !8 ! menu_menu$(menu_row_max%, menu_col_max%)/ ! ! column 1 = menu name2 ! ! column 2 = menu headingB ! ! column 3 = beginning MENU_INFO$(,) slot? ! ! column 4 = ending MENU_INFO$(,) slotL ! ! column 5 = "N" if all numbered items on this menu ! ! RESULT:' ! menu_info$(,) is loaded' ! menu_menu$(,) is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%, routine menu_process_command_heading4 z1$ = edit$(mcl_line$, nolead% + noextra%)2 z2$ = z1$[len("$HEADING ") + 1:len(z1$)]' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$5 menu_info$(menu_info_slot%, 2) = "$HEADING"- menu_info$(menu_info_slot%, 3) = "". menu_info$(menu_info_slot%, 4) = z2$- menu_info$(menu_info_slot%, 5) = "". menu_menu$(menu_menu_slot%, 2) = z2$ end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%= ! M E N U _ P R O C E S S _ C O M M A N D _ T I T L EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !# ! Process a $TITLE command. ! ! EXPECTED:/ ! mcl_line$ = .MCL file text line( ! cur_menu$ = current menuC ! nolead% = edit$() param to discard leading spacesA ! noextra% = edit$() param to discard extra spaces ! ! RESULT:' ! menu_info$(,) is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%* routine menu_process_command_title4 z1$ = edit$(mcl_line$, nolead% + noextra%)0 z2$ = z1$[len("$TITLE ") + 1:len(z1$)]' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$3 menu_info$(menu_info_slot%, 2) = "$TITLE"- menu_info$(menu_info_slot%, 3) = "". menu_info$(menu_info_slot%, 4) = z2$- menu_info$(menu_info_slot%, 5) = "" end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%; ! M E N U _ P R O C E S S _ C O M M A N D _ T E X TI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !" ! Process a $TEXT command. ! ! EXPECTED:2 ! mcl_line$ = .MCL file text line+ ! cur_menu$ = current menuA ! err_bad_cmd% = mcl_err% value for invalid command ! ! ! RESULT:' ! menu_info$(,) is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%) routine menu_process_command_text& z1% = pos(mcl_line$, '"', 1)Q if z1% = 0 then z1% = pos(mcl_line$, "'", 1) ! find beginning quote if z1% = 0 then z2% = -1% else= z2% = pos(mcl_line$, mcl_line$[z1%:z1%], z1% + 1) end if9 ! find ending quote (if we had a beginning) if z2% = 0 then# mcl_err% = err_bad_cmd%! menu_report_mcl_error exit routine end if1 text_text$ = mcl_line$[z1% + 1:z2% - 1]* menu_load_array_for_command_text end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%I ! M E N U _ L O A D _ A R R A Y _ F O R _ C O M M A N D _ T E X TI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !- ! Load the array for a $TEXT command. ! ! EXPECTED:- ! cur_menu$ = current menu name( ! text_text$ = text string ! ! RESULT:; ! menu_info$(,) is loaded for a $TEXT command !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0 routine menu_load_array_for_command_text' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$2 menu_info$(menu_info_slot%, 2) = "$TEXT"- menu_info$(menu_info_slot%, 3) = ""5 menu_info$(menu_info_slot%, 4) = text_text$- menu_info$(menu_info_slot%, 5) = "" end routine  I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%; ! M E N U _ P R O C E S S _ C O M M A N D _ I T E MI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !0 ! Process a $ITEM or $ITEM MENU command. ! ! EXPECTED:1 ! mcl_line$ = MCL file text lineA ! err_bad_cmd% = mcl_err% value for invalid commandF ! nolead% = edit$() param to discard leading spacesD ! noextra% = edit$() param to discard extra spacesA ! ucase% = edit$() param to uppercase lettersG ! notrail% = edit$() param to discard trailing spaces ! ! RESULT:3 ! item_line$ = massaged MCL_LINE$C ! item_elements% = number of "elements" in ITEM_LINE$6 ! mcl_err% = error number if any- ! I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%) routine menu_process_command_itemO item_line$ = edit$(mcl_line$, nolead% + noextra% + ucase% + notrail%)4 item_elements% = elements(item_line$, " ")3 if item_line$[1:10] = "$ITEM MENU" then) if item_elements% >= 3 then menu_item_menu else& mcl_err% = err_bad_cmd% # menu_report_mcl_error end if' else ! $ITEMD if (item_elements% = 2) or (item_elements% = 3) then menu_item_item else% mcl_err% = err_bad_cmd%# menu_report_mcl_error end if end if end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M E N U _ I T E M _ I T E MI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !C ! Process a $ITEM command in either of the following forms: !) ! $ITEM item-name ! $ITEM item-name ! ! EXPECTED:2 ! cur_menu$ = current menu nameC ! item_elements% = number of "elements" in ITEM_LINE$ !  ! RESULT:; ! item_info$(,) is loaded for a $ITEM command !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_item_item$ select case item_elements% case is = 2' menu_item_item_without_name case is = 3$ menu_item_item_with_name end select) if (error) then exit routine ! RETURNED:1 ! item_id$ = item ID= ! item_proc_name$ = item procedure name: ! item_desc$ = item description2 item_idz$ = item_idz$ + (item_id$ + ",")( ! add to item IDs string' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$2 menu_info$(menu_info_slot%, 2) = "$ITEM"3 menu_info$(menu_info_slot%, 3) = item_id$: menu_info$(menu_info_slot%, 4) = item_proc_name$5 menu_info$(menu_info_slot%, 5) = item_desc$' menu_items% = menu_items% + 13 menu_item%(menu_items%) = menu_info_slot% end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%? ! M E N U _ I T E M _ I T E M _ W I T H O U T _ N A M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !8 ! Process a $ITEM command in the following form: ! ! $ITEM item-name ! ! EXPECTED:, ! item_nbr% = item number3 ! item_line$ = massaged MCL_LINE$ !  ! RESULT:) ! item_id$ = item ID5 ! item_proc_name$ = item procedure name2 ! item_desc$ = item description !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ routine menu_item_item_without_name$ item_nbr% = item_nbr% + 1%% item_id$ = str$(item_nbr%)' menu_check_for_duplicate_item( if _error then exit routine8 item_proc_name$ = element$(item_line$, 2, " ") menu_find_item_desc( if _error then exit routine! item_desc$ = proc(desc) end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%9 ! M E N U _ I T E M _ I T E M _ W I T H _ N A M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !8 ! Process a $ITEM command in the following form: !) ! $ITEM item-name ! ! EXPECTED:4 ! item_line$ = massaged MCL_LINE$ ! ! RESULT:) ! item_id$ = item ID5 ! item_proc_name$ = item procedure name2 ! item_desc$ = item description !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( routine menu_item_item_with_name1 item_id$ = element$(item_line$, 2, " ") menu_check_item_id( if _error then exit routine8 item_proc_name$ = element$(item_line$, 3, " ") menu_find_item_desc( if _error then exit routine! item_desc$ = proc(desc) end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M E N U _ I T E M _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !> ! Process a $ITEM MENU menu-name command !  ! EXPECTED:, ! cur_menu$ = current menuname/ ! item_line$ = massaged MCL_LINE$ ! ! RESULT:' ! menu_info$(,) is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_item_menu@ if scan(element$(item_line$, 3, " "), "<>") = 0 then' menu_item_menu_without_name else$ menu_item_menu_with_name end if( if _error then exit routine ! RETURNED:, ! item_id$ = item ID8 ! menu_name$ = menu name (to call): ! menu_desc$ = menu description text2 item_idz$ = item_idz$ + (item_id$ + ",")' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$7 menu_info$(menu_info_slot%, 2) = "$ITEM MENU"3 menu_info$(menu_info_slot%, 3) = item_id$5 menu_info$(menu_info_slot%, 4) = menu_name$5 menu_info$(menu_info_slot%, 5) = menu_desc$' menu_items% = menu_items% + 13 menu_item%(menu_items%) = menu_info_slot% end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%? ! M E N U _ I T E M _ M E N U _ W I T H O U T _ N A M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !4 ! Process a $ITEM MENU menu-name command !  ! EXPECTED:0 ! mcl_line$ = .MCL file text line/ ! item_line$ = massaged MCL_LINE$0 ! item_nbr% = item number counterD ! nolead% = edit$() param to discard leading spacesB ! noextra% = edit$() param to discard extra spacesE ! notrail% = edit$() param to discard trailing spaces ! ! RESULT:$ ! item_id$ = item ID& ! menu_name$ = menu name- ! menu_desc$ = description text !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ routine menu_item_menu_without_name$ item_nbr% = item_nbr% + 1%% item_id$ = str$(item_nbr%)' menu_check_for_duplicate_item( if _error then exit routine3 menu_name$ = element$(item_line$, 3, " ")? z1$ = edit$(mcl_line$, nolead% + noextra% + notrail%)5 z1% = pos(z1$, " ", len("$ITEM MENU ") + 1) if z1% > 0% then. menu_desc$ = z1$[z1% + 1:len(z1$)] else- menu_desc$ = menu_name$ + " menu" end if end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%9 ! M E N U _ I T E M _ M E N U _ W I T H _ N A M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !> ! Process a $ITEM MENU menu-name command !  ! EXPECTED:0 ! mcl_line$ = .MCL file text line/ ! item_line$ = massaged MCL_LINE$0 ! item_nbr% = item number counterC ! nolead% = edit$() param to discard leading spacesA ! noextra% = edit$() param to discard extra spacesD ! notrail% = edit$() param to discard trailing spaces ! ! RESULT:$ ! item_id$ = item ID& ! menu_name$ = menu name- ! menu_desc$ = description text !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( routine menu_item_menu_with_name1 item_id$ = element$(item_line$, 3, " ") menu_check_item_id( if _error then exit routine3 menu_name$ = element$(item_line$, 4, " ")? z1$ = edit$(mcl_line$, nolead% + noextra% + notrail%)! z1% = pos(z1$, "> ", 1)& z1% = pos(z1$, " ", z1% + 2) if z1% > 0% then. menu_desc$ = z1$[z1% + 1:len(z1$)] else- menu_desc$ = menu_name$ + " menu" end if end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! M E N U _ C H E C K _ I T E M _ I DI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !3 ! Here only when an item name is specified. !C ! Item IDs must be enclosed between "<" and ">" characters,[ ! be 12 characters max, contain only "legal" characters, and be ++DJS++ 26-NOV-1990! ! unique within the menu. ! ! EXPECTS:% ! item_id$ = item ID7 ! item_idz$ = string of unique item IDs= ! err_syntax% = mcl_err% value for syntax error> ! err_bad_id% = mcl_err% value for item ID error ! ! RETURNS:0 ! item_id$ = "massaged" item ID3 ! mcl_err% = error number if any !I ! Exceeds 22 lines to completely validate item name in one place. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine menu_check_item_id error = false1 if (left$(item_id$, 1) <> "<") and &0 (right$(item_id$, 1) <> ">") then# mcl_err% = err_syntax% ! menu_report_mcl_error set error on exit routine end if0 item_id$ = item_id$[2:len(item_id$)-1]@ ! remove from between the "<" and ">" characters' if len(item_id$) > 12% then; ! item name too long 12 max ++DJS++ 26-NOV-1990# mcl_err% = err_bad_id% ! menu_report_mcl_error set error on exit routine end if@ legal_chars$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"( for z1% = 1% to len(item_id$)> if pos(legal_chars$, item_id$[z1%:z1%]) = 0 then% mcl_err% = err_bad_id% # menu_report_mcl_error set error on exit for end if next z1%( if _error then exit routine' menu_check_for_duplicate_item end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%C ! M E N U _ C H E C K _ F O R _ D U P L I C A T E _ I T E MI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !% ! Check for a duplicate item. ! ! EXPECTED:/ ! item_id$ = item ID to check.@ ! item_idz$ = string of item IDs we have so far.B ! err_dup_id% = mcl_err% value for duplicate item ID ! ! RESULT:. ! error = true if a duplicate. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- routine menu_check_for_duplicate_item3 if match(item_idz$, item_id$) <> 0 then% mcl_err% = err_dup_id% ! menu_report_mcl_error set error on end if end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! M E N U _ F I N D _ I T E M _ D E S CI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !H ! Get the matching PROCEDURE record for the item procedure name. ! ! EXPECTS:+ ! item_proc_name$ = item nameJ ! err_no_item% = mcl_err% value for item not in PROCEDURE ! ! RETURNS:> ! mcl_err% = error number if item name not found !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine menu_find_item_desc> set structure proc, field name : key item_proc_name$" if _extracted = 0 then # mcl_err% = err_no_item%! menu_report_mcl_error set error on end if end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%= ! M E N U _ P R O C E S S _ C O M M A N D _ S P L I TI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !# ! Process a $SPLIT command. ! ! EXPECTED:/ ! mcl_line$ = .MCL file text line ! ! RESULT:= ! menu_info$(,) is loaded for a $SPLIT command. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%* routine menu_process_command_split' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$3 menu_info$(menu_info_slot%, 2) = "$SPLIT"- menu_info$(menu_info_slot%, 3) = ""- menu_info$(menu_info_slot%, 4) = ""- menu_info$(menu_info_slot%, 5) = "" end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%9 ! M E N U _ P R O C E S S _ C O M M A N D _ E N DI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !! ! Process a $END command.D ! The $END may be real or implied because we came to a $MENU& ! or the end of main MCL file. ! ! EXPECTED:A ! do_end% = true if we need to run this routine- ! cur_menu$ = current menu name4 ! menu_menu_slot% = menu_menu$(,) slot !8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name- ! ! column 2 = command< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 !8 ! menu_menu$(menu_row_max%, menu_col_max%)/ ! ! column 1 = menu name2 ! ! column 2 = menu headingB ! ! column 3 = beginning MENU_INFO$(,) slot? ! ! column 4 = ending MENU_INFO$(,) slotL ! ! column 5 = "N" if all numbered items on this menu !' ! menu_info$(,) is loaded' ! menu_menu$(,) is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%( routine menu_process_command_end- if not do_end% then exit routine' menu_increment_menu_info_slot4 menu_info$(menu_info_slot%, 1) = cur_menu$1 menu_info$(menu_info_slot%, 2) = "$END"- menu_info$(menu_info_slot%, 3) = ""- menu_info$(menu_info_slot%, 4) = ""- menu_info$(menu_info_slot%, 5) = ""@ menu_menu$(menu_menu_slot%, 4) = str$(menu_info_slot%)> ! last MENU_INFO$(,) slot for the current menu menu_load_items_type do_end% = false end routineH !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%1 ! M E N U _ L O A D _ I T E M S _ T Y P EH !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !@ ! Load column 5 of the MENU_MENU$(,) slot with an "N" if3 ! this menu contains only "numbered" items. ! ! EXPECTED:; ~DEMO.BCK_L+#[INTOUCH_DEMO]MENU_ROUTINES.INC;141]|U ! menu_menu_slot% = current MENU_MENU$(,) row !8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name- ! ! column 2 = command< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 !8 ! menu_menu$(menu_row_max%, menu_col_max%)/ ! ! column 1 = menu name2 ! ! column 2 = menu headingB ! ! column 3 = beginning MENU_INFO$(,) slot? ! ! column 4 = ending MENU_INFO$(,) slotL ! ! column 5 = "N" if all numbered items on this menu ! ! RESULT:J ! frst_menu_slot% = first MENU_INFO$(,) slot for this menuI ! last_menu_slot% = last MENU_INFO$(,) slot for this menu !H !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$ routine menu_load_items_type? frst_menu_slot% = val(menu_menu$(menu_menu_slot%, 3))? last_menu_slot% = val(menu_menu$(menu_menu_slot%, 4))6 z2% = true ! z2% = true = all numeric items7 for z1% = frst_menu_slot% to last_menu_slot%E if menu_info$(z1%, 2)[1:5] <> "$ITEM" then iterate for? if not(valid(menu_info$(z1%, 3), "INTEGER")) then z2% = false exit for end if next z1%] if z2% then menu_menu$(menu_menu_slot%, 5) = "N" ! set "all numbered items" flag end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%C ! M E N U _ I N C R E M E N T _ M E N U _ I N F O _ S L O TI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !/ ! Increment the MENU_INFO_SLOT% counter ! ! EXPECTED:< ! menu_info_slot% = menu_info$(,) row counter ! ! RESULT:7 ! menu_info_slot% is incremented by one. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- routine menu_increment_menu_info_slot/ menu_info_slot% = menu_info_slot% + 1 end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%= ! M E N U _ P R O C E S S _ M C L _ D I R E C T I V EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !" ! Process a MCL directive.0 ! Directives begin with a "%" character. ! ! EXPECTED:D ! mcl_line$ = MCL file line which begins with a "%"A ! err_bad_cmd% = mcl_err% value for invalid commandF ! nolead% = edit$() param to discard leading spacesD ! ucase% = edit$() param to convert to uppercase ! ! RESULT:0 ! mcl_err% = error number if any !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%* routine menu_process_mcl_directiveD z1$ = element$(edit$(mcl_line$, nolead% + ucase%), 1, " ") select case z1$ case "%INCLUDE"* menu_process_directive_include case else# mcl_err% = err_bad_cmd%! menu_report_mcl_error end select end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%E ! M E N U _ P R O C E S S _ D I R E C T I V E _ I N C L U D EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !) ! Process the %INCLUDE directive. ! ! EXPECTED:. ! mcl_line$ = MCL file text lineC ! nolead% = edit$() param to discard leading spacesA ! noextra% = edit$() param to discard extra spaces ! ! RESULT:2 ! mcl_fspec$ = file name to include. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%. routine menu_process_directive_include4 z1$ = edit$(mcl_line$, nolead% + noextra%)S mcl_fspec$ = z1$[len("%INCLUDE ") + 1:len(z1$)] ! name of file to include menu_check_mcl_file( if _error then exit routine menu_open_mcl_file( if _error then exit routine menu_read_mcl_file menu_close_mcl_file end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%7 ! M E N U _ D I S P L A Y _ F I R S T _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !- ! Set up to display the level 1 menu. ! ! EXPECTED:6 ! menu_menu$(1, 1) = level one menu name ! ! RESULT: ! cur_menu% = 1 ! menu_level% = 1> ! menu_level$(1, 1) is loaded with the menu name !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' routine menu_display_first_menu cur_menu% = 1 menu_level% = 1L menu_level$(menu_level%, 1) = menu_menu$(cur_menu%, 1) ! menu name= menu_level$(menu_level%, 2) = "" ! last item chosen& action$ = "menu_paint_menu"  end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ! M E N U _ P A I N T _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !' ! Paint the screen with a menu. ! ! EXPECTED:J ! cur_menu% = current menu number, i.e. menu to paintI ! frst_menu_slot% = first MENU_INFO$(,) slot for this menuH ! last_menu_slot% = last MENU_INFO$(,) slot for this menu !8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name- ! ! column 2 = command< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 !8 ! menu_menu$(menu_row_max%, menu_col_max%)/ ! ! column 1 = menu name2 ! ! column 2 = menu headingB ! ! column 3 = beginning MENU_INFO$(,) slot? ! ! column 4 = ending MENU_INFO$(,) slotL ! ! column 5 = "N" if all numbered items on this menu ! ! RESULT:1 ! cur_menu$ = current menu name4 ! menu_heading$ = current menu heading !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_paint_menu if pop_up_menu then menu_menu_frame% action$ = 'menu_ask_item' exit routine end if4 cur_menu$ = menu_menu$(cur_menu%, 1)4 menu_heading$ = menu_menu$(cur_menu%, 2)9 frst_menu_slot% = val(menu_menu$(cur_menu%, 3))9 last_menu_slot% = val(menu_menu$(cur_menu%, 4))> all_numbered_items% = menu_menu$(cur_menu%, 5) = "N"6 ! this is an "all numbered items" menuB for menu_info_slot% = frst_menu_slot% to last_menu_slot%6 select case menu_info$(menu_info_slot%, 2)5 case "$MENU" : menu_display_menu@ case "$HEADING" : ! we got menu_heading$ above6 case "$TITLE" : menu_display_title5 case "$TEXT" : menu_display_text5 case "$ITEM" : menu_display_item: case "$ITEM MENU" : menu_display_item_menu6 case "$SPLIT" : menu_display_split3 case "$END" : ! nothing to do9 case else : !??? REPORT ERROR ??? end select next menu_info_slot%# action$ = "menu_ask_item" end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! M E N U _ D I S P L A Y _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !& ! Painting menu -- found $MENU( ! Set up to paint a menu screen. ! ! RESULT:2 ! cur_row% = current row is set to 35 ! cur_col% = current column is set to 1 !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine menu_display_menu menu_menu_frame cur_row% = 3 cur_col% = 1 end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ! M E N U _ M E N U _ F R A M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !* ! Create and paint the menu frame. ! ! EXPECTED:, ! menu_heading$ = header text2 ! cur_menu$ = current menu name+ ! menu_level% = menu level !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_menu_frame if pop_up_menu then" u_str$ = system_title$ screen_frame else! u_str$ = system_name$6 gosub screen_frame # z3$ = space$(the_width)( print reverse, at 2, 1 : z3$+ z3$ = " " + menu_heading$ + " "- z% = (the_width/2) - (len(z3$)/2)0 print reverse, bold, at 2, z% : z3$;/ print reverse, at 2, 2 : cur_menu$;/ z1$ = "Level: " + str$(menu_level%)A print reverse, at 2, the_width - len(z1$) : z1$; ' '; end if message menu_message$ end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! M E N U _ D I S P L A Y _ T I T L EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !' ! Painting menu -- found $TITLE5 ! Paint a blank line and then the title text. ! ! EXPECTED:4 ! menu_info_slot% = MENU_INFO$(,) slot ! ! RESULT:@ ! cur_row% = current screen row incremented by two !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine menu_display_title! cur_row% = cur_row% + 1U print reverse, bold, at cur_row%, cur_col% : menu_info$(menu_info_slot%, 4)! cur_row% = cur_row% + 1 end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! M E N U _ D I S P L A Y _ T E X TI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !' ! Painting menu -- found $TEXT. ! ! EXPECTED:4 ! menu_info_slot% = MENU_INFO$(,) slot ! ! RESULT:9 ! cur_row% = current screen row incremented !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine menu_display_textF print at cur_row%, cur_col% : menu_info$(menu_info_slot%, 4)! cur_row% = cur_row% + 1 end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! M E N U _ D I S P L A Y _ I T E MI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !% ! Painting menu - found $ITEM ! ! EXPECTED:% ! cur_row% = screen row( ! cur_col% = screen column( ! menu_level% = menu level4 ! menu_info_slot% = MENU_INFO$(,) slot3 ! all_numbered_items% = true or false ! ! RESULT:2 ! cur_row% = current row incremented !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine menu_display_item' print at cur_row%, cur_col%:;G if menu_info_slot% = val(menu_level$(menu_level%, 2)) then' print bold : " *";  else print " "; end if) if (all_numbered_items%) thenC print bold : lpad$(menu_info$(menu_info_slot%, 3), 2); 5 print " "; menu_info$(menu_info_slot%, 5) elseD print bold : rpad$(menu_info$(menu_info_slot%, 3), 10); 5 print " "; menu_info$(menu_info_slot%, 5) end if5 ! display the item ID and description! cur_row% = cur_row% + 1( ! increment line counter end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%6 ! M E N U _ D I S P L A Y _ I T E M _ M E N UI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !+ ! Painting menu -- found $ITEM MENU ! ! EXPECTED:- ! cur_row% = current screen row0 ! cur_col% = current screen column( ! menu_level% = menu level4 ! menu_info_slot% = MENU_INFO$(,) slot3 ! all_numbered_items% = true or false ! ! RESULT:4 ! cur_row% = screen row is incremented !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& routine menu_display_item_menu' print at cur_row%, cur_col%:;G if menu_info_slot% = val(menu_level$(menu_level%, 2)) then print bold : " *"; else print " "; end ifG ! last item chosen on this menu gets marked with an "*") if (all_numbered_items%) thenB print bold : lpad$(menu_info$(menu_info_slot%, 3), 2);5 print " "; menu_info$(menu_info_slot%, 5) elseC print bold : rpad$(menu_info$(menu_info_slot%, 3), 10);5 print " "; menu_info$(menu_info_slot%, 5) end if! cur_row% = cur_row% + 1 end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! M E N U _ D I S P L A Y _ S P L I TI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !' ! Painting menu -- found $SPLITC ! Adjust row and column to start over at top of column two. ! ! RESULT:' ! cur_row% = set to row 3+ ! cur_col% = set to column 41 !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine menu_display_split cur_row% = 3 cur_col% = 41 end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! M E N U _ A S K _ I T E MI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !3 ! Ask the user for the menu item ID to run.6 ! They can choose any valid item on any of the ! "set of menu screens." ! ! RESULT:1 ! requested_item$ = user's repsonse !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_ask_item if pop_up_menu then menu_do_pop_up exit routine end if prompt$ = "Item" length = 12 uc_response? = true" validation$ = 'required'! help$ = "menu item" input_response" clear area 21, 1, 21, 80 if _back then menu_do_back exit routine end if if _exit then menu_do_exit exit routine end if) requested_item$ = trim$(reply$)& action$ = "menu_verify_item" end routineI / J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M E N U D O P O P U PJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description: ! ! Expected: ! ! Locals: ! ! Results: !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_do_pop_upJ line input menu menu_text$, default input_menu_default$ : reply$C if _back and menu_no_finish then !++nva defined in .int% action$ = 'exit' & exit routine  end if# if _exit or _back then% action$ = 'menu_finish' exit routine end if) input_menu_default$ = _string$ requested_item$ = reply$( action$ = 'menu_verify_item' end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%) ! M E N U _ V E R I F Y _ I T E MI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% != ! Find the MENU_INFO$(,) slot for the requested item. ! ! EXPECTED:9 ! requested_item$ = user requested item IDI ! frst_menu_slot% = first MENU_INFO$(,) slot for this menuH ! last_menu_slot% = last MENU_INFO$(,) slot for this menu !8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name- ! ! column 2 = command< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 ! ! RESULT:G ! menu_info_slot% = MENU_INFO$(,) slot for requested itemF ! desired_menu$ = menu desired item is on if we're not> ! already on the correct menu !- ! menu_level$(menu_row_max%, 2), ! ! row# = menu level/ ! ! column 1 = menu nameM ! ! column 2 = MENU_INFO$(,) slot for last item chosen ! !B ! Exceeds 22 lines to completely verify item in one place. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_verify_item found_count% = 0% saved_slot% = 0%$ for z% = 1% to menu_items%, menu_info_slot% = menu_item%(z%)I z1$ = menu_info$(menu_info_slot%, 3%)[1:len(requested_item$)]+ if requested_item$ = z1$ then. found_count% = found_count% + 1%, saved_slot% = menu_info_slot%= menu_ambiguous%(found_count%) = menu_info_slot% end if next z%< ! find MENU_INFO$(,) slot for requested item% if found_count% = 0% then@ message error : "Item not found: " + requested_item$% action$ = "menu_ask_item" exit routine end if$ if found_count% > 1 then" menu_display_ambiguous if _error then' action$ = "menu_ask_item" exit routine end if end if' menu_info_slot% = saved_slot%/ ! slot of valid, requested item$ if not pop_up_menu then &? menu_level$(menu_level%, 2) = str$(menu_info_slot%)) ! update last item chosen4 select case menu_info$(menu_info_slot%, 2) case "$ITEM"# menu_get_procedure_info if _error then' action$ = "menu_ask_item" exit routine end if% action$ = "menu_run_item" case "$ITEM MENU": desired_menu$ = menu_info$(menu_info_slot%, 4)& action$ = "menu_call_menu" end select end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 ! M E N U D I S P L A Y A M B I G U O U SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%G ! an ambiguous selection was entered. Display them and let the ! user pick one ! ! Expected:> ! found_count% = number of ambiguous items found0 ! menu_ambiguous%() = menu numbers ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%& routine menu_display_ambiguous mda_init mda_process_items/ if not mda_done or reply$ = '' then set error on elseB saved_slot% = menu_ambiguous%(val(reply$) + mda_base%) end if+ set window : current save_window$ end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M D A I N I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%9 ! setup to display ambiguous menu item selections ! ! Expected: ! ! Result : !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mda_init2 max_ambig_disp% = min(found_count%, 15%)" mda_display_offset% = 0% mda_base% = 0%+ ask window : current save_window$- clear area 3, 1, 21, current_marginB clear area box : 3, 1, 5+max_ambig_disp%, current_margin' z$ = " Ambiguous Menu Items "H print bold, reverse, at 4, (current_margin/2)-(len(z$)/2) : z$ end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! M D A P R O C E S S I T E M SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%; ! display the selections and get the users response !u ! Expected: !  ! Result :e !TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine mda_process_items.1 for menu_ambig_ctr% = 1 to found_count%r mda_display_option; if mda_display_offset% = max_ambig_disp% then  mda_ask%( if mda_done then exit for& mda_display_offset% = 0%I mda_base% = mda_base% + max_ambig_disp% ! offset into table  end if next menu_ambig_ctr%! if not(mda_done) thenJ5 if mda_display_offset% > 0 then mda_ask  end if end routinedJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! M D A D I S P L A Y O P T I O NrJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%. ! display one of the ambiguous options !u ! Expected: < ! menu_ambiguous%() = array of ambiguous items= ! menu_info$() = array of info about itemsiL ! all_numbered_items% = true if using numbers instead of names !  ! Result : 2 ! mda_display_offset% is incremented ! J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine mda_display_option. z = menu_ambiguous%(menu_ambig_ctr%)7 mda_display_offset% = mda_display_offset% + 1 0 print at 4 + mda_display_offset%, 3: &7 format$(mda_display_offset%, "##) "); ' if all_numbered_items% then%D print lpad$(menu_info$(z, 3), 2); " "; menu_info$(z, 5) elseE print rpad$(menu_info$(z, 3), 10); " "; menu_info$(z, 5)% end if end routine%J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M D A A S K J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H ! ask if one of the items displayed on the screen is the one the ! user wants ! ! Expected:b !  ! Result : !eJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mda_ask  mda_done = false- if mda_display_offset% = 15% theno6 message "Press RETURN for the next screen" end if% prompt$ = "Sequence number"  length = 4I validation$ = 'integer;allow 1 to ' + str$(mda_display_offset%)  input_response# if _back or _exit thenn mda_done = truen exit routine end if if reply$ <> '' then  mda_done = trueo* else 0 if mda_display_offset% = 15% then &F clear area 5, 3, 4+max_ambig_disp%, current_margin - 1 end if end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%r7 ! M E N U _ G E T _ P R O C E D U R E _ I N F OfI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%n ! 8 ! Get the matching PROCEDURE record inforamtion. !e ! EXPECTED:rG ! menu_info_slot% = MENU_INFO$(,) slot for requested itemo !f ! RESULT:+ ! error = true if not found !tG ! proc_dispatch_type$ = dispatch type (ROUTINE, COMMAND) 4 ! proc_dispatch_text$ = dispatch text0 ! proc_parameter_text$ = parameter ! I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' routine menu_get_procedure_info M set structure proc, field name : key menu_info$(menu_info_slot%, 4)g. ! procedure name for this item" if _extracted = 0 then H message error : "Item " + menu_info$(menu_info_slot%, 4) + &? " not found in PROCEDURE structure" exit routine end if4 proc_dispatch_type$ = proc(dispatch_type)4 proc_dispatch_text$ = proc(dispatch_text)5 proc_parameter_text$ = proc(parameter_text)  end routine%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%o# ! M E N U _ R U N _ I T E M I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! + ! Set up the parameter as a symbol.8 ! Run the chosen item (if a routine or command). !  ! EXPECTED: > ! proc_dispatch_type$ = procedure dispatch typeB ! proc_dispatch_text$ = routine name or DCL command0 ! proc_parameter_text$ = parameter !uI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_run_item%) select case proc_dispatch_type$  case "COMMAND" clear%? pass "OPER_PARAMETER :== " + proc_parameter_text$p& pass proc_dispatch_text$ case "ROUTINE", dispatch proc_dispatch_text$ end select% action$ = "menu_paint_menu"d end routinehI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%e% ! M E N U _ C A L L _ M E N U I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! * ! The chosen item is a $ITEM MENU. !aF ! Check if the menu to "call" was already called on our way toE ! where we are now (we'll go backwards) OR if this is a new%& ! menu (we're going forwards). !o ! EXPECTED:l2 ! menu_level% = current menu level= ! desired_menu$ = menu screen we want to set up !  ! RESULT:_: ! menu_level% = set for new or previous menu1 ! cur_menu$ = set to desired menulA ! menu_level$(menu_level%, 1) = set to desired menua !nI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%c routine menu_call_menu found = false % for z1% = 1% to menu_level% 9 if desired_menu$ = menu_level$(z1%, 1) then  found = true menu_level% = z1%  exit for end if next z1% if not found then ) menu_level% = menu_level% + 1 7 menu_level$(menu_level%, 1) = desired_menu$%, menu_level$(menu_level%, 2) = "" end if1 cur_menu$ = menu_level$(menu_level%, 1)r menu_get_menu_number# ! returns cur_menu%x% action$ = "menu_paint_menu"  end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! M E N U _ D O _ E X I T I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%u !u8 ! If we're at the level 1 menu then exit program/ ! else go directly to the level 1 menu.f !  ! EXPECTED: 0 ! menu_level% = current menu level !u ! RESULT:%, ! menu_level% = set to level 1- ! cur_menu$ = level 1 menu name! ! OR  ! exit program !iI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  routine menu_do_exit# if menu_level% = 1 thenn# action$ = "menu_finish"  else menu_level% = 1 3 cur_menu$ = menu_level$(menu_level%, 1) menu_get_menu_number# ! returns cur_menu% ' action$ = "menu_paint_menu"O end if end routinecI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%u! ! M E N U _ D O _ B A C K I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !! ! Go back one menu level. !$ ! EXPECTED:m0 ! menu_level% = current menu level !x ! RESULT: , ! menu_level% = new menu level+ ! cur_menu$ = new menu namei !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  routine menu_do_back/ menu_level% = max(1, menu_level% - 1) 8 ! can't go any farther back than level 11 cur_menu$ = menu_level$(menu_level%, 1)  menu_get_menu_number# ! returns cur_menu%u% action$ = "menu_paint_menu"  end routinef I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%m1 ! M E N U _ G E T _ M E N U _ N U M B E RlI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%e !x4 ! Given a menu name, return the menu number. !u ~DEMO.BCK_L+#[INTOUCH_DEMO]MENU_ROUTINES.INC;141]D ! EXPECTED:& ! cur_menu$ = menu name ! 8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu name !  ! RETURNED: ( ! cur_menu% = menu number !%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%a$ routine menu_get_menu_number+ for z1% = 1% to menu_menu_total%s> if menu_menu$(z1%, 1) = cur_menu$ then exit for next z1% cur_menu% = z1%  end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% / ! M E N U _ C H E C K _ M C L _ F I L E I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !' ! Check if the MCL file exists.n !r ! EXPECTED: 1 ! mcl_fspec$ = file to be checkedl@ ! err_no_file% = mcl_err% value for file not found !  ! RESULT: 1 ! error = true if file NOT found% !%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%i# routine menu_check_mcl_files error = false , if pos(mcl_fspec$, ".") = 0 then, mcl_fspec$ = mcl_fspec$ + ".MCL" end if% z1$ = findfile$(mcl_fspec$)a if z1$ = "" then error = true$ mcl_err% = err_no_file% ! menu_report_mcl_error  end if end routine%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 7 ! M E N U _ C H E C K _ C A L L E D _ M E N U S%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ? ! Verify that all of the $ITEM MENU menu_namec8 ! actually have a corresponding $MENU menu_name. != ! EXPECTED:iF ! menu_info_total% = number of MENU_INFO$(,) slots usedF ! menu_menu_total% = number of MENU_MENU$(,) slots used ! 8 ! menu_info$(info_row_max%, info_col_max%)/ ! ! column 1 = menu namec- ! ! column 2 = command%< ! ! column 3 = item number (if $ITEM), ! ! column 4 = text 1, ! ! column 5 = text 2 !e8 ! menu_menu$(menu_row_max%, menu_col_max%)/ ! ! column 1 = menu name 2 ! ! column 2 = menu headingB ! ! column 3 = beginning MENU_INFO$(,) slot? ! ! column 4 = ending MENU_INFO$(,) slottL ! ! column 5 = "N" if all numbered items on this menu ! I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' routine menu_check_called_menus%* for z1% = 1% to menu_info_total%7 if menu_info$(z1%, 2) = "$ITEM MENU" then  found = falsee. for z2% = 1% to menu_menu_total%A if menu_menu$(z2%, 1) = menu_info$(z1%, 4) then found = true exit for end if next z2%! if not found then%/ menu_name$ = menu_info$(z1%, 4)e- menu_report_called_menu_errore end if end if next z1% end routine_I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%lC ! M E N U _ R E P O R T _ C A L L E D _ M E N U _ E R R O R%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ? ! Report that a $ITEM MENU menu_name does not%/ ! have a corresponding $MENU menu_name. !e ! EXPECTED: < ! menu_name$ = menu to call that doesn't exist !  ! RESULT:e ! fatal = trueI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%l- routine menu_report_called_menu_errorc fatal = true message error : ""> print bold, at 14, 5 : "Called menu does not exist";5 print at 16, 5 : "Command : $ITEM MENU";l7 print at 17, 5 : "Menu name : "; menu_name$;  delayl" clear area 14, 1, 19, 80* message "Initializing system..." print at 23, 52:;% end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%3 ! M E N U _ R E P O R T _ M C L _ E R R O R I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !c# ! Report an MCL file error.l !  ! EXPECTED:x' ! mcl_err% = error number % ! mcl_level% = menu level ( ! mcl_line$ = MCL file line< ! err_no_file% = mcl_err% value for file not found: ! err_syntax% = mcl_err% value for syntax error= ! err_bad_cmd% = mcl_err% value for invalid command]I ! err_no_item% = mcl_err% value for item not found in PROCEDUREl? ! err_dup_id% = mcl_err% value for duplicate item ID ; ! err_bad_id% = mcl_err% value for item ID error !  ! RESULT:e ! fatal = truee ! I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % routine menu_report_mcl_error fatal = true message error : "" print at 14, 5:; select case mcl_err%? case err_no_file% : print bold : "File not found";%= case err_syntax% : print bold : "Syntax error"; @ case err_bad_cmd% : print bold : "Invalid command";I case err_no_item% : print bold : "Item "; item_proc_name$; & G " not found in PROCEDURE")A case err_dup_id% : print bold : "Duplicate item ID"i= case err_bad_id% : print bold : "Item ID error"= end selectB print at 16, 5 : "Menu file : "; mcl_name$(mcl_level%);M print at 17, 5 : "Line number: "; str$(menu_line_ctr%(mcl_level%));%6 print at 18, 5 : "Statement : "; mcl_line$; delayp" clear area 14, 1, 19, 80* message "Initializing system..." print at 23, 52:;s end routineeJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ! M E N U B U I L D M E N U J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !  ! Brief description: !  ! Expected: !e ! Locals:i !  ! Results: ! J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_build_menu cur_menu% = 1e, dim mbm_last_info(menu_menu_slot%)+ dim mbm_cur_info(menu_menu_slot%)( dim mbm_menus(menu_menu_slot%)& for z = 1 to menu_menu_slot%3 mbm_cur_info(z) = val(menu_menu$(z, 3)) 4 mbm_last_info(z) = val(menu_menu$(z, 4)) next z mbm_menus(1) = 1 mbm_menu_index = 1G menu_text$ = '%at 3, center, %autodisplay off, %autovbar off'  mbm_index = 0L do% mbm_index = mbm_index + 1r9 if mbm_index > mbm_last_info(cur_menu%) thend1 mbm_menu_index = mbm_menu_index - 1 1 if mbm_menu_index = 0 then exit doa3 cur_menu% = mbm_menus(mbm_menu_index)u+ menu_text$ = menu_text$ + '}' 5 mbm_index = mbm_cur_info(cur_menu%) + 1 end if mbm_get_info select case mbm_cmd$$ case "$HEADING" mbm_append_commaG menu_text$ = menu_text$ + '%title "' + mbm_text1$ + '"' $ case "$TITLE" mbm_append_comma: menu_text$ = menu_text$ + '%heading "' + &" mbm_text1$ + '"'. case "$ITEM" : mbm_item3 case "$ITEM MENU" : mbm_item_menu$ case "$SPLIT" mbm_append_comma2 menu_text$ = menu_text$ + '%split' case elsef end select loop menu_add_exita end routineuJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! M E N U A D D E X I TJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !i ! Brief description:F ! This routine adds 'EXIT' as the last menu item in the main  ! pop-up menu. !  ! Expected: 6 ! menu_text$ is defined from MENU_BUILD_MENU.8 ! u_exit_text$ is defined from the main program ! !a ! Results:! ! menu_text$ is completeT ! J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine menu_add_exitx0 menu_text$ = menu_text$ + u_exit_text$ end routine J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! M B M G E T I N F O!J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !  ! Brief description: !m ! Expected: !c ! Locals: !  ! Results: !uJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mbm_get_info- mbm_cmd$ = menu_info$(mbm_index, 2) 5 mbm_prompt$ = menu_info$(mbm_index, 3)[1:9]n/ mbm_text1$ = menu_info$(mbm_index, 4) / mbm_text2$ = menu_info$(mbm_index, 5)  end routine J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M B M I T E M J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !m ! Brief description: !s ! Expected:N !  ! Locals:m !o ! Results: !eJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mbm_item mbm_append_comma2 if valid(mbm_prompt$, 'integer') then & z$ = lpad$(mbm_prompt$, 3) !z = 30  z = 55 else' z$ = rpad$(mbm_prompt$, 10)o !z = 24  z = 48 end ifA !+jls+ increase maximum length of menu item descriptionJ menu_text$ = menu_text$ + '"' + z$ + mbm_text2$[1:z] + '"="' + & mbm_prompt$ + '"'% end routine%J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! M B M I T E M M E N U%J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !m ! Brief description: ! ! Expected:i !f ! Locals: !  ! Results: ! J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mbm_item_menuo2 if valid(mbm_prompt$, 'integer') then & z$ = lpad$(mbm_prompt$, 3) !z = 30  z = 55 else' z$ = rpad$(mbm_prompt$, 10) !z = 23  z = 48 end ifA !+jls+ increase maximum length of menu item description  mbm_append_commaB menu_text$ = menu_text$ + '"' + z$ + mbm_text2$[1:z] + &2 '"={%replace, %at 3, center' - mbm_cur_info(cur_menu%) = mbm_indexg& for z = 1 to menu_menu_slot%; if menu_menu$(z, 1) = mbm_text1$ then exit form next z cur_menu% = z - mbm_index = mbm_cur_info(cur_menu%) - mbm_menu_index = mbm_menu_index + 1T/ mbm_menus(mbm_menu_index) = cur_menu%  end routine$J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%) ! M B M A P P E N D C O M M AoJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !2 ! Brief description: !  ! Expected:t !s ! Locals:u !_ ! Results: ! J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mbm_append_comma1 if right$(menu_text$, 1) <> '{' then &u* menu_text$ = menu_text$ + ','  end routinesJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! G E T V A L I D O P E R A T O R J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !% ! Brief description:, ! find out how to handle operator id !d ! Expected: = ! mc(operator_type) = "none", "username", "ask" !  ! Result :r+ ! dispatch to correct routine !sJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine get_valid_operator oper_okay = falseu z$ = mc(operator_type) select case z$ case "NONE"%+ let oper_menu$ = default_mcl$p oper_okay = true pop_up_menu = true( ask system : user oper_id$" action$ = 'finished' case "USERNAME" + action$ = 'menu_get_username'$ case "ASK"+ action$ = 'menu_ask_operator'u end select' do until action$ = 'finished'o dispatch action$ loop% if fatal then exit routine) if oper_okay then exit routine% repeat routine end routine J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! M E N U G E T U S E R N A M EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! get the user's username !e ! Expected: !e ! Result : ! writea !lJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine menu_get_usernamel" ask system : user reply$ menu_verify_operator! if have_operator then . action$ = 'menu_get_operator_info' else) action$ = 'menu_ask_password'% end if end routinenI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! M E N U _ A S K _ O P E R A T O R%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%e !n8 ! Ask the user for their operator ID and verify. !cH ! u_* = information to provide for the "ask" routine2 ! action$ = next action to perform) ! have_operator% = operator flagoI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine menu_ask_operator%# prompt$ = "Operator ID"  length = 15  uc_response? = true%" validation$ = 'required' help$ = 'operator id'  input_response$ if _back or _exit then action$ = "finished" fatal = true exit routine end if menu_verify_operator user_id$ = reply$i! if have_operator thenn. action$ = "menu_get_operator_info" else) action$ = "menu_ask_password"  end if end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%r1 ! M E N U _ V E R I F Y _ O P E R A T O R"I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%$ !sC ! Verify the entered operator ID in the OPERATOR structure. !n ! EXPECTED: 1 ! reply$ = user entered operator ID% !% ! RESULT:%1 ! have_operator% = TRUE if found 5 ! FALSE if not found% !%) ! have_operator% = operator flag I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%T$ routine menu_verify_operator3 set structure oper, field id : key reply$l( have_operator = _extracted = 1 end routine=I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%p5 ! M E N U _ G E T _ O P E R A T O R _ I N F O I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%i !tB ! Get the information from the operator's OPERATOR record. !m ! EXPECTED: ) ! we have a OPERATOR record= !" ! RESULT:I, ! oper_id$ = operator ID. ! oper_name$ = operator name2 ! oper_password% = operator password. ! oper_menu$ = operator menu2 ! oper_initials$ = operator initials !$I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%t& routine menu_get_operator_info# oper_id$ = oper(id) % oper_name$ = oper(name)>) oper_password% = oper(password) 8 oper_menu$ = oper(#system_name$ + '_menu') pop_up_menu = true? if oper(#system_name$ + '_menu_type') = 'ITEM' then & pop_up_menu = false ' action$ = "menu_ask_password"  end routinetI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%r+ ! M E N U _ A S K _ P A S S W O R D I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !%. ! Ask the operator for their password.E ! We ask for the password even if we didn't find the matching%B ! operator record. If failure, go get next process to do. !f ! EXPECTED:8 ! access_tries% = number of access tries4 ! have_operator% = TRUE or FALSE flag* ! oper_password% = passwordC ! mc(password_type) = ask if password is to be askedm !E+ ! reply$ = user answer4 ! found = TRUE or FALSE flagI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine menu_ask_passwordn+ access_tries% = access_tries% + 1e- if mc(password_type) <> "ASK" thene# if have_operator then " action$ = "finished" oper_okay = true else- action$ = "menu_access_failure"  end if exit routine end ifF z1$ = ""( line input screen z1$ : reply$# clear area 21, 1, 21, 80m% if not have_operator then  found = false else' gosub menu_encrypt_passwordi+ found = u_int% = oper_password%  end if if found then action$ = "finished" oper_okay = true else% gosub menu_access_failure  end if end routine_I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! M E N U _ A C C E S S _ F A I L U R EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! $ ! Access attempt has failed.% ! Three tries and you're out.% !% ! EXPECTED:%7 ! access_tries% = number of access trieso? ! access_limit = number of access tries allowedt7 ! action$ = next action to perform 3 ! fatal = TRUE or FALSE flaglI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine menu_access_failuret3 message error : "Operator access failure"u0 if access_tries% < access_limit thenK if mc(operator_type) = 'ASK' or mc(password_type) = 'ASK' then%" action$ = "finished" exit routine end if end if fatal = true action$ = "finished" end routineeI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%m3 ! M E N U _ E N C R Y P T _ P A S S W O R DsI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%e ! . ! Encrypt (hash) the entered password. !% ! EXPECTED:%, ! u_str$ = password to encrypt !  ! RESULT: - ! u_int% = "encrypted" password% !%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%g% routine menu_encrypt_passwordE. u_int% = convert(hash$(reply$)[1:4]) end routine I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  ! M E N U _ F I N I S HI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%t !  ! Exit the program. !  ! EXPECTED:%7 ! fatal = true if couldn't process menut !eI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  routine menu_finish  clearh if fatal then $ u_str$ = "A B O R T E D" else& u_str$ = "F I N I S H E D" end if gosub center& print at 10, u_int% : u_str$( u_str$ = date$(days(date$), 3) gosub center& print at 13, u_int% : u_str$ print at 19, 1: '' action$ = "exit" end routine%%%%%% !> ! Process a $ITEM MENU menu-name command !  ! EXPECTED:, ! cur_menu$ = current menuname/ ! item_line$ = massaged MCL_LINE$ ! ! RESULT:' ! menu_info$(,) is loaded !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine me$*[INTOUCH_DEMO]UTILITY_ROUTINES.INC;5+,+.6/@ 4O64~-L+0123 KPWO756 `0.W7:hh8Uf9GHJ"I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%. ! Program : UTILITY_ROUTINES.INC% ! Package : menu system% ! Author : Allen Roske" ! Date : May 19888 ! Purpose : commonly used utility routinesI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !1 ! ask get user response5 ! askyn ask a yes/no question2 ! screen_frame paint screen frameE ! get_date get many versions of a date in yyMMDDG ! get_time get time in HH:MM AM or HH:MM PM formatA ! ymd_to_mdy change date from yyMMDD to MMDDyyA ! mdy_to_ymd change date from MMDDyy to yyMMDD !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S KI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !E ! Prompt the user and get their reply. Perform the indicated ! validations. ! ! EXPECTED:* ! u_prompt$ = prompt text/ ! u_default$ = default response5 ! u_required% = response required flag- ! u_maxlen% = maximum length1 ! u_numeric% = numeric entry onlyF ! u_allow$ = allowed responses (separated by commas)< ! u_range$ = allowed range (ex: "1 TO 99")* ! u_date% = verify date9 ! u_uconly% = convert to upper case flag> ! u_help$ = the name of a help topic in the. ! HELP structure.A ! the_width = screen width - set by screen_frame ! RETURNED:1 ! u_reply$ = what the user enteredB ! u_rel = numeric version if u_numeric% = true ! ! MENTIONED:> ! help_topic$ = the name of a help topic in the. ! HELP structure. !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ask do) clear area 21, 1, 21, the_width u_reply$ = "" u_rel = real(0)% prompt$ = u_prompt$ + "? " line input &1 prompt prompt$, default u_default$, &1 length u_maxlen%, at 21, 1 : u_reply$1 if (_back) or (_exit) then exit do if (_help) then! help_topic$ = u_help$ gosub help repeat do end if gosub do_ask_checks& if (error) then repeat do end do gosub do_ask_reset end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! D O _ A S K _ C H E C K SI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !@ ! Perform the various validations on the user's response ! ! EXPECTED:5 ! u_required% = response required flag3 ! u_maxlen% = maximum input length6 ! u_numeric% = numeric entry only flagF ! u_allow$ = allowed responses (separated by commas)9 ! u_range$ = range check, i.e. "1 TO 5"* ! u_date% = verify date9 ! u_uconly% = convert to upper case flag ! ! RESULT:. ! error = true if any problem !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_ask_checks do% gosub do_ask_check_required$ if (error) then exit do$ gosub do_ask_check_numeric$ if (error) then exit do" gosub do_ask_check_allow$ if (error) then exit do" gosub do_ask_check_range$ if (error) then exit do! gosub do_ask_check_date$ if (error) then exit do# gosub do_ask_check_uconly end do end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%3 ! D O _ A S K _ C H E C K _ R E Q U I R E DI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !? ! Check that we have a response if u_required% = true ! ! EXPECTED:- ! u_reply$ = what they entered ! ! RETURNED:4 ! error = true if no response given !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_ask_check_required error = false if (u_required%) then" z1$ = edit$(u_reply$, 2)- ! discard all spaces and tabs if z1$ = "" then/ message error : "Response required" error = true end if end if end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%3 ! D O _ A S K _ C H E C K _ N U M E R I CI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !3 ! Check that the response is a valid number ! ! EXPECTED:1 ! u_reply$ = what the user entered ! ! RESULT:7 ! error = true if response not numeric? ! u_rel = numeric value of response if numericJ ! I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%H $ routine do_ask_check_numeric error = false if (u_numeric%) then u_rel = 0.- if valid(u_reply$, "number") then! u_rel = val(u_reply$) else4 message error : "Numeric entry expected" error = true end if end if end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! D O _ A S K _ C H E C K _ A L L O WI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% != ! Check that the reply is among the allowed responses ! ! EXPECTED:1 ! u_reply$ = what the user enteredB ! u_allow$ = list of allowed responses separated by" ! commas ! ! RETURNED:D ! error = true if reply not among allowed responses !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine do_ask_check_allow error = false do" if u_allow$ <> "" then) z1$ = ucase$(trim$(u_reply$))< if (z1$ = "") and (u_required% = false) then exit do end ifB ! don't check if null string and response not  ! required. if match(u_allow$, z1$) = 0 thenC message error : 'Valid responses: "' + u_allow$ + '"' error = true end if end if end do end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%- ! D O _ A S K _ C H E C K _ R A N G EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !3 ! Check response is within a specific range ! ! EXPECTED:2 ! u_reply$ = what the user entered9 ! u_range$ = range string (ex: "1 TO 100") ! ! RETURNED:E ! u_rel = numeric version of what they entered (if OK)< ! error = true if response not within range !C ! Exceeds 22 lines to complete range checking in one place. !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%" routine do_ask_check_range error = false do" if u_range$ <> "" then u_rel = 0.) z1$ = ucase$(trim$(u_reply$))< if (z1$ = "") and (u_required% = false) then exit do end if@ ! don't check if null string and response not  !required0 ~DEMO.BCK+L+$[INTOUCH_DEMO]UTILITY_ROUTINES.INC;5O6Flbound$ = element$(u_range$, 1, " ")0 ubound$ = element$(u_range$, 3, " ")" lbound = val(lbound$)" ubound = val(ubound$)* if valid(z1$, "number") then u_rel = val(z1$) else6 message error : "Numeric entry expected" error = true exit do end if< if (u_rel < lbound) or (u_rel > ubound) then; message error : "Enter a number between " + &9 lbound$ + " and " + ubound$ error = true end if end if end do end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%+ ! D O _ A S K _ C H E C K _ D A T EE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !( ! Check response is a valid date ! ! EXPECTED:2 ! u_reply$ = what the user entered ! ! RETURNED:< ! error = true if response not a valid date !2 ! u_day = "julian" of dateE ! u_day$ = day of week (Monday, Tuesday, etc.)> ! u_yymmdd$ = yymmdd version of entered date> ! u_mmddyy$ = mmddyy version of entered dateA ! u_ddmonyy$ = dd-mon-yy version of entered dateD ! u_monthddyy$ = month dd, yy version of entered date; ! (padded to 18 characters) !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! routine do_ask_check_date error = false do if (u_date%) thenH if (trim$(u_reply$) = "") and (u_required% = false) then exit do end ifH ! don't check if null string and response not required ! verify the date u_mmddyy$ = u_reply$ gosub mdy_to_ymd0 if (valid(u_yymmdd$, "date")) then u_str$ = u_yymmdd$! gosub get_date else9 message error : "Invalid date: " + u_reply$ error = true end if end if end do end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%/ ! D O _ A S K _ C H E C K _ U C O N L YE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !> ! Convert u_reply$ to upper case if u_uconly% = true ! ! EXPECTED:1 ! u_reply$ = what the user entered ! ! RESULT:5 ! u_reply$ = changed to all upper case !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# routine do_ask_check_uconly if (u_uconly%) then% u_reply$ = ucase$(u_reply$) end if end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! D O _ A S K _ R E S E TE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !9 ! Reset all the variables used by the ask routine ! ! EXPECTED:* ! u_prompt$ = prompt text/ ! u_default$ = default response5 ! u_required% = response required flag- ! u_maxlen% = maximum length1 ! u_numeric% = numeric entry onlyF ! u_allow$ = allowed responses (separated by commas)< ! u_range$ = allowed range (ex: "1 TO 99")* ! u_date% = verify date9 ! u_uconly% = convert to upper case flag; ! u_help$ = help topic in HELP structure !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine do_ask_reset u_prompt$ = "" u_default$ = "" u_required% = false u_maxlen% = 0% u_numeric% = false u_allow$ = "" u_range$ = "" u_date% = false u_uconly% = false u_help$ = "" end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! A S K Y NE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Ask a YES/NO question. ! ! EXPECTED:( ! u_prompt$ = prompt text ! ! RESULT:& ! u_reply$ = "Y" or "N" !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine askyn prompt_sav$ = u_prompt$ do. u_prompt$ = prompt_sav$ + " (Y/N)" u_default$ = "No" u_required% = true u_maxlen% = 4% u_uconly% = true gosub ask1 if (_exit) or (_back) then exit do- if valid(u_reply$, "yes/no") then$ u_reply$ = u_reply$[1:1] else' message error : "YES or NO" repeat do end if end do end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%! ! S C R E E N _ F R A M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !: ! Paint the screen with the top and bottom frames. ! ! EXPECTED:% ! u_str$ = header text ! ! Results:A ! the_width = screen width - set by screen_frameI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine screen_frame ask margin the_width# if save_bottom_frame then# save_bottom_frame = false( clear area 1, 1, 21, the_width else clear end if' z3$ = space$(the_width)  sf_head$ = u_str$1 z$ = system_name$ + " " + system_version$ z = len(z$) z3$[2:2 + z - 1] = z$ u_str$ = date$ gosub get_date z = len(u_ddmonyy$) z = the_width - z) z3$[z:the_width - 1] = u_ddmonyy$% print reverse, at 1, 1 : z3$;' sf_head$ = " " + sf_head$ + " "- z = (the_width/2) - (len(sf_head$)/2)0 print at 1, z, bold, reverse : sf_head$; z3$ = "EXIT = Exit" + &( space$(the_width - 32) + &% "\ = Back HELP = Help"& print reverse, at 24, 1 : z3$;7 if bottom_frame_text$ = '' then exit routine3 z = the_width - (len(bottom_frame_text$)/2); print at 24, z, bold, reverse : bottom_frame_text$; end routineI I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! G E T _ D A T EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! EXPECTED:> ! u_str$ = yyMMDD version of date to "elaborate" ! ! RESULT:9 ! u_day = "julian" of entered dateD ! u_day$ = day of week (Monday, Tuesday, etc.)= ! u_yymmdd$ = yymmdd version of entered date= ! u_mmddyy$ = mmddyy version of entered date@ ! u_ddmonyy$ = dd-mon-yy version of entered dateC ! u_monthddyy$ = month dd, yy version of entered date: ! (padded to 18 characters) !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine get_date$ if trim$(u_str$) = "" then u_day = 0. u_day$ = "" u_yymmdd$ = "" u_mmddyy$ = "" u_ddmonyy$ = ""# u_monthddyy$ = space$(18) else ' u_day = days(u_str$)& u_day$ = day$(u_day)( u_yymmdd$ = date$(u_day, 0)( u_mmddyy$ = date$(u_day, 1)( u_ddmonyy$ = date$(u_day, 3)3 u_monthddyy$ = rpad$(date$(u_day, 4), 18) end if end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! G E T _ T I M EI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !C ! Convert a 24-hour time string into a 12-hour time string. ! ! EXPECTED:E ! u_str$ = HH:MM (24 hr) version of time to "elaborate" ! ! RESULT: 0 ! u_time$ = HH:MM AM or HH:MM PM !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine get_time z1$ = u_str$[1:2] z2$ = u_str$[4:5] select case z1$ case is < "12"+ u_time$ = z1$ + ":" + z2$ + " AM" case is = "12"+ u_time$ = z1$ + ":" + z2$ + " PM" case is > "12" z1% = val(z1$) z1% = z1% - 12@ u_time$ = lpad$(str$(z1%), 2, "0") + ":" + z2$ + " PM" end select end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Y M D _ T O _ M D YE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !9 ! Change a date in yyMMDD format to MMDDyy format ! ! EXPECTED:A ! u_yymmdd$ = date in yyMMDD format if 8 char date ! ! RETURNED:2 ! u_mmddyy$ = date in MMDDyy format !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine ymd_to_mdy# if len(u_yymmdd$) = 6 then5 u_mmddyy$ = u_yymmdd$[3:6] + u_yymmdd$[1:2] else5 u_mmddyy$ = u_yymmdd$[5:8] + u_yymmdd$[1:4] end if end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M D Y _ T O _ Y M DE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !9 ! Change a date in MMDDyy format to yyMMDD format ! ! EXPECTED:2 ! u_mmddyy$ = date in MMDDyy format ! ! RETURNED:2 ! u_yymmdd$ = date in yyMMDD format !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine mdy_to_ymd# if len(u_mmddyy$) = 6 then5 u_yymmdd$ = u_mmddyy$[5:6] + u_mmddyy$[1:4] else5 u_yymmdd$ = u_mmddyy$[5:8] + u_mmddyy$[1:4] end if end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! E R R _ P A U S EE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !4 ! Print out an error message, ring the bell,& ! and pause while they read it ! ! EXPECTED:4 ! u_str$ = error message to print outA ! the_width = screen width - set by screen_frame !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine err_pause' clear area 22, 1, 22, the_width gosub center. ! given u_str$, returns u_int%- print bold, at 22, u_int% : u_str$; & chr$(7); delay' clear area 22, 1, 22, the_width end routineE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! M S G _ P A U S EE !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !: ! Print out a message and pause while they read it ! ! EXPECTED:. ! u_str$ = message to print outA ! the_width = screen width - set by screen_frame !E !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine msg_pause' clear area 22, 1, 22, the_width gosub center. ! given u_str$, returns u_int%+ print bold, at 22, u_int% : u_str$; delay' clear area 22, 1, 22, the_width end routineI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! C E N T E RI !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !D ! Returns the screen column to use in order to center u_str$ ! on an screen ! ! EXPECTED:/ ! u_str$ = string to be centeredB ! the_width = width of screen - set by screen_frame ! ! RESULT:< ! u_int% = starting column to print u_str$ on !I !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine center2 u_int% = (the_width/2) - (len(u_str$) / 2) end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! I N P U T R E S P O N S EJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description:$ ! Ask the expected prompt.E ! Allows, through various flags (see do_ask_checks), you toC ! automatically check for stuff. Because these flags areC ! automatically reset, you don't need to worry about them6 ! 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 rules1 ! response_message$ message to display ! ! Locals: ! ! Results:A ! finished_entry? flag signifying entry is finished" ! reply$ = user's reply !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine input_response init_ask_vars" clear area 21, 1, 21, 80 do< if ask_message$ <> '' then message ask_message$C line input prompt ask_prompt$, default ask_default$, &4 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$ = '' then6 message error : 'No help is available' else- help_topic$ = tmp_help_topic$! gosub h_help end if repeat do end ifF if not valid(reply$, ask_validation$, true) then repeat do end do reply$ = trim$(reply$); if ask_uc_response? then reply$ = ucase$(reply$)O if reply$ = 'NONE' then reply$ = 'none' ! don't want this uppercased= if _terminator = 'PF4' then finished_entry? = true end routineJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%# ! I N I T A S K V A R SJ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Brief description:H ! initialize the variables that ask uses. Reset the variablesL ! that the programmer passed so that they don't get used next time !  ! Expected:1 ! 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:A ! finished_entry? flag signifying entry is finished1 ! 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 text0 ! ask_validation$ validations rules9 ! reply$ user's response is blanked !J !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% routine init_ask_vars reply$ = ""' ask_validation$ = validation$ validation$ = '' ask_prompt$ = prompt$M 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*[INTOUCH_DEMO]VAX.DIR;1+,./@ 4 -L+0123 KPWO56cLP]7#h8f9GHJI:INT_DEMO_B_BASELINE_BASIC.LIS # V F9:INT_DEMO_B_BASELINE_BASIC.LOG IW 1 z#:INT_DEMO_B_BASELINE_BASIC.OBJ D$ j- F6INT_DEMO_B_BASELINE_C.LIS %n   F$6INT_DEMO_B_BASELINE_C.LOG JW c F|6INT_DEMO_B_BASELINE_C.OBJ ?% 5 F:INT_DEMO_B_BASELINE_COBOL.LIS % , FP:INT_DEMO_B_BASELINE_COBOL.LOGrW\%  &:INT_DEMO_B_BASELINE_COBOL.OBJ F ' F <INT_DEMO_B_BASELINE_FORTRAN.LIS SW T <INT_DEMO_B_BASELINE_FORTRAN.LOGe%#T +<INT_DEMO_B_BASELINE_FORTRAN.OBJ F5 'q -< INT_DEMO_B_IO_BASELINE_BASIC.LIS+( m F< INT_DEMO_B_IO_BASELINE_BASIC.LOGVW , F@< INT_DEMO_B_IO_BASELINE_BASIC.OBJ,' ) F*8INT_DEMO_B_IO_BASELINE_C.LISw? p F!8INT_DEMO_B_IO_BASELINE_C.LOGA-- a F)8INT_DEMO_B_IO_BASELINE_C.OBJ?/  F%< INT_DEMO_B_IO_BASELINE_COBOL.LIS j@ F< INT_DEMO_B_IO_BASELINE_COBOL.LOG%?r 7< INT_DEMO_B_IO_BASELINE_COBOL.OBJ F0 O F6"INT_DEMO_B_IO_BASELINE_FORTRAN.LIS WW , >"INT_DEMO_B_IO_BASELINE_FORTRAN.LOGc@  .Fm6"INT_DEMO_B_IO_BASELINE_FORTRAN.OBJ @  86INT_DEMO_B_READ_BASIC.LIS@ D Z Fh6INT_DEMO_B_READ_BASIC.LOGdW X F6INT_DEMO_B_READ_BASIC.OBJ@6 G B F]6INT_DEMO_B_READ_COBOL.LIS @ m F(6INT_DEMO_B_READ_COBOL.LOGz@@M d6INT_DEMO_B_READ_COBOL.OBJ F# c [ FN8INT_DEMO_B_READ_FORTRAN.LIS eW T @8INT_DEMO_B_READ_FORTRAN.LOG@T8INT_DEMO_B_READ_FORTRAN.OBJ e A 6INT_DEMO_B_REDIM_BASIC.LISA  [I)6INT_DEMO_B_REDIM_BASIC.LOG  b ZI6INT_DEMO_B_REDIM_BASIC.OBJNAs  \I":INT_DEMO_B_SCREEN_IO_BASIC.LIS%B  ^I:INT_DEMO_B_SCREEN_IO_BASIC.LOGA =l ]I:INT_DEMO_B_SCREEN_IO_BASIC.OBJ=B/ 5 _I66INT_DEMO_B_SCREEN_IO_C.LISB? E fI6INT_DEMO_B_SCREEN_IO_C.LOGgB# /% `I6INT_DEMO_B_SCREEN_IO_C.OBJ5CL Lm gI0:INT_DEMO_B_SCREEN_IO_COBOL.LIS qC/ zv mIG:INT_DEMO_B_SCREEN_IO_COBOL.LOG@ NCvlN:INT_DEMO_B_SCREEN_IO_COBOL.OBJ iIP q kI;4 INT_DEMO_B_SCREEN_IO_FORTRAN.LIS fW F< INT_DEMO_B_SCREEN_IO_FORTRAN.LOGkC*5uI`4 INT_DEMO_B_SCREEN_IO_FORTRAN.OBJ CH 8INT_DEMO_B_UPDATE_BASIC.LISCs  xI!8INT_DEMO_B_UPDATE_BASIC.LOGiW  wI28INT_DEMO_B_UPDATE_BASIC.OBJDe c I-8INT_DEMO_B_UPDATE_COBOL.LIS DR yS I8INT_DEMO_B_UPDATE_COBOL.LOGzCHD$8INT_DEMO_B_UPDATE_COBOL.OBJ I5 V I6INT_DEMO_B_WRITE_BASIC.LISD= W I6INT_DEMO_B_WRITE_BASIC.LOGD( ;/ I6INT_DEMO_B_WRITE_BASIC.OBJD> p( I'6INT_DEMO_B_WRITE_COBOL.LIS E%  IY6INT_DEMO_B_WRITE_COBOL.LOGDgDM{76INT_DEMO_B_WRITE_COBOL.OBJ I  I)0INT_DEMO_B_WRITE_FORTRAN.LIS lW 8INT_DEMO_B_WRITE_FORTRAN.LOGEMI 0INT_DEMO_B_WRITE_FORTRAN.OBJ E. R!